99 lines
2.9 KiB
Haskell
99 lines
2.9 KiB
Haskell
{-# LANGUAGE ApplicativeDo #-}
|
|
{-# LANGUAGE DerivingVia #-}
|
|
{-# LANGUAGE NamedFieldPuns #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE StrictData #-}
|
|
module Hledger.Row
|
|
( Task
|
|
, task
|
|
, getTask
|
|
, Row(..)
|
|
, RowContent(..)
|
|
, Operation(..)
|
|
, encode
|
|
, decode
|
|
, encodeFile
|
|
, decodeFile
|
|
)
|
|
where
|
|
|
|
import Conduit (ConduitT, (.|))
|
|
import Control.Applicative ((<|>))
|
|
import qualified Data.Attoparsec.ByteString.Char8 as P
|
|
import Data.ByteString (ByteString)
|
|
import qualified Data.ByteString.Char8 as BC
|
|
import qualified Data.Conduit.Combinators as Conduit
|
|
import Data.Text (Text)
|
|
import qualified Data.Text as T
|
|
import qualified Data.Text.Encoding as TE
|
|
import Data.Time (LocalTime, defaultTimeLocale, formatTime, parseTimeM)
|
|
|
|
|
|
newtype Task = Task { getTask :: Text }
|
|
deriving (Eq, Show) via Text
|
|
|
|
task :: Text -> Maybe Task
|
|
task "" = Nothing
|
|
task x = Just $ Task x
|
|
|
|
data Operation
|
|
= In Task
|
|
| Out
|
|
deriving (Eq, Show)
|
|
|
|
data Row
|
|
= Row RowContent
|
|
| Empty
|
|
deriving (Show, Eq)
|
|
|
|
data RowContent = RowContent
|
|
{ rowOperation :: Operation
|
|
, rowTime :: LocalTime
|
|
}
|
|
deriving (Eq, Show)
|
|
|
|
encode :: Row -> ByteString
|
|
encode Empty = ""
|
|
encode (Row (RowContent{rowOperation = In (Task t), rowTime})) =
|
|
"i" <> " " <>
|
|
BC.pack (formatTime defaultTimeLocale "%Y-%m-%d %H:%M:%S" rowTime) <> " " <>
|
|
TE.encodeUtf8 t
|
|
encode (Row (RowContent{rowOperation = Out, rowTime})) =
|
|
"o" <> " " <>
|
|
BC.pack (formatTime defaultTimeLocale "%Y-%m-%d %H:%M:%S" rowTime)
|
|
|
|
decode :: ByteString -> Either String Row
|
|
decode = P.parseOnly ((Row <$> parseRow) <|> (Empty <$ parseEmpty))
|
|
where
|
|
parseEmpty = P.skipSpace <* P.endOfInput
|
|
parseRow :: P.Parser RowContent
|
|
parseRow = do
|
|
P.skipSpace
|
|
-- See the data model above, the operation is dependent on the task,
|
|
-- hence the monadic parser
|
|
op <- parseOp
|
|
time <- parseTime
|
|
t <- parseTask op
|
|
pure $ RowContent t time
|
|
parseOp :: P.Parser (Task -> Operation)
|
|
parseOp = (In <$ P.char 'i' <* P.skipSpace) <|> (const Out <$ P.char 'o' <* P.skipSpace)
|
|
parseTime :: P.Parser LocalTime
|
|
parseTime = do
|
|
-- I'm assuming that '2022-08-15 17:02:00' has 19 characters
|
|
-- The input is ByteString, but since 'parseTime' eventually wants
|
|
-- String, I'm decoding it first to Text while retaining the decoding
|
|
-- error.
|
|
timeStr <- either (fail . show) (pure . T.unpack) . TE.decodeUtf8' =<< P.take 19
|
|
P.skipSpace
|
|
parseTimeM False defaultTimeLocale "%Y-%m-%d %H:%M:%S" timeStr
|
|
parseTask :: (Task -> Operation) -> P.Parser Operation
|
|
parseTask op = do
|
|
either (fail . show) (pure . op . Task) . TE.decodeUtf8' =<< P.takeByteString
|
|
|
|
-- | Decode a file containing the hledger clock-ins and clock-uts
|
|
decodeFile :: Monad m => ConduitT ByteString Row m ()
|
|
decodeFile = Conduit.linesUnboundedAscii .| Conduit.concatMap decode
|
|
|
|
encodeFile :: Monad m => ConduitT Row ByteString m ()
|
|
encodeFile = Conduit.map encode .| Conduit.unlinesAscii
|