3
\$\begingroup\$

I have this small Haskell script that I wrote some time ago to parse a set of financial CSV files to produce other CSV files. I've recently had a problem with large input files (around 300Mb) that I solved with RTS options.

Still, I'd like to make it more lazy and efficient. For example, I noted that it loads the whole input file in memory before starting writing results despite the left fold that was intended to be lazy. What's wrong here?

Moreover, I'd like to know how to make it more readable (since a smart colleague used to other functional languages stated it's unreadable) and idiomatic to Haskell.

Main.hs

{-# LANGUAGE CPP, TemplateHaskell #-}

module Main (
    main
) where

import System.Exit (exitFailure)
import System.Environment(getArgs)
import System.IO (withFile, IOMode(..), hGetContents)
import Data.Maybe (catMaybes)
import Data.Time.LocalTime (TimeOfDay(..))
import Data.Time.Format (formatTime)
import System.Locale (defaultTimeLocale)
import TickWrite
import EarlyTrade

main = do
    args <- getArgs
    switchArgs args
    putStrLn "Done"

switchArgs ("importTrades":"help":xs) = importTradesHelp
switchArgs ("importTrades":outDir:filenames) = mapM_ (importTrades outDir) filenames
switchArgs ["importTrades"] = importTradesHelp
switchArgs [] = print $ "You must specify a tool"

transformFile :: FilePath -> ([String] -> a) -> (a -> IO r) -> IO r
transformFile file operation continuation = withFile file ReadMode (\h -> hGetContents h >>= (continuation.operation.lines))

importTradesHelp = print "importTrades outDir fileNames"

importTrades :: FilePath -> FilePath -> IO ()
importTrades outDir csvFile = transformFile csvFile (foldTradingSample.getTickWriteTrades) (saveTradingSamples outDir)
    where getTickWriteTrades = filter (isBetween (9, 0) (18, 0)).(catMaybes.(map fromCSVLine))
          foldTradingSample = foldl toTradingSample []

saveTradingSamples :: String -> [TradingSample] -> IO ()
saveTradingSamples folder samples = mapM_ (saveTradingSample folder) samples

saveTradingSample :: String -> TradingSample -> IO ()
saveTradingSample folder sample = writeFile fileName contents
    where fileName = folder ++ "\\" ++ (equity sample) ++ "_" ++ (formatTime defaultTimeLocale "%F" $ day sample) ++ ".CSV"
          contents = tradingSampleToCSV sample

EarlyTrade.hs

module EarlyTrade (
    Trade,
    TradingSample (..),
    toTradingSample,
    tradingSampleToCSV
) where

import qualified TickWrite as Tw
import Data.Time.Calendar (Day)
import Data.Time.LocalTime (timeOfDayToDayFraction)
import Data.List (intersperse)

type Simbol = String

data Trade = Trade { tPrice     :: Double
                   , tTime      :: Double
                   , tVolume    :: Integer
                   } deriving (Show, Read, Eq)

data TradingSample = TradingSample { equity :: Simbol
                                   , day    :: Day
                                   , trades :: [Trade]
                                   } deriving (Show, Read, Eq)

tradingSampleToCSV :: TradingSample -> String
tradingSampleToCSV (TradingSample _ _ t) = unlines $ map tradeToCSVRow t

tradeToCSVRow :: Trade -> String
tradeToCSVRow (Trade p t v) = show t ++ "," ++ show p ++ "," ++ show v

fromTickWrite :: Tw.Trade -> Trade
fromTickWrite tt = Trade {tPrice    = Tw.tPrice tt
                         ,tTime     = fromRational $ timeOfDayToDayFraction $ Tw.tTime tt
                         ,tVolume   = Tw.tVolume tt
                         }

toTradingSample :: [TradingSample] -> Tw.Trade -> [TradingSample]
toTradingSample (current:others) twTrade
    | newEqt == equity current && newDay == day current = (current { trades = newTrades }):others
    | otherwise = current : toTradingSample others twTrade
    where newEqt = Tw.tSimbol twTrade
          newDay = Tw.tDate twTrade
          newTrade = fromTickWrite twTrade
          newTrades = trades current ++ [newTrade]
toTradingSample [] twTrade = [TradingSample { equity = Tw.tSimbol twTrade
                                            , day = Tw.tDate twTrade
                                            , trades = [fromTickWrite twTrade]
                                            }]

TickWrite.hs

module TickWrite (
    Trade(..),
    fromCSVLine,
    isBetween
) where

import Data.Time.Calendar (Day, fromGregorian)
import Data.Time.LocalTime (TimeOfDay(..))
import Data.Time.Format (parseTime)
import Data.List.Split (splitOn)
import System.Locale (defaultTimeLocale)

data Trade = Trade {tSimbol              :: String
                   ,tDate                :: Day
                   ,tTime                :: TimeOfDay
                   ,tPrice               :: Double
                   ,tVolume              :: Integer
                   ,tTradeNumber         :: String
                   ,tExcludeRecordFlag   :: String
                   ,tFilteredPrice       :: String
                   ,tCompanyID           :: String
                   } deriving (Show, Read, Eq)

isBetween :: (Int, Int) -> (Int, Int) -> Trade -> Bool
isBetween (sH, sM) (eH, eM) trade = tradeTime >= start && tradeTime <= end
    where tradeTime = tTime trade
          start = TimeOfDay sH sM 0
          end = TimeOfDay eH eM 0

fromCSVLine = fromCSVRecord . (splitOn ",")

parseValue :: Read a => String -> Maybe a
parseValue s =
    case reads s of
      [] -> Nothing
      ((i,_):_) -> Just i

fromCSVRecord (s:d:t:p:v:n:e:f:c:xs) = do
    dateV <- parseTime defaultTimeLocale "%Y/%m/%d" d
    timeV <- parseTime defaultTimeLocale "%T%Q" t
    volumeV <- parseValue v
    priceV <- parseValue p
    return  Trade {tSimbol              = s
                  ,tDate                = dateV
                  ,tTime                = timeV
                  ,tPrice               = priceV
                  ,tVolume              = volumeV
                  ,tTradeNumber         = n
                  ,tExcludeRecordFlag   = e
                  ,tFilteredPrice       = f
                  ,tCompanyID           = c
                  }
\$\endgroup\$
  • \$\begingroup\$ I don't have time at the moment to give a full write up, but you can fix the memory issues by using pipes or conduit. Both libraries will allow you to avoid the large intermediate list and stream results to the output file immediately as they are generated. \$\endgroup\$ – Gabriel Gonzalez May 15 '13 at 5:22
  • \$\begingroup\$ @GabrielGonzalez a few month ago I did looked at those libraries, but I was unable to understand what was the most supported. In other languages I'm used to choose libraries that have good community support. In the Haskell ecosystem this is really hard to see. What's their state now? Is there a "winner" library for such approach? \$\endgroup\$ – Giacomo Tesio May 15 '13 at 7:39
  • \$\begingroup\$ conduit currently has the best community support, but pipes support is growing rapidly. Right now your best choice is conduit. Besides, both libraries are very similar, so you can very easily switch from one to the other. \$\endgroup\$ – Gabriel Gonzalez May 15 '13 at 15:09
  • \$\begingroup\$ @GiacomoTesio Have a stop at #haskell on freenode whenever you're uncertain about what's best supported; they're quite a good representation of 'the community' so what they prefer is what you will find the best community support for. \$\endgroup\$ – Jimmy Hoffa May 15 '13 at 21:51

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Browse other questions tagged or ask your own question.