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 qualified Data.Text as T
import Test.HUnit
import Text.Megaparsec hiding (parse)
import System.FilePath
import Hledger.Data
import Hledger.Read.Common
import Hledger.Utils hiding (ptrace)
ptrace = return
reader :: Reader
reader = Reader format detect parse
format :: String
format = "timedot"
detect :: FilePath -> Text -> Bool
detect f t
| f /= "-" = takeExtension f == '.':format
| otherwise = regexMatches "(^|\n)[0-9]" $ T.unpack t
parse :: Maybe FilePath -> Bool -> FilePath -> Text -> ExceptT String IO Journal
parse _ = parseAndFinaliseJournal timedotfilep
timedotfilep :: ErroringJournalParser ParsedJournal
timedotfilep = do many timedotfileitemp
eof
get
where
timedotfileitemp :: ErroringJournalParser ()
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 :: ErroringJournalParser [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 :: ErroringJournalParser 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 :: ErroringJournalParser Quantity
timedotdurationp = try timedotnumberp <|> timedotdotsp
timedotnumberp :: ErroringJournalParser Quantity
timedotnumberp = do
(q, _, _, _) <- lift numberp
lift (many spacenonewline)
optional $ char 'h'
lift (many spacenonewline)
return q
timedotdotsp :: ErroringJournalParser Quantity
timedotdotsp = do
dots <- filter (not.isSpace) <$> many (oneOf (". " :: [Char]))
return $ (/4) $ fromIntegral $ length dots
tests_Hledger_Read_TimedotReader = TestList [
]