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 timedotnumericp <|> timedotdotsp
timedotnumericp :: JournalParser m Quantity
timedotnumericp = do
(q, _, _, _) <- lift numberp
msymbol <- optional $ choice $ map (string . fst) timeUnits
lift (many spacenonewline)
let q' =
case msymbol of
Nothing -> q
Just sym ->
case lookup sym timeUnits of
Just mult -> q * mult
Nothing -> q
return q'
timeUnits =
[("s",2.777777777777778e-4)
,("mo",5040)
,("m",1.6666666666666666e-2)
,("h",1)
,("d",24)
,("w",168)
,("y",61320)
]
timedotdotsp :: JournalParser m Quantity
timedotdotsp = do
dots <- filter (not.isSpace) <$> many (oneOf (". " :: [Char]))
return $ (/4) $ fromIntegral $ length dots
tests_Hledger_Read_TimedotReader = TestList [
]