module Hledger.Read.Common
where
import Control.Monad.Error
import Hledger.Data.Utils
import Hledger.Data.Types (Journal)
import Hledger.Data.Journal
import System.Directory (getHomeDirectory)
import System.FilePath(takeDirectory,combine)
import System.Time (getClockTime)
import Text.ParserCombinators.Parsec
data Reader = Reader {rFormat :: String
,rDetector :: FilePath -> String -> Bool
,rParser :: FilePath -> String -> ErrorT String IO Journal
}
type JournalUpdate = ErrorT String IO (Journal -> Journal)
parseJournalWith :: (GenParser Char JournalContext JournalUpdate) -> FilePath -> String -> ErrorT String IO Journal
parseJournalWith p f s = do
tc <- liftIO getClockTime
tl <- liftIO getCurrentLocalTime
case runParser p emptyCtx f s of
Right updates -> liftM (journalFinalise tc tl f s) $ updates `ap` return nulljournal
Left err -> throwError $ show err
data JournalContext = Ctx {
ctxYear :: !(Maybe Integer)
, ctxCommod :: !(Maybe String)
, ctxAccount :: ![String]
} deriving (Read, Show)
emptyCtx :: JournalContext
emptyCtx = Ctx { ctxYear = Nothing, ctxCommod = Nothing, ctxAccount = [] }
setYear :: Integer -> GenParser tok JournalContext ()
setYear y = updateState (\ctx -> ctx{ctxYear=Just y})
getYear :: GenParser tok JournalContext (Maybe Integer)
getYear = liftM ctxYear getState
pushParentAccount :: String -> GenParser tok JournalContext ()
pushParentAccount parent = updateState addParentAccount
where addParentAccount ctx0 = ctx0 { ctxAccount = normalize parent : ctxAccount ctx0 }
normalize = (++ ":")
popParentAccount :: GenParser tok JournalContext ()
popParentAccount = do ctx0 <- getState
case ctxAccount ctx0 of
[] -> unexpected "End of account block with no beginning"
(_:rest) -> setState $ ctx0 { ctxAccount = rest }
getParentAccount :: GenParser tok JournalContext String
getParentAccount = liftM (concat . reverse . ctxAccount) getState
expandPath :: (MonadIO m) => SourcePos -> FilePath -> m FilePath
expandPath pos fp = liftM mkRelative (expandHome fp)
where
mkRelative = combine (takeDirectory (sourceName pos))
expandHome inname | "~/" `isPrefixOf` inname = do homedir <- liftIO getHomeDirectory
return $ homedir ++ drop 1 inname
| otherwise = return inname
fileSuffix :: FilePath -> String
fileSuffix = reverse . takeWhile (/='.') . reverse . dropWhile (/='.')