hledger/hledger-lib/Hledger/Read/TimedotReader.hs

{-|

A reader for the "timedot" file format.
Example:

@
#DATE
#ACCT DOTS  # Each dot represents 15m, spaces are ignored

# on 2/1, 1h was spent on FOSS haskell work, 0.25h on research, etc.
2/1
fos.haskell   .... ..
biz.research  .
inc.client1   .... .... .... .... .... ....

2/2
biz.research  .
inc.client1   .... .... ..

@

-}

module Hledger.Read.TimedotReader (
  -- * Reader
  reader,
  -- * Misc other exports
  timedotfilep,
  -- * Tests
  tests_Hledger_Read_TimedotReader
)
where
import Prelude ()
import Prelude.Compat
import Control.Monad (liftM)
import Control.Monad.Except (ExceptT)
import Data.Char (isSpace)
import Data.List (foldl')
import Data.Maybe
import Test.HUnit
import Text.Parsec hiding (parse)
import System.FilePath

import Hledger.Data
import Hledger.Read.Common (
  datep, numberp, emptyorcommentlinep, followingcommentp,
  parseAndFinaliseJournal, modifiedaccountnamep, genericSourcePos
  )
import Hledger.Utils hiding (ptrace)

-- easier to toggle this here sometimes
-- import qualified Hledger.Utils (ptrace)
-- ptrace = Hledger.Utils.ptrace
ptrace = return

reader :: Reader
reader = Reader format detect parse

format :: String
format = "timedot"

-- | Does the given file path and data look like it might contain this format ?
detect :: FilePath -> String -> Bool
detect f s
  | f /= "-"  = takeExtension f == '.':format -- from a file: yes if the extension matches the format name
  | otherwise = regexMatches "(^|\n)[0-9]" s  -- from stdin: yes if we can see a possible timedot day entry (digits in column 0)

-- | Parse and post-process a "Journal" from the timedot format, or give an error.
parse :: Maybe FilePath -> Bool -> FilePath -> String -> ExceptT String IO Journal
parse _ = parseAndFinaliseJournal timedotfilep

timedotfilep :: ParsecT [Char] JournalContext (ExceptT String IO) (JournalUpdate, JournalContext)
timedotfilep = do items <- many timedotfileitemp
                  eof
                  ctx <- getState
                  return (liftM (foldl' (\acc new x -> new (acc x)) id) $ sequence items, ctx)
    where
      timedotfileitemp = do
        ptrace "timedotfileitemp"
        choice [
         emptyorcommentlinep >> return (return id),
         liftM (return . addTransactions) timedotdayp
         ] <?> "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)

-- | Parse timedot day entries to zero or more time transactions for that day.
-- @
-- 2/1
-- fos.haskell  .... ..
-- biz.research .
-- inc.client1  .... .... .... .... .... ....
-- @
timedotdayp :: ParsecT [Char] JournalContext (ExceptT String IO) [Transaction]
timedotdayp = do
  ptrace " timedotdayp"
  d <- datep <* eolof
  es <- catMaybes <$> many (const Nothing <$> try emptyorcommentlinep <|>
                            Just <$> (notFollowedBy datep >> timedotentryp))
  return $ map (\t -> t{tdate=d}) es -- <$> many timedotentryp

-- | Parse a single timedot entry to one (dateless) transaction.
-- @
-- fos.haskell  .... ..
-- @
timedotentryp :: ParsecT [Char] JournalContext (ExceptT String IO) Transaction
timedotentryp = do
  ptrace "  timedotentryp"
  pos <- genericSourcePos <$> getPosition
  many spacenonewline
  a <- modifiedaccountnamep
  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]  -- don't assume hours; do set precision to 2
                     ,ptype=VirtualPosting
                     ,ptransaction=Just t
                     }
          ]
        }
  return t

timedotdurationp :: ParsecT [Char] JournalContext (ExceptT String IO) Quantity
timedotdurationp = try timedotnumberp <|> timedotdotsp

-- | Parse a duration written as a decimal number of hours (optionally followed by the letter h).
-- @
-- 1.5h
-- @
timedotnumberp :: ParsecT [Char] JournalContext (ExceptT String IO) Quantity
timedotnumberp = do
   (q, _, _, _) <- numberp
   many spacenonewline
   optional $ char 'h'
   many spacenonewline
   return q

-- | Parse a quantity written as a line of dots, each representing 0.25.
-- @
-- .... ..
-- @
timedotdotsp :: ParsecT [Char] JournalContext (ExceptT String IO) Quantity
timedotdotsp = do
  dots <- filter (not.isSpace) <$> many (oneOf ". ")
  return $ (/4) $ fromIntegral $ length dots

tests_Hledger_Read_TimedotReader = TestList [
 ]