slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

lib: some Hledger.Read cleanup

Browse Source
This commit is contained in:
Simon Michael 2016-11-17 20:20:07 -08:00
parent 3ddc9d7432
commit 12151e05c0
1 changed files with 137 additions and 100 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

237
hledger-lib/Hledger/Read.hs
View File

@ -5,37 +5,59 @@ Journals from various data formats. Use this module if you want to parse
journal data or read journal files. Generally it should not be necessary journal data or read journal files. Generally it should not be necessary
to import modules below this one. to import modules below this one.
Here's how most of these functions fit together:
@
readJournalFiles
readJournalFile
requireJournalFileExists
readJournal
readersFor
readerForStorageFormat
readersForPathAndData
tryReaders
@
-} -}
{-# LANGUAGE ScopedTypeVariables, OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables, OverloadedStrings #-}
module Hledger.Read module Hledger.Read (
(
module Hledger.Read.Common, -- * Journal files
readFormatNames, defaultJournal,
-- * Journal reading API defaultJournalPath,
defaultJournalPath, readJournalFiles,
defaultJournal, readJournalFile,
readJournal, requireJournalFileExists,
readJournal', ensureJournalFileExists,
readJournalFile,
readJournalFiles, -- * Journal parsing
requireJournalFileExists, readJournal,
ensureJournalFileExists, readersFor,
-- * Parsers used elsewhere readerForStorageFormat,
postingp, readersForPathAndData,
-- accountnamep, tryReaders,
-- amountp, readJournal',
-- amountp', readFormatNames,
-- mamountp',
-- numberp, -- * Re-exported
-- codep, -- accountnamep,
accountaliasp, -- amountp,
-- * Tests -- amountp',
samplejournal, -- mamountp',
tests_Hledger_Read, -- numberp,
) -- codep,
where accountaliasp,
postingp,
module Hledger.Read.Common,
-- * Tests
samplejournal,
tests_Hledger_Read,
) where
import qualified Control.Exception as C import qualified Control.Exception as C
import Control.Monad.Except import Control.Monad.Except
import Data.List import Data.List
@ -81,69 +103,47 @@ journalEnvVar = "LEDGER_FILE"
journalEnvVar2 = "LEDGER" journalEnvVar2 = "LEDGER"
journalDefaultFilename = ".hledger.journal" journalDefaultFilename = ".hledger.journal"
-- | Which readers are worth trying for this (possibly unspecified) format, filepath, and data ? -- | Read the default journal file specified by the environment, or raise an error.
readersFor :: (Maybe StorageFormat, Maybe FilePath, Text) -> [Reader] defaultJournal :: IO Journal
readersFor (format,path,t) = defaultJournal = defaultJournalPath >>= readJournalFile Nothing Nothing True >>= either error' return
dbg1 ("possible readers for "++show (format,path,textElideRight 30 t)) $
case format of
Just f -> case readerForStorageFormat f of Just r -> [r]
Nothing -> []
Nothing -> case path of Nothing -> readers
Just p -> case readersForPathAndData (p,t) of [] -> readers
rs -> rs
-- | Find the (first) reader which can handle the given format, if any. -- | Get the default journal file path specified by the environment.
readerForStorageFormat :: StorageFormat -> Maybe Reader -- Like ledger, we look first for the LEDGER_FILE environment
readerForStorageFormat s | null rs = Nothing -- variable, and if that does not exist, for the legacy LEDGER
| otherwise = Just $ head rs -- environment variable. If neither is set, or the value is blank,
-- return the hard-coded default, which is @.hledger.journal@ in the
-- users's home directory (or in the current directory, if we cannot
-- determine a home directory).
defaultJournalPath :: IO String
defaultJournalPath = do
s <- envJournalPath
if null s then defaultJournalPath else return s
where where
rs = filter ((s==).rFormat) readers :: [Reader] envJournalPath =
getEnv journalEnvVar
`C.catch` (\(_::C.IOException) -> getEnv journalEnvVar2
`C.catch` (\(_::C.IOException) -> return ""))
defaultJournalPath = do
home <- getHomeDirectory `C.catch` (\(_::C.IOException) -> return "")
return $ home </> journalDefaultFilename
-- | Find the readers which think they can handle the given file path and data, if any. -- | @readJournalFiles mformat mrulesfile assrt fs@
readersForPathAndData :: (FilePath,Text) -> [Reader]
readersForPathAndData (f,t) = filter (\r -> dbg1 ("try "++rFormat r++" format") $ (rDetector r) f t) readers
-- try each reader in turn, returning the error of the first if all fail
tryReaders :: [Reader] -> Maybe FilePath -> Bool -> Maybe FilePath -> Text -> IO (Either String Journal)
tryReaders readers mrulesfile assrt path t = firstSuccessOrBestError [] readers
where
firstSuccessOrBestError :: [String] -> [Reader] -> IO (Either String Journal)
firstSuccessOrBestError [] [] = return $ Left "no readers found"
firstSuccessOrBestError errs (r:rs) = do
dbg1IO "trying reader" (rFormat r)
result <- (runExceptT . (rParser r) mrulesfile assrt path') t
dbg1IO "reader result" $ either id show result
case result of Right j -> return $ Right j -- success!
Left e -> firstSuccessOrBestError (errs++[e]) rs -- keep trying
firstSuccessOrBestError (e:_) [] = return $ Left e -- none left, return first error
path' = fromMaybe "(string)" path
-- | Read a journal from this string, trying whatever readers seem appropriate:
-- --
-- - if a format is specified, try that reader only -- Call readJournalFile on each specified file path, and combine the
--
-- - or if one or more readers recognises the file path and data, try those
--
-- - otherwise, try them all.
--
-- A CSV conversion rules file may also be specified for use by the CSV reader.
-- Also there is a flag specifying whether to check or ignore balance assertions in the journal.
readJournal :: Maybe StorageFormat -> Maybe FilePath -> Bool -> Maybe FilePath -> Text -> IO (Either String Journal)
readJournal mformat mrulesfile assrt mpath t = tryReaders (readersFor (mformat, mpath, t)) mrulesfile assrt mpath t
-- | Call readJournalFile on each specified file path, and combine the
-- resulting journals into one. If there are any errors, the first is -- resulting journals into one. If there are any errors, the first is
-- returned, otherwise they are combined per Journal's monoid instance -- returned, otherwise they are combined per Journal's monoid instance
-- (concatenated, basically). Parse context (eg directives & aliases) -- (concatenated, basically). Parse context (eg directives & aliases)
-- is not maintained across file boundaries, it resets at the start of -- is not maintained across file boundaries, it resets at the start of
-- each file (though the rfinal parse state saved in the resulting -- each file (though the final parse state saved in the resulting
-- journal is the combination of parse states from all files). -- journal is the combination of parse states from all files).
readJournalFiles :: Maybe StorageFormat -> Maybe FilePath -> Bool -> [FilePath] -> IO (Either String Journal) readJournalFiles :: Maybe StorageFormat -> Maybe FilePath -> Bool -> [FilePath] -> IO (Either String Journal)
readJournalFiles mformat mrulesfile assrt fs = do readJournalFiles mformat mrulesfile assrt fs = do
(either Left (Right . mconcat) . sequence) (either Left (Right . mconcat) . sequence)
<$> mapM (readJournalFile mformat mrulesfile assrt) fs <$> mapM (readJournalFile mformat mrulesfile assrt) fs
-- | Read a Journal from this file (or stdin if the filename is -) or give -- | @readJournalFile mformat mrulesfile assrt f@
--
-- Read a Journal from this file (or stdin if the filename is -) or give
-- an error message, using the specified data format or trying all known -- an error message, using the specified data format or trying all known
-- formats. A CSV conversion rules file may be specified for better -- formats. A CSV conversion rules file may be specified for better
-- conversion of that format. Also there is a flag specifying whether -- conversion of that format. Also there is a flag specifying whether
@ -180,30 +180,6 @@ newJournalContent = do
d <- getCurrentDay d <- getCurrentDay
return $ printf "; journal created %s by hledger\n" (show d) return $ printf "; journal created %s by hledger\n" (show d)
-- | Get the default journal file path specified by the environment.
-- Like ledger, we look first for the LEDGER_FILE environment
-- variable, and if that does not exist, for the legacy LEDGER
-- environment variable. If neither is set, or the value is blank,
-- return the hard-coded default, which is @.hledger.journal@ in the
-- users's home directory (or in the current directory, if we cannot
-- determine a home directory).
defaultJournalPath :: IO String
defaultJournalPath = do
s <- envJournalPath
if null s then defaultJournalPath else return s
where
envJournalPath =
getEnv journalEnvVar
`C.catch` (\(_::C.IOException) -> getEnv journalEnvVar2
`C.catch` (\(_::C.IOException) -> return ""))
defaultJournalPath = do
home <- getHomeDirectory `C.catch` (\(_::C.IOException) -> return "")
return $ home </> journalDefaultFilename
-- | Read the default journal file specified by the environment, or raise an error.
defaultJournal :: IO Journal
defaultJournal = defaultJournalPath >>= readJournalFile Nothing Nothing True >>= either error' return
-- | Read a journal from the given text, trying all known formats, or simply throw an error. -- | Read a journal from the given text, trying all known formats, or simply throw an error.
readJournal' :: Text -> IO Journal readJournal' :: Text -> IO Journal
readJournal' t = readJournal Nothing Nothing True Nothing t >>= either error' return readJournal' t = readJournal Nothing Nothing True Nothing t >>= either error' return
@ -214,6 +190,67 @@ tests_readJournal' = [
assertBool "" True assertBool "" True
] ]
-- | @readJournal mformat mrulesfile assrt mpath t@
--
-- Read a journal from this string, trying whatever readers seem appropriate:
--
-- - if a format is specified, try that reader only
--
-- - or if one or more readers recognises the file path and data, try those
--
-- - otherwise, try them all.
--
-- A CSV conversion rules file may also be specified for use by the CSV reader.
-- Also there is a flag specifying whether to check or ignore balance assertions in the journal.
readJournal :: Maybe StorageFormat -> Maybe FilePath -> Bool -> Maybe FilePath -> Text -> IO (Either String Journal)
readJournal mformat mrulesfile assrt mpath t =
let rs = readersFor (mformat, mpath, t)
in tryReaders rs mrulesfile assrt mpath t
-- | @readersFor (format,path,t)@
--
-- Which readers are worth trying for this (possibly unspecified) format, filepath, and data ?
readersFor :: (Maybe StorageFormat, Maybe FilePath, Text) -> [Reader]
readersFor (format,path,t) =
dbg1 ("possible readers for "++show (format,path,textElideRight 30 t)) $
case format of
Just f -> case readerForStorageFormat f of Just r -> [r]
Nothing -> []
Nothing -> case path of Nothing -> readers
Just p -> case readersForPathAndData (p,t) of [] -> readers
rs -> rs
-- | Find the (first) reader which can handle the given format, if any.
readerForStorageFormat :: StorageFormat -> Maybe Reader
readerForStorageFormat s | null rs = Nothing
| otherwise = Just $ head rs
where
rs = filter ((s==).rFormat) readers :: [Reader]
-- | Find the readers which think they can handle the given file path and data, if any.
readersForPathAndData :: (FilePath,Text) -> [Reader]
readersForPathAndData (f,t) = filter (\r -> dbg1 ("try "++rFormat r++" format") $ (rDetector r) f t) readers
-- | @tryReaders readers mrulesfile assrt path t@
--
-- Try to parse the given text to a Journal using each reader in turn,
-- returning the first success, or if all of them fail, the first error message.
tryReaders :: [Reader] -> Maybe FilePath -> Bool -> Maybe FilePath -> Text -> IO (Either String Journal)
tryReaders readers mrulesfile assrt path t = firstSuccessOrFirstError [] readers
where
firstSuccessOrFirstError :: [String] -> [Reader] -> IO (Either String Journal)
firstSuccessOrFirstError [] [] = return $ Left "no readers found"
firstSuccessOrFirstError errs (r:rs) = do
dbg1IO "trying reader" (rFormat r)
result <- (runExceptT . (rParser r) mrulesfile assrt path') t
dbg1IO "reader result" $ either id show result
case result of Right j -> return $ Right j -- success!
Left e -> firstSuccessOrFirstError (errs++[e]) rs -- keep trying
firstSuccessOrFirstError (e:_) [] = return $ Left e -- none left, return first error
path' = fromMaybe "(string)" path
-- tests -- tests
samplejournal = readJournal' $ T.unlines samplejournal = readJournal' $ T.unlines