hpaste

{-# OPTIONS -fffi #-}

import qualified Data.ByteString.Char8 as BS
import System
import Data.List
import Maybe
import CForeign
import Foreign.Ptr
import System.IO.Unsafe

data Row = Row {
      ticker :: !BS.ByteString,
      bid    :: !Double,
      ask    :: !Double,
      day    :: !BS.ByteString,
      time   :: !BS.ByteString
      }

instance Eq Row where
    a == b  = ticker a == ticker b && time a == time b

instance Ord Row where
    compare a b = case compare (ticker a) (ticker b) of
                    EQ -> compare (time a) (time b)
                    e  -> e

-- since ByteString library doesn't seem to have strtod-like function, we can
-- peek into the ByteString using useAsCString and calling C strtod on it.
-- ByteStrign library should definitely be fixed!

foreign import ccall "stdlib.h strtod" cstrtod :: CString -> CString -> IO CDouble

{-# NOINLINE strtod #-}
strtod :: BS.ByteString -> Double
strtod bs = realToFrac . unsafePerformIO . BS.useAsCString bs $ \cs -> cstrtod cs nullPtr

data Result = Result {
      tickerR :: !BS.ByteString,
      openR   :: !Double,
      highR   :: !Double,
      lowR    :: !Double,
      closeR  :: !Double,
      dayR    :: !BS.ByteString
      }

instance Show Result where
    show (Result ticker open high low close day) =
        intercalate "," [BS.unpack ticker, show open, show high,
                         show low, show close, BS.unpack day] ++ "\n"

main :: IO ()
main = do
  (csvFile:outputFile:_) <- getArgs
  rows <- doReadData csvFile
  writeFile outputFile . concatMap show . computeResults $ groupToDays rows

computeResults :: [[Row]] -> [Result]
computeResults = map makeResult
 where makeResult d = let openRow  = head d
                          closeRow = last d
                          highRow  = maximumBy comparePrice d
                          lowRow   = minimumBy comparePrice d
                      in Result (ticker openRow) (price openRow) (price highRow)
                             (price lowRow) (price closeRow) (day openRow)
       price r = (bid r + ask r) / 2
       comparePrice a b = compare (price a) (price b)

groupToDays :: [Row] -> [[Row]]
groupToDays = concatMap (groupBy tickerDay) . groupBy tickerName
 where tickerName a b = ticker a == ticker b
       tickerDay a b  = day a == day b

doReadData :: FilePath -> IO [Row]
doReadData file = do
    contents <- BS.readFile file
    return . qsort . mapMaybe parseRow . BS.lines $ contents

parseRow :: BS.ByteString -> Maybe Row
parseRow row = case BS.split ',' row of
                 [ticker_,bid_,ask_,_,day_,time_] ->
                     Just $ Row ticker_ (strtod bid_) (strtod ask_) day_ time_
                 _ -> Nothing

qsort :: Ord a => [a] -> [a]
qsort []  = []
qsort (x:xs) = qsort lesser ++ equal ++ qsort greater
 where
   (lesser,equal,greater) = part x xs ([], [x], [])
   part _ [] (l,e,g) = (l,e,g)
   part p (x:xs) (l,e,g)
       | x > p  = part p xs (l,e,x:g)
       | x < p  = part p xs (x:l, e, g)
       | otherwise = part p xs (l,x:e, g)