{-# LANGUAGE OverloadedStrings, PackageImports #-}
module Hledger.Read.TimedotReader (
reader,
timedotfilep,
)
where
import Prelude ()
import "base-compat-batteries" 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 Text.Megaparsec hiding (parse)
import Text.Megaparsec.Char
import Hledger.Data
import Hledger.Read.Common
import Hledger.Utils hiding (traceParse)
traceParse :: Monad m => a -> m a
traceParse :: a -> m a
traceParse = a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
reader :: Reader
reader :: Reader
reader = Reader :: StorageFormat
-> [StorageFormat]
-> (InputOpts
-> StorageFormat -> Text -> ExceptT StorageFormat IO Journal)
-> Bool
-> Reader
Reader
{rFormat :: StorageFormat
rFormat = "timedot"
,rExtensions :: [StorageFormat]
rExtensions = ["timedot"]
,rParser :: InputOpts
-> StorageFormat -> Text -> ExceptT StorageFormat IO Journal
rParser = InputOpts
-> StorageFormat -> Text -> ExceptT StorageFormat IO Journal
parse
,rExperimental :: Bool
rExperimental = Bool
False
}
parse :: InputOpts -> FilePath -> Text -> ExceptT String IO Journal
parse :: InputOpts
-> StorageFormat -> Text -> ExceptT StorageFormat IO Journal
parse = JournalParser IO Journal
-> InputOpts
-> StorageFormat
-> Text
-> ExceptT StorageFormat IO Journal
parseAndFinaliseJournal' JournalParser IO Journal
forall (m :: * -> *). JournalParser m Journal
timedotfilep
timedotfilep :: JournalParser m ParsedJournal
timedotfilep :: JournalParser m Journal
timedotfilep = do StateT Journal (ParsecT CustomErr Text m) ()
-> StateT Journal (ParsecT CustomErr Text m) [()]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many StateT Journal (ParsecT CustomErr Text m) ()
forall (m :: * -> *). JournalParser m ()
timedotfileitemp
StateT Journal (ParsecT CustomErr Text m) ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof
JournalParser m Journal
forall s (m :: * -> *). MonadState s m => m s
get
where
timedotfileitemp :: JournalParser m ()
timedotfileitemp :: JournalParser m ()
timedotfileitemp = do
StorageFormat
-> StateT Journal (ParsecT CustomErr Text m) StorageFormat
forall (m :: * -> *) a. Monad m => a -> m a
traceParse "timedotfileitemp"
[JournalParser m ()] -> JournalParser m ()
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice [
JournalParser m () -> JournalParser m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (JournalParser m () -> JournalParser m ())
-> JournalParser m () -> JournalParser m ()
forall a b. (a -> b) -> a -> b
$ ParsecT CustomErr Text m () -> JournalParser m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text m ()
forall (m :: * -> *). TextParser m ()
emptyorcommentlinep
,JournalParser m [Transaction]
forall (m :: * -> *). JournalParser m [Transaction]
timedotdayp JournalParser m [Transaction]
-> ([Transaction] -> JournalParser m ()) -> JournalParser m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ts :: [Transaction]
ts -> (Journal -> Journal) -> JournalParser m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ([Transaction] -> Journal -> Journal
addTransactions [Transaction]
ts)
] JournalParser m () -> StorageFormat -> JournalParser m ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> StorageFormat -> m a
<?> "timedot day entry, or default year or comment line or blank line"
addTransactions :: [Transaction] -> Journal -> Journal
addTransactions :: [Transaction] -> Journal -> Journal
addTransactions ts :: [Transaction]
ts j :: Journal
j = (Journal -> (Journal -> Journal) -> Journal)
-> Journal -> [Journal -> Journal] -> Journal
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (((Journal -> Journal) -> Journal -> Journal)
-> Journal -> (Journal -> Journal) -> Journal
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Journal -> Journal) -> Journal -> Journal
forall a b. (a -> b) -> a -> b
($)) Journal
j ((Transaction -> Journal -> Journal)
-> [Transaction] -> [Journal -> Journal]
forall a b. (a -> b) -> [a] -> [b]
map Transaction -> Journal -> Journal
addTransaction [Transaction]
ts)
timedotdayp :: JournalParser m [Transaction]
timedotdayp :: JournalParser m [Transaction]
timedotdayp = do
StorageFormat
-> StateT Journal (ParsecT CustomErr Text m) StorageFormat
forall (m :: * -> *) a. Monad m => a -> m a
traceParse " timedotdayp"
Day
d <- JournalParser m Day
forall (m :: * -> *). JournalParser m Day
datep JournalParser m Day
-> StateT Journal (ParsecT CustomErr Text m) ()
-> JournalParser m Day
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT CustomErr Text m ()
-> StateT Journal (ParsecT CustomErr Text m) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text m ()
forall (m :: * -> *). TextParser m ()
eolof
[Transaction]
es <- [Maybe Transaction] -> [Transaction]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Transaction] -> [Transaction])
-> StateT Journal (ParsecT CustomErr Text m) [Maybe Transaction]
-> JournalParser m [Transaction]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT Journal (ParsecT CustomErr Text m) (Maybe Transaction)
-> StateT Journal (ParsecT CustomErr Text m) [Maybe Transaction]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (Maybe Transaction -> () -> Maybe Transaction
forall a b. a -> b -> a
const Maybe Transaction
forall a. Maybe a
Nothing (() -> Maybe Transaction)
-> StateT Journal (ParsecT CustomErr Text m) ()
-> StateT Journal (ParsecT CustomErr Text m) (Maybe Transaction)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT Journal (ParsecT CustomErr Text m) ()
-> StateT Journal (ParsecT CustomErr Text m) ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT CustomErr Text m ()
-> StateT Journal (ParsecT CustomErr Text m) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text m ()
forall (m :: * -> *). TextParser m ()
emptyorcommentlinep) StateT Journal (ParsecT CustomErr Text m) (Maybe Transaction)
-> StateT Journal (ParsecT CustomErr Text m) (Maybe Transaction)
-> StateT Journal (ParsecT CustomErr Text m) (Maybe Transaction)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
Transaction -> Maybe Transaction
forall a. a -> Maybe a
Just (Transaction -> Maybe Transaction)
-> StateT Journal (ParsecT CustomErr Text m) Transaction
-> StateT Journal (ParsecT CustomErr Text m) (Maybe Transaction)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (JournalParser m Day -> StateT Journal (ParsecT CustomErr Text m) ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy JournalParser m Day
forall (m :: * -> *). JournalParser m Day
datep StateT Journal (ParsecT CustomErr Text m) ()
-> StateT Journal (ParsecT CustomErr Text m) Transaction
-> StateT Journal (ParsecT CustomErr Text m) Transaction
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StateT Journal (ParsecT CustomErr Text m) Transaction
forall (m :: * -> *). JournalParser m Transaction
timedotentryp))
[Transaction] -> JournalParser m [Transaction]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Transaction] -> JournalParser m [Transaction])
-> [Transaction] -> JournalParser m [Transaction]
forall a b. (a -> b) -> a -> b
$ (Transaction -> Transaction) -> [Transaction] -> [Transaction]
forall a b. (a -> b) -> [a] -> [b]
map (\t :: Transaction
t -> Transaction
t{tdate :: Day
tdate=Day
d}) [Transaction]
es
timedotentryp :: JournalParser m Transaction
timedotentryp :: JournalParser m Transaction
timedotentryp = do
StorageFormat
-> StateT Journal (ParsecT CustomErr Text m) StorageFormat
forall (m :: * -> *) a. Monad m => a -> m a
traceParse " timedotentryp"
GenericSourcePos
pos <- SourcePos -> GenericSourcePos
genericSourcePos (SourcePos -> GenericSourcePos)
-> StateT Journal (ParsecT CustomErr Text m) SourcePos
-> StateT Journal (ParsecT CustomErr Text m) GenericSourcePos
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT Journal (ParsecT CustomErr Text m) SourcePos
forall e s (m :: * -> *). MonadParsec e s m => m SourcePos
getSourcePos
ParsecT CustomErr Text m ()
-> StateT Journal (ParsecT CustomErr Text m) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT CustomErr Text m Char -> ParsecT CustomErr Text m ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany ParsecT CustomErr Text m Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline)
Text
a <- JournalParser m Text
forall (m :: * -> *). JournalParser m Text
modifiedaccountnamep
ParsecT CustomErr Text m ()
-> StateT Journal (ParsecT CustomErr Text m) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT CustomErr Text m Char -> ParsecT CustomErr Text m ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany ParsecT CustomErr Text m Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline)
Quantity
hours <-
StateT Journal (ParsecT CustomErr Text m) Quantity
-> StateT Journal (ParsecT CustomErr Text m) Quantity
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT CustomErr Text m Text -> JournalParser m Text
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text m Text
forall (m :: * -> *). TextParser m Text
followingcommentp JournalParser m Text
-> StateT Journal (ParsecT CustomErr Text m) Quantity
-> StateT Journal (ParsecT CustomErr Text m) Quantity
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Quantity -> StateT Journal (ParsecT CustomErr Text m) Quantity
forall (m :: * -> *) a. Monad m => a -> m a
return 0)
StateT Journal (ParsecT CustomErr Text m) Quantity
-> StateT Journal (ParsecT CustomErr Text m) Quantity
-> StateT Journal (ParsecT CustomErr Text m) Quantity
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (StateT Journal (ParsecT CustomErr Text m) Quantity
forall (m :: * -> *). JournalParser m Quantity
timedotdurationp StateT Journal (ParsecT CustomErr Text m) Quantity
-> JournalParser m Text
-> StateT Journal (ParsecT CustomErr Text m) Quantity
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*
(JournalParser m Text -> JournalParser m Text
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT CustomErr Text m Text -> JournalParser m Text
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text m Text
forall (m :: * -> *). TextParser m Text
followingcommentp) JournalParser m Text
-> JournalParser m Text -> JournalParser m Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (StateT Journal (ParsecT CustomErr Text m) Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline StateT Journal (ParsecT CustomErr Text m) Char
-> JournalParser m Text -> JournalParser m Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> JournalParser m Text
forall (m :: * -> *) a. Monad m => a -> m a
return "")))
let t :: Transaction
t = Transaction
nulltransaction{
tsourcepos :: GenericSourcePos
tsourcepos = GenericSourcePos
pos,
tstatus :: Status
tstatus = Status
Cleared,
tpostings :: [Posting]
tpostings = [
Posting
nullposting{paccount :: Text
paccount=Text
a
,pamount :: MixedAmount
pamount=[Amount] -> MixedAmount
Mixed [Int -> Amount -> Amount
setAmountPrecision 2 (Amount -> Amount) -> Amount -> Amount
forall a b. (a -> b) -> a -> b
$ Quantity -> Amount
num Quantity
hours]
,ptype :: PostingType
ptype=PostingType
VirtualPosting
,ptransaction :: Maybe Transaction
ptransaction=Transaction -> Maybe Transaction
forall a. a -> Maybe a
Just Transaction
t
}
]
}
Transaction -> JournalParser m Transaction
forall (m :: * -> *) a. Monad m => a -> m a
return Transaction
t
timedotdurationp :: JournalParser m Quantity
timedotdurationp :: JournalParser m Quantity
timedotdurationp = JournalParser m Quantity -> JournalParser m Quantity
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try JournalParser m Quantity
forall (m :: * -> *). JournalParser m Quantity
timedotnumericp JournalParser m Quantity
-> JournalParser m Quantity -> JournalParser m Quantity
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> JournalParser m Quantity
forall (m :: * -> *). JournalParser m Quantity
timedotdotsp
timedotnumericp :: JournalParser m Quantity
timedotnumericp :: JournalParser m Quantity
timedotnumericp = do
(q :: Quantity
q, _, _, _) <- ParsecT
CustomErr Text m (Quantity, Int, Maybe Char, Maybe DigitGroupStyle)
-> StateT
Journal
(ParsecT CustomErr Text m)
(Quantity, Int, Maybe Char, Maybe DigitGroupStyle)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT
CustomErr Text m (Quantity, Int, Maybe Char, Maybe DigitGroupStyle)
-> StateT
Journal
(ParsecT CustomErr Text m)
(Quantity, Int, Maybe Char, Maybe DigitGroupStyle))
-> ParsecT
CustomErr Text m (Quantity, Int, Maybe Char, Maybe DigitGroupStyle)
-> StateT
Journal
(ParsecT CustomErr Text m)
(Quantity, Int, Maybe Char, Maybe DigitGroupStyle)
forall a b. (a -> b) -> a -> b
$ Maybe AmountStyle
-> ParsecT
CustomErr Text m (Quantity, Int, Maybe Char, Maybe DigitGroupStyle)
forall (m :: * -> *).
Maybe AmountStyle
-> TextParser m (Quantity, Int, Maybe Char, Maybe DigitGroupStyle)
numberp Maybe AmountStyle
forall a. Maybe a
Nothing
Maybe Text
msymbol <- StateT Journal (ParsecT CustomErr Text m) Text
-> StateT Journal (ParsecT CustomErr Text m) (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (StateT Journal (ParsecT CustomErr Text m) Text
-> StateT Journal (ParsecT CustomErr Text m) (Maybe Text))
-> StateT Journal (ParsecT CustomErr Text m) Text
-> StateT Journal (ParsecT CustomErr Text m) (Maybe Text)
forall a b. (a -> b) -> a -> b
$ [StateT Journal (ParsecT CustomErr Text m) Text]
-> StateT Journal (ParsecT CustomErr Text m) Text
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice ([StateT Journal (ParsecT CustomErr Text m) Text]
-> StateT Journal (ParsecT CustomErr Text m) Text)
-> [StateT Journal (ParsecT CustomErr Text m) Text]
-> StateT Journal (ParsecT CustomErr Text m) Text
forall a b. (a -> b) -> a -> b
$ ((Text, Quantity)
-> StateT Journal (ParsecT CustomErr Text m) Text)
-> [(Text, Quantity)]
-> [StateT Journal (ParsecT CustomErr Text m) Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> StateT Journal (ParsecT CustomErr Text m) Text
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string (Text -> StateT Journal (ParsecT CustomErr Text m) Text)
-> ((Text, Quantity) -> Text)
-> (Text, Quantity)
-> StateT Journal (ParsecT CustomErr Text m) Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Quantity) -> Text
forall a b. (a, b) -> a
fst) [(Text, Quantity)]
timeUnits
ParsecT CustomErr Text m ()
-> StateT Journal (ParsecT CustomErr Text m) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT CustomErr Text m Char -> ParsecT CustomErr Text m ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany ParsecT CustomErr Text m Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline)
let q' :: Quantity
q' =
case Maybe Text
msymbol of
Nothing -> Quantity
q
Just sym :: Text
sym ->
case Text -> [(Text, Quantity)] -> Maybe Quantity
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
sym [(Text, Quantity)]
timeUnits of
Just mult :: Quantity
mult -> Quantity
q Quantity -> Quantity -> Quantity
forall a. Num a => a -> a -> a
* Quantity
mult
Nothing -> Quantity
q
Quantity -> JournalParser m Quantity
forall (m :: * -> *) a. Monad m => a -> m a
return Quantity
q'
timeUnits :: [(Text, Quantity)]
timeUnits =
[("s",2.777777777777778e-4)
,("mo",5040)
,("m",1.6666666666666666e-2)
,("h",1)
,("d",24)
,("w",168)
,("y",61320)
]
timedotdotsp :: JournalParser m Quantity
timedotdotsp :: JournalParser m Quantity
timedotdotsp = do
StorageFormat
dots <- (Char -> Bool) -> StorageFormat -> StorageFormat
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not(Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Char -> Bool
isSpace) (StorageFormat -> StorageFormat)
-> StateT Journal (ParsecT CustomErr Text m) StorageFormat
-> StateT Journal (ParsecT CustomErr Text m) StorageFormat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT Journal (ParsecT CustomErr Text m) Char
-> StateT Journal (ParsecT CustomErr Text m) StorageFormat
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many ([Token Text]
-> StateT Journal (ParsecT CustomErr Text m) (Token Text)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
oneOf (". " :: [Char]))
Quantity -> JournalParser m Quantity
forall (m :: * -> *) a. Monad m => a -> m a
return (Quantity -> JournalParser m Quantity)
-> Quantity -> JournalParser m Quantity
forall a b. (a -> b) -> a -> b
$ (Quantity -> Quantity -> Quantity
forall a. Fractional a => a -> a -> a
/4) (Quantity -> Quantity) -> Quantity -> Quantity
forall a b. (a -> b) -> a -> b
$ Int -> Quantity
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Quantity) -> Int -> Quantity
forall a b. (a -> b) -> a -> b
$ StorageFormat -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length StorageFormat
dots