Ordinary Data Processing Task in Haskell: Vague Misgivings

This is an ordinary data processing task: read a list of dates and amounts (for example, deposits and withdrawals from a bank account) and report the date on which the lowest balance was recorded and what that balance was. While I do get the correct answer--always a virtue--with the code below, I can't help thinking that it could be done better (e.g. more concisely). I've included the preliminary input parsing code so that the whole thing can be compiled and run as is.

module Main where

import Text.ParserCombinators.Parsec
import Data.Time
import Numeric
import Control.Applicative ((<$>), (<*>), (*>)) import Control.Monad.State as CM --The purpose is to sum up a list of dated values (example: transactions in a bank --account) and produce the date and amount of the lowest recorded balance. --For the three lines below, the output would be: -- DtdBal {runningBal = 4859.96, lowDt = 2013-01-23, lowBal = 4859.96} --12/1/12, 6844.79 --1/1/13, 992.41 --1/23/13, -2977.24 data DtdVal = DtdVal { dt :: Day , amt :: Double } deriving Show data DtdBal = DtdBal { runningBal :: Double , lowDt :: Day , lowBal :: Double } deriving Show main = do res <- parseFromFile sched "escrow.txt" case res of Right l -> putStrLn . show$ process l
Left _ -> error "Oops"
where process (x:xs) = execState (minBal xs) (initState x)
initState x = DtdBal { runningBal = amt x, lowDt = dt x, lowBal = amt x }

minBal :: [DtdVal] -> CM.State DtdBal ()
minBal [] = return ()
minBal (x:xs) = do
rBal <- runningBal <$> get lBal <- lowBal <$> get
lDt  <- lowDt <$> get if amt x + rBal < lBal then put$ DtdBal { runningBal = rBal + amt x, lowDt = dt x, lowBal = amt x + rBal}
else put $DtdBal { runningBal = rBal + amt x, lowDt = lDt, lowBal = lBal } minBal xs sched :: CharParser () [DtdVal] sched = line endBy newline line :: CharParser () DtdVal line = DtdVal <$> dts <*> (char ',' >> spaces *> readSgnd)

dts :: CharParser () Day
dts = toDay <$> many digit sepBy char '/' where toDay [x, y, z] = fromGregorian (2000 + read z) (read x) (read y) readSgnd :: CharParser () Double readSgnd = do optional (char '+') inp <- getInput let [(num, inp')] = readSigned readFloat inp setInput inp' return num 2 Answers • recursive part of minBal is mapM_ • multiple get is better to refactor into one • get - process - put part of minBal is modify • state monad is not necessary - you can use plain foldr instead of mapM_ and modify • runningBal is better to implement using scanr. Then zip running balances and source list and foldr the resulting list of tuples • use minimum to find the minimum Here is a more idiomatic approach to minBal: runningBal' = scanl1 (+) . map amt rb l = zip (runningBal' l) l mb l = minimumBy (compare on fst) l minDay = mb . rb minBal' l = DtdBal { runningBal = fst$ last runningBals,
lowDt = dt $snd md, lowBal = fst md } where runningBals = rb l md = minDay l You can inline all the small functions for the final code but that's the order I created them in. Note that rb is calculated twice, but I was not sure if you really need the final balance. In your algorithm it was a byproduct. main can be rewritten too: main' = (parseFromFile sched >=> process >=> print) "escrow.txt" where process (Right l) = return$ minBal' l
process (Left _) = error "Oops"

Basically, putStrLn . show is print and composition is your friend. >=> is monadic variant of .. It's advantage over >>= is associativity - it lets you refactor your code more easily.

Here is a shorter version of minBal' which also saves a few calculations, but last is still O(N):

minBal' l = DtdBal {
runningBal = last runningBals,
lowDt = dt $snd md, lowBal = fst md } where md = minimumBy (compare on fst)$ zip runningBals l
runningBals = scanl1 (+) $map amt l Let me know how this works for very large files. • There is no need to use a state monad for the minBal, a simple foldl suffices. • One nice thing about using a parser library is that it will automatically generate some helpful error messages, but the way it is used in dts will only give a pattern match failure if something is wrong. Similarly a less helpful error message will be generated from a parse failure using readSigned. • It is not uncommon to simply name the parser from the thing that is being parsed, similar to BNF grammars. data Transaction = Transaction { time :: Day , amount :: Double } deriving Show data DtdBal = DtdBal { runningBal :: Double , lowDt :: Day , lowBal :: Double } deriving Show main = do result <- parseFromFile transactions "escrow.txt" case result of Right ls -> print . minBal$ ls
Left e -> print e

minBal (l:ls) = foldl go start ls
where
start = DtdBal{runningBal = amount l,lowDt = time l,lowBal = amount l}
go a b
| newBal < lowBal a = a{runningBal = newBal,lowBal = newBal,lowDt = time b}
| otherwise         = a{runningBal = newBal}
where newBal = amount b + runningBal a

transactions :: CharParser () [Transaction]
transactions = transaction endBy newline

transaction :: CharParser () Transaction
transaction = Transaction <$> date <*> (char ',' >> spaces *> float) date :: CharParser () Day date = do x <- int char '/' y <- int char '/' z <- int return (fromGregorian (2000 + z) x y) int :: (Integral a) => CharParser () a int = (fromInteger . read) <$> many digit

float :: CharParser () Double
float =
(char '-' >> negate <\$> posFloat) <|>
(optional (char '+') >> posFloat)
where
posFloat = do
x <- many digit
char '.'
y <- many digit
return (read (x ++ ('.':y)))