{-# 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