reader code cleanups

This commit is contained in:
Simon Michael 2012-03-10 18:13:32 +00:00
parent 120a9fd0e1
commit 2e8cf1c7f2
2 changed files with 29 additions and 21 deletions

View File

@ -175,11 +175,14 @@ type JournalUpdate = ErrorT String IO (Journal -> Journal)
-- | A hledger journal reader is a triple of format name, format-detecting
-- predicate, and a parser to Journal.
data Reader = Reader {rFormat :: String
,rDetector :: FilePath -> String -> Bool
,rParser :: FilePath -> String -> ErrorT String IO Journal
data Reader = Reader {
-- name of the format this reader handles
rFormat :: String
-- quickly check if this reader can probably handle the given file path and file content
,rDetector :: FilePath -> String -> Bool
-- really parse the given file path and file content, returning a journal or error
,rParser :: FilePath -> String -> ErrorT String IO Journal
}
data Ledger = Ledger {
journal :: Journal,
accountnametree :: Tree AccountName,

View File

@ -45,44 +45,49 @@ journalenvvar = "LEDGER_FILE"
journalenvvar2 = "LEDGER"
journaldefaultfilename = ".hledger.journal"
-- Here are the available readers. The first is the default, used for unknown data formats.
-- The available data file readers, each one handling a particular data
-- format. The first is also used as the default for unknown formats.
readers :: [Reader]
readers = [
JournalReader.reader
,TimelogReader.reader
]
formats = map rFormat readers
-- | All the data formats we can read.
formats = map rFormat readers
-- | Find the reader which can handle the given format, if any.
-- Typically there is just one; only the first is returned.
readerForFormat :: String -> Maybe Reader
readerForFormat s | null rs = Nothing
| otherwise = Just $ head rs
where
rs = filter ((s==).rFormat) readers :: [Reader]
-- | Read a Journal from this string (and file path), auto-detecting the
-- data format, or give a useful error string. Tries to parse each known
-- data format in turn. If none succeed, gives the error message specific
-- to the intended data format, which if not specified is guessed from the
-- file suffix and possibly the data.
-- | Do our best to read a Journal from this string using the specified
-- data format, or if unspecified, trying all supported formats until one
-- succeeds. The file path is provided as an extra hint. Returns an error
-- message if the format is unsupported or if it is supported but parsing
-- fails.
journalFromPathAndString :: Maybe String -> FilePath -> String -> IO (Either String Journal)
journalFromPathAndString format fp s = do
let readers' = case format of Just f -> case readerForFormat f of Just r -> [r]
Nothing -> []
Nothing -> readers
(errors, journals) <- partitionEithers `fmap` mapM tryReader readers'
let readerstotry = case format of Nothing -> readers
Just f -> case readerForFormat f of Just r -> [r]
Nothing -> []
(errors, journals) <- partitionEithers `fmap` mapM tryReader readerstotry
case journals of j:_ -> return $ Right j
_ -> return $ Left $ errMsg errors
_ -> return $ Left $ bestErrorMsg errors
where
tryReader r = (runErrorT . (rParser r) fp) s
errMsg [] = unknownFormatMsg
errMsg es = printf "could not parse %s data in %s\n%s" (rFormat r) fp e
where (r,e) = headDef (head readers, head es) $ filter detects $ zip readers es
detects (r,_) = (rDetector r) fp s
unknownFormatMsg = printf "could not parse %sdata in %s" (fmt formats) fp
-- unknown format
bestErrorMsg [] = printf "could not parse %sdata in %s" (fmt formats) fp
where fmt [] = ""
fmt [f] = f ++ " "
fmt fs = intercalate ", " (init fs) ++ " or " ++ last fs ++ " "
-- one or more errors - report (the most appropriate ?) one
bestErrorMsg es = printf "could not parse %s data in %s\n%s" (rFormat r) fp e
where (r,e) = headDef (head readers, head es) $ filter detects $ zip readers es
detects (r,_) = (rDetector r) fp s
-- | Read a journal from this file, using the specified data format or
-- trying all known formats, or give an error string.