module Hledger.Read.TimedotReader (
reader,
timedotfilep,
tests_Hledger_Read_TimedotReader
)
where
import Prelude ()
import Prelude.Compat
import Control.Monad
import Control.Monad.Except (ExceptT)
import Control.Monad.State.Strict
import Data.Char (isSpace)
import Data.List (foldl')
import Data.Maybe
import Data.Text (Text)
import Test.HUnit
import Text.Megaparsec.Compat hiding (parse)
import Hledger.Data
import Hledger.Read.Common
import Hledger.Utils hiding (ptrace)
ptrace :: Monad m => a -> m a
ptrace = return
reader :: Reader
reader = Reader
{rFormat = "timedot"
,rExtensions = ["timedot"]
,rParser = parse
,rExperimental = False
}
parse :: Maybe FilePath -> Bool -> FilePath -> Text -> ExceptT String IO Journal
parse _ = parseAndFinaliseJournal timedotfilep
timedotfilep :: JournalParser m ParsedJournal
timedotfilep = do many timedotfileitemp
eof
get
where
timedotfileitemp :: JournalParser m ()
timedotfileitemp = do
ptrace "timedotfileitemp"
choice [
void emptyorcommentlinep
,timedotdayp >>= \ts -> modify' (addTransactions ts)
] <?> "timedot day entry, or default year or comment line or blank line"
addTransactions :: [Transaction] -> Journal -> Journal
addTransactions ts j = foldl' (flip ($)) j (map addTransaction ts)
timedotdayp :: JournalParser m [Transaction]
timedotdayp = do
ptrace " timedotdayp"
d <- datep <* lift eolof
es <- catMaybes <$> many (const Nothing <$> try emptyorcommentlinep <|>
Just <$> (notFollowedBy datep >> timedotentryp))
return $ map (\t -> t{tdate=d}) es
timedotentryp :: JournalParser m Transaction
timedotentryp = do
ptrace " timedotentryp"
pos <- genericSourcePos <$> getPosition
lift (many spacenonewline)
a <- modifiedaccountnamep
lift (many spacenonewline)
hours <-
try (followingcommentp >> return 0)
<|> (timedotdurationp <*
(try followingcommentp <|> (newline >> return "")))
let t = nulltransaction{
tsourcepos = pos,
tstatus = Cleared,
tpostings = [
nullposting{paccount=a
,pamount=Mixed [setAmountPrecision 2 $ num hours]
,ptype=VirtualPosting
,ptransaction=Just t
}
]
}
return t
timedotdurationp :: JournalParser m Quantity
timedotdurationp = try timedotnumberp <|> timedotdotsp
timedotnumberp :: JournalParser m Quantity
timedotnumberp = do
(q, _, _, _) <- lift numberp
lift (many spacenonewline)
optional $ char 'h'
lift (many spacenonewline)
return q
timedotdotsp :: JournalParser m Quantity
timedotdotsp = do
dots <- filter (not.isSpace) <$> many (oneOf (". " :: [Char]))
return $ (/4) $ fromIntegral $ length dots
tests_Hledger_Read_TimedotReader = TestList [
]