|
|
|
@ -11,17 +11,17 @@ A reader for CSV data, using an extra rules file to help interpret the data.
|
|
|
|
|
-- stack haddock hledger-lib --fast --no-haddock-deps --haddock-arguments='--ignore-all-exports' --open
|
|
|
|
|
|
|
|
|
|
--- ** language
|
|
|
|
|
{-# LANGUAGE FlexibleContexts #-}
|
|
|
|
|
{-# LANGUAGE FlexibleInstances #-}
|
|
|
|
|
{-# LANGUAGE MultiWayIf #-}
|
|
|
|
|
{-# LANGUAGE NamedFieldPuns #-}
|
|
|
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
|
{-# LANGUAGE PackageImports #-}
|
|
|
|
|
{-# LANGUAGE RecordWildCards #-}
|
|
|
|
|
{-# LANGUAGE ScopedTypeVariables #-}
|
|
|
|
|
{-# LANGUAGE TypeFamilies #-}
|
|
|
|
|
{-# LANGUAGE FlexibleContexts #-}
|
|
|
|
|
{-# LANGUAGE FlexibleInstances #-}
|
|
|
|
|
{-# LANGUAGE MultiWayIf #-}
|
|
|
|
|
{-# LANGUAGE NamedFieldPuns #-}
|
|
|
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
|
{-# LANGUAGE PackageImports #-}
|
|
|
|
|
{-# LANGUAGE RecordWildCards #-}
|
|
|
|
|
{-# LANGUAGE ScopedTypeVariables #-}
|
|
|
|
|
{-# LANGUAGE TypeFamilies #-}
|
|
|
|
|
{-# LANGUAGE TypeSynonymInstances #-}
|
|
|
|
|
{-# LANGUAGE ViewPatterns #-}
|
|
|
|
|
{-# LANGUAGE ViewPatterns #-}
|
|
|
|
|
|
|
|
|
|
--- ** exports
|
|
|
|
|
module Hledger.Read.CsvReader (
|
|
|
|
@ -52,7 +52,6 @@ import Control.Monad.Trans.Class (lift)
|
|
|
|
|
import Data.Char (toLower, isDigit, isSpace, isAlphaNum, isAscii, ord)
|
|
|
|
|
import Data.Bifunctor (first)
|
|
|
|
|
import "base-compat-batteries" Data.List.Compat
|
|
|
|
|
import qualified Data.List.Split as LS (splitOn)
|
|
|
|
|
import Data.Maybe (catMaybes, fromMaybe, isJust)
|
|
|
|
|
import Data.MemoUgly (memo)
|
|
|
|
|
import Data.Ord (comparing)
|
|
|
|
@ -61,6 +60,8 @@ import Data.Text (Text)
|
|
|
|
|
import qualified Data.Text as T
|
|
|
|
|
import qualified Data.Text.Encoding as T
|
|
|
|
|
import qualified Data.Text.IO as T
|
|
|
|
|
import qualified Data.Text.Lazy as TL
|
|
|
|
|
import qualified Data.Text.Lazy.Builder as TB
|
|
|
|
|
import Data.Time.Calendar (Day)
|
|
|
|
|
import Data.Time.Format (parseTimeM, defaultTimeLocale)
|
|
|
|
|
import Safe (atMay, headMay, lastMay, readDef, readMay)
|
|
|
|
@ -88,7 +89,7 @@ import Hledger.Read.Common (aliasesFromOpts, Reader(..),InputOpts(..), amountp,
|
|
|
|
|
|
|
|
|
|
type CSV = [CsvRecord]
|
|
|
|
|
type CsvRecord = [CsvValue]
|
|
|
|
|
type CsvValue = String
|
|
|
|
|
type CsvValue = Text
|
|
|
|
|
|
|
|
|
|
--- ** reader
|
|
|
|
|
|
|
|
|
@ -164,7 +165,7 @@ defaultRulesText csvfile = T.pack $ unlines
|
|
|
|
|
," account2 assets:bank:savings\n"
|
|
|
|
|
]
|
|
|
|
|
|
|
|
|
|
addDirective :: (DirectiveName, String) -> CsvRulesParsed -> CsvRulesParsed
|
|
|
|
|
addDirective :: (DirectiveName, Text) -> CsvRulesParsed -> CsvRulesParsed
|
|
|
|
|
addDirective d r = r{rdirectives=d:rdirectives r}
|
|
|
|
|
|
|
|
|
|
addAssignment :: (HledgerFieldName, FieldTemplate) -> CsvRulesParsed -> CsvRulesParsed
|
|
|
|
@ -181,7 +182,7 @@ addAssignmentsFromList fs r = foldl' maybeAddAssignment r journalfieldnames
|
|
|
|
|
where
|
|
|
|
|
maybeAddAssignment rules f = (maybe id addAssignmentFromIndex $ elemIndex f fs) rules
|
|
|
|
|
where
|
|
|
|
|
addAssignmentFromIndex i = addAssignment (f, "%"++show (i+1))
|
|
|
|
|
addAssignmentFromIndex i = addAssignment (f, T.pack $ '%':show (i+1))
|
|
|
|
|
|
|
|
|
|
addConditionalBlock :: ConditionalBlock -> CsvRulesParsed -> CsvRulesParsed
|
|
|
|
|
addConditionalBlock b r = r{rconditionalblocks=b:rconditionalblocks r}
|
|
|
|
@ -240,7 +241,7 @@ validateRules rules = do
|
|
|
|
|
-- | A set of data definitions and account-matching patterns sufficient to
|
|
|
|
|
-- convert a particular CSV data file into meaningful journal transactions.
|
|
|
|
|
data CsvRules' a = CsvRules' {
|
|
|
|
|
rdirectives :: [(DirectiveName,String)],
|
|
|
|
|
rdirectives :: [(DirectiveName,Text)],
|
|
|
|
|
-- ^ top-level rules, as (keyword, value) pairs
|
|
|
|
|
rcsvfieldindexes :: [(CsvFieldName, CsvFieldIndex)],
|
|
|
|
|
-- ^ csv field names and their column number, if declared by a fields list
|
|
|
|
@ -260,7 +261,7 @@ type CsvRulesParsed = CsvRules' ()
|
|
|
|
|
-- | Type used after parsing is done. Directives, assignments and conditional blocks
|
|
|
|
|
-- are in the same order as they were in the unput file and rblocksassigning is functional.
|
|
|
|
|
-- Ready to be used for CSV record processing
|
|
|
|
|
type CsvRules = CsvRules' (String -> [ConditionalBlock])
|
|
|
|
|
type CsvRules = CsvRules' (Text -> [ConditionalBlock])
|
|
|
|
|
|
|
|
|
|
instance Eq CsvRules where
|
|
|
|
|
r1 == r2 = (rdirectives r1, rcsvfieldindexes r1, rassignments r1) ==
|
|
|
|
@ -277,27 +278,27 @@ instance Show CsvRules where
|
|
|
|
|
type CsvRulesParser a = StateT CsvRulesParsed SimpleTextParser a
|
|
|
|
|
|
|
|
|
|
-- | The keyword of a CSV rule - "fields", "skip", "if", etc.
|
|
|
|
|
type DirectiveName = String
|
|
|
|
|
type DirectiveName = Text
|
|
|
|
|
|
|
|
|
|
-- | CSV field name.
|
|
|
|
|
type CsvFieldName = String
|
|
|
|
|
type CsvFieldName = Text
|
|
|
|
|
|
|
|
|
|
-- | 1-based CSV column number.
|
|
|
|
|
type CsvFieldIndex = Int
|
|
|
|
|
|
|
|
|
|
-- | Percent symbol followed by a CSV field name or column number. Eg: %date, %1.
|
|
|
|
|
type CsvFieldReference = String
|
|
|
|
|
type CsvFieldReference = Text
|
|
|
|
|
|
|
|
|
|
-- | One of the standard hledger fields or pseudo-fields that can be assigned to.
|
|
|
|
|
-- Eg date, account1, amount, amount1-in, date-format.
|
|
|
|
|
type HledgerFieldName = String
|
|
|
|
|
type HledgerFieldName = Text
|
|
|
|
|
|
|
|
|
|
-- | A text value to be assigned to a hledger field, possibly
|
|
|
|
|
-- containing csv field references to be interpolated.
|
|
|
|
|
type FieldTemplate = String
|
|
|
|
|
type FieldTemplate = Text
|
|
|
|
|
|
|
|
|
|
-- | A strptime date parsing pattern, as supported by Data.Time.Format.
|
|
|
|
|
type DateFormat = String
|
|
|
|
|
type DateFormat = Text
|
|
|
|
|
|
|
|
|
|
-- | A prefix for a matcher test, either & or none (implicit or).
|
|
|
|
|
data MatcherPrefix = And | None
|
|
|
|
@ -453,16 +454,16 @@ commentlinep = lift skipNonNewlineSpaces >> commentcharp >> lift restofline >> r
|
|
|
|
|
commentcharp :: CsvRulesParser Char
|
|
|
|
|
commentcharp = oneOf (";#*" :: [Char])
|
|
|
|
|
|
|
|
|
|
directivep :: CsvRulesParser (DirectiveName, String)
|
|
|
|
|
directivep :: CsvRulesParser (DirectiveName, Text)
|
|
|
|
|
directivep = (do
|
|
|
|
|
lift $ dbgparse 8 "trying directive"
|
|
|
|
|
d <- fmap T.unpack $ choiceInState $ map (lift . string . T.pack) directives
|
|
|
|
|
d <- choiceInState $ map (lift . string) directives
|
|
|
|
|
v <- (((char ':' >> lift (many spacenonewline)) <|> lift (some spacenonewline)) >> directivevalp)
|
|
|
|
|
<|> (optional (char ':') >> lift skipNonNewlineSpaces >> lift eolof >> return "")
|
|
|
|
|
return (d, v)
|
|
|
|
|
) <?> "directive"
|
|
|
|
|
|
|
|
|
|
directives :: [String]
|
|
|
|
|
directives :: [Text]
|
|
|
|
|
directives =
|
|
|
|
|
["date-format"
|
|
|
|
|
,"decimal-mark"
|
|
|
|
@ -474,8 +475,8 @@ directives =
|
|
|
|
|
, "balance-type"
|
|
|
|
|
]
|
|
|
|
|
|
|
|
|
|
directivevalp :: CsvRulesParser String
|
|
|
|
|
directivevalp = anySingle `manyTill` lift eolof
|
|
|
|
|
directivevalp :: CsvRulesParser Text
|
|
|
|
|
directivevalp = T.pack <$> anySingle `manyTill` lift eolof
|
|
|
|
|
|
|
|
|
|
fieldnamelistp :: CsvRulesParser [CsvFieldName]
|
|
|
|
|
fieldnamelistp = (do
|
|
|
|
@ -487,21 +488,18 @@ fieldnamelistp = (do
|
|
|
|
|
f <- fromMaybe "" <$> optional fieldnamep
|
|
|
|
|
fs <- some $ (separator >> fromMaybe "" <$> optional fieldnamep)
|
|
|
|
|
lift restofline
|
|
|
|
|
return $ map (map toLower) $ f:fs
|
|
|
|
|
return . map T.toLower $ f:fs
|
|
|
|
|
) <?> "field name list"
|
|
|
|
|
|
|
|
|
|
fieldnamep :: CsvRulesParser String
|
|
|
|
|
fieldnamep :: CsvRulesParser Text
|
|
|
|
|
fieldnamep = quotedfieldnamep <|> barefieldnamep
|
|
|
|
|
|
|
|
|
|
quotedfieldnamep :: CsvRulesParser String
|
|
|
|
|
quotedfieldnamep = do
|
|
|
|
|
char '"'
|
|
|
|
|
f <- some $ noneOf ("\"\n:;#~" :: [Char])
|
|
|
|
|
char '"'
|
|
|
|
|
return f
|
|
|
|
|
quotedfieldnamep :: CsvRulesParser Text
|
|
|
|
|
quotedfieldnamep =
|
|
|
|
|
char '"' *> takeWhile1P Nothing (`notElem` ("\"\n:;#~" :: [Char])) <* char '"'
|
|
|
|
|
|
|
|
|
|
barefieldnamep :: CsvRulesParser String
|
|
|
|
|
barefieldnamep = some $ noneOf (" \t\n,;#~" :: [Char])
|
|
|
|
|
barefieldnamep :: CsvRulesParser Text
|
|
|
|
|
barefieldnamep = takeWhile1P Nothing (`notElem` (" \t\n,;#~" :: [Char]))
|
|
|
|
|
|
|
|
|
|
fieldassignmentp :: CsvRulesParser (HledgerFieldName, FieldTemplate)
|
|
|
|
|
fieldassignmentp = do
|
|
|
|
@ -513,10 +511,10 @@ fieldassignmentp = do
|
|
|
|
|
return (f,v)
|
|
|
|
|
<?> "field assignment"
|
|
|
|
|
|
|
|
|
|
journalfieldnamep :: CsvRulesParser String
|
|
|
|
|
journalfieldnamep :: CsvRulesParser Text
|
|
|
|
|
journalfieldnamep = do
|
|
|
|
|
lift (dbgparse 8 "trying journalfieldnamep")
|
|
|
|
|
T.unpack <$> choiceInState (map (lift . string . T.pack) journalfieldnames)
|
|
|
|
|
choiceInState $ map (lift . string) journalfieldnames
|
|
|
|
|
|
|
|
|
|
maxpostings = 99
|
|
|
|
|
|
|
|
|
@ -524,14 +522,14 @@ maxpostings = 99
|
|
|
|
|
-- Names must precede any other name they contain, for the parser
|
|
|
|
|
-- (amount-in before amount; date2 before date). TODO: fix
|
|
|
|
|
journalfieldnames =
|
|
|
|
|
concat [[ "account" ++ i
|
|
|
|
|
,"amount" ++ i ++ "-in"
|
|
|
|
|
,"amount" ++ i ++ "-out"
|
|
|
|
|
,"amount" ++ i
|
|
|
|
|
,"balance" ++ i
|
|
|
|
|
,"comment" ++ i
|
|
|
|
|
,"currency" ++ i
|
|
|
|
|
] | x <- [maxpostings, (maxpostings-1)..1], let i = show x]
|
|
|
|
|
concat [[ "account" <> i
|
|
|
|
|
,"amount" <> i <> "-in"
|
|
|
|
|
,"amount" <> i <> "-out"
|
|
|
|
|
,"amount" <> i
|
|
|
|
|
,"balance" <> i
|
|
|
|
|
,"comment" <> i
|
|
|
|
|
,"currency" <> i
|
|
|
|
|
] | x <- [maxpostings, (maxpostings-1)..1], let i = T.pack $ show x]
|
|
|
|
|
++
|
|
|
|
|
["amount-in"
|
|
|
|
|
,"amount-out"
|
|
|
|
@ -556,10 +554,10 @@ assignmentseparatorp = do
|
|
|
|
|
]
|
|
|
|
|
return ()
|
|
|
|
|
|
|
|
|
|
fieldvalp :: CsvRulesParser String
|
|
|
|
|
fieldvalp :: CsvRulesParser Text
|
|
|
|
|
fieldvalp = do
|
|
|
|
|
lift $ dbgparse 8 "trying fieldvalp"
|
|
|
|
|
anySingle `manyTill` lift eolof
|
|
|
|
|
T.pack <$> anySingle `manyTill` lift eolof
|
|
|
|
|
|
|
|
|
|
-- A conditional block: one or more matchers, one per line, followed by one or more indented rules.
|
|
|
|
|
conditionalblockp :: CsvRulesParser ConditionalBlock
|
|
|
|
@ -594,7 +592,7 @@ conditionaltablep = do
|
|
|
|
|
body <- flip manyTill (lift eolof) $ do
|
|
|
|
|
off <- getOffset
|
|
|
|
|
m <- matcherp' (char sep >> return ())
|
|
|
|
|
vs <- LS.splitOn [sep] <$> lift restofline
|
|
|
|
|
vs <- T.split (==sep) . T.pack <$> lift restofline
|
|
|
|
|
if (length vs /= length fields)
|
|
|
|
|
then customFailure $ parseErrorAt off $ ((printf "line of conditional table should have %d values, but this one has only %d\n" (length fields) (length vs)) :: String)
|
|
|
|
|
else return (m,vs)
|
|
|
|
@ -655,8 +653,8 @@ csvfieldreferencep :: CsvRulesParser CsvFieldReference
|
|
|
|
|
csvfieldreferencep = do
|
|
|
|
|
lift $ dbgparse 8 "trying csvfieldreferencep"
|
|
|
|
|
char '%'
|
|
|
|
|
f <- fieldnamep
|
|
|
|
|
return $ '%' : quoteIfNeeded f
|
|
|
|
|
f <- T.unpack <$> fieldnamep -- XXX unpack and then pack
|
|
|
|
|
return . T.pack $ '%' : quoteIfNeeded f
|
|
|
|
|
|
|
|
|
|
-- A single regular expression
|
|
|
|
|
regexp :: CsvRulesParser () -> CsvRulesParser Regexp
|
|
|
|
@ -721,7 +719,7 @@ readJournalFromCsv mrulesfile csvfile csvdata =
|
|
|
|
|
let skiplines = case getDirective "skip" rules of
|
|
|
|
|
Nothing -> 0
|
|
|
|
|
Just "" -> 1
|
|
|
|
|
Just s -> readDef (throwerr $ "could not parse skip value: " ++ show s) s
|
|
|
|
|
Just s -> readDef (throwerr $ "could not parse skip value: " ++ show s) $ T.unpack s
|
|
|
|
|
|
|
|
|
|
-- parse csv
|
|
|
|
|
let
|
|
|
|
@ -785,12 +783,11 @@ readJournalFromCsv mrulesfile csvfile csvdata =
|
|
|
|
|
|
|
|
|
|
-- | Parse special separator names TAB and SPACE, or return the first
|
|
|
|
|
-- character. Return Nothing on empty string
|
|
|
|
|
parseSeparator :: String -> Maybe Char
|
|
|
|
|
parseSeparator = specials . map toLower
|
|
|
|
|
parseSeparator :: Text -> Maybe Char
|
|
|
|
|
parseSeparator = specials . T.toLower
|
|
|
|
|
where specials "space" = Just ' '
|
|
|
|
|
specials "tab" = Just '\t'
|
|
|
|
|
specials (x:_) = Just x
|
|
|
|
|
specials [] = Nothing
|
|
|
|
|
specials xs = fst <$> T.uncons xs
|
|
|
|
|
|
|
|
|
|
parseCsv :: Char -> FilePath -> Text -> IO (Either String CSV)
|
|
|
|
|
parseCsv separator filePath csvdata =
|
|
|
|
@ -813,15 +810,13 @@ parseResultToCsv :: (Foldable t, Functor t) => t (t B.ByteString) -> CSV
|
|
|
|
|
parseResultToCsv = toListList . unpackFields
|
|
|
|
|
where
|
|
|
|
|
toListList = toList . fmap toList
|
|
|
|
|
unpackFields = (fmap . fmap) (T.unpack . T.decodeUtf8)
|
|
|
|
|
unpackFields = (fmap . fmap) T.decodeUtf8
|
|
|
|
|
|
|
|
|
|
printCSV :: CSV -> String
|
|
|
|
|
printCSV records = unlined (printRecord `map` records)
|
|
|
|
|
where printRecord = concat . intersperse "," . map printField
|
|
|
|
|
printField f = "\"" ++ concatMap escape f ++ "\""
|
|
|
|
|
escape '"' = "\"\""
|
|
|
|
|
escape x = [x]
|
|
|
|
|
unlined = concat . intersperse "\n"
|
|
|
|
|
printCSV :: CSV -> TL.Text
|
|
|
|
|
printCSV = TB.toLazyText . unlined . map printRecord
|
|
|
|
|
where printRecord = mconcat . map TB.fromText . intersperse "," . map printField
|
|
|
|
|
printField = wrap "\"" "\"" . T.replace "\"" "\\\"\\\""
|
|
|
|
|
unlined = (<> TB.fromText "\n") . mconcat . intersperse "\n"
|
|
|
|
|
|
|
|
|
|
-- | Return the cleaned up and validated CSV data (can be empty), or an error.
|
|
|
|
|
validateCsv :: CsvRules -> Int -> Either String CSV -> Either String [CsvRecord]
|
|
|
|
@ -834,7 +829,7 @@ validateCsv rules numhdrlines (Right rs) = validate $ applyConditionalSkips $ dr
|
|
|
|
|
(Nothing, Nothing) -> Nothing
|
|
|
|
|
(Just _, _) -> Just maxBound
|
|
|
|
|
(Nothing, Just "") -> Just 1
|
|
|
|
|
(Nothing, Just x) -> Just (read x)
|
|
|
|
|
(Nothing, Just x) -> Just (read $ T.unpack x)
|
|
|
|
|
applyConditionalSkips [] = []
|
|
|
|
|
applyConditionalSkips (r:rest) =
|
|
|
|
|
case skipCount r of
|
|
|
|
@ -866,7 +861,7 @@ validateCsv rules numhdrlines (Right rs) = validate $ applyConditionalSkips $ dr
|
|
|
|
|
--- ** converting csv records to transactions
|
|
|
|
|
|
|
|
|
|
showRules rules record =
|
|
|
|
|
unlines $ catMaybes [ (("the "++fld++" rule is: ")++) <$> getEffectiveAssignment rules record fld | fld <- journalfieldnames]
|
|
|
|
|
T.unlines $ catMaybes [ (("the "<>fld<>" rule is: ")<>) <$> getEffectiveAssignment rules record fld | fld <- journalfieldnames]
|
|
|
|
|
|
|
|
|
|
-- | Look up the value (template) of a csv rule by rule keyword.
|
|
|
|
|
csvRule :: CsvRules -> DirectiveName -> Maybe FieldTemplate
|
|
|
|
@ -880,7 +875,7 @@ hledgerField = getEffectiveAssignment
|
|
|
|
|
|
|
|
|
|
-- | Look up the final value assigned to a hledger field, with csv field
|
|
|
|
|
-- references interpolated.
|
|
|
|
|
hledgerFieldValue :: CsvRules -> CsvRecord -> HledgerFieldName -> Maybe String
|
|
|
|
|
hledgerFieldValue :: CsvRules -> CsvRecord -> HledgerFieldName -> Maybe Text
|
|
|
|
|
hledgerFieldValue rules record = fmap (renderTemplate rules record) . hledgerField rules record
|
|
|
|
|
|
|
|
|
|
transactionFromCsvRecord :: SourcePos -> CsvRules -> CsvRecord -> Transaction
|
|
|
|
@ -892,18 +887,18 @@ transactionFromCsvRecord sourcepos rules record = t
|
|
|
|
|
rule = csvRule rules :: DirectiveName -> Maybe FieldTemplate
|
|
|
|
|
-- ruleval = csvRuleValue rules record :: DirectiveName -> Maybe String
|
|
|
|
|
field = hledgerField rules record :: HledgerFieldName -> Maybe FieldTemplate
|
|
|
|
|
fieldval = hledgerFieldValue rules record :: HledgerFieldName -> Maybe String
|
|
|
|
|
fieldval = hledgerFieldValue rules record :: HledgerFieldName -> Maybe Text
|
|
|
|
|
parsedate = parseDateWithCustomOrDefaultFormats (rule "date-format")
|
|
|
|
|
mkdateerror datefield datevalue mdateformat = unlines
|
|
|
|
|
["error: could not parse \""++datevalue++"\" as a date using date format "
|
|
|
|
|
++maybe "\"YYYY/M/D\", \"YYYY-M-D\" or \"YYYY.M.D\"" show mdateformat
|
|
|
|
|
mkdateerror datefield datevalue mdateformat = T.unpack $ T.unlines
|
|
|
|
|
["error: could not parse \""<>datevalue<>"\" as a date using date format "
|
|
|
|
|
<>maybe "\"YYYY/M/D\", \"YYYY-M-D\" or \"YYYY.M.D\"" (T.pack . show) mdateformat
|
|
|
|
|
,showRecord record
|
|
|
|
|
,"the "++datefield++" rule is: "++(fromMaybe "required, but missing" $ field datefield)
|
|
|
|
|
,"the date-format is: "++fromMaybe "unspecified" mdateformat
|
|
|
|
|
,"the "<>datefield<>" rule is: "<>(fromMaybe "required, but missing" $ field datefield)
|
|
|
|
|
,"the date-format is: "<>fromMaybe "unspecified" mdateformat
|
|
|
|
|
,"you may need to "
|
|
|
|
|
++"change your "++datefield++" rule, "
|
|
|
|
|
++maybe "add a" (const "change your") mdateformat++" date-format rule, "
|
|
|
|
|
++"or "++maybe "add a" (const "change your") mskip++" skip rule"
|
|
|
|
|
<>"change your "<>datefield<>" rule, "
|
|
|
|
|
<>maybe "add a" (const "change your") mdateformat<>" date-format rule, "
|
|
|
|
|
<>"or "<>maybe "add a" (const "change your") mskip<>" skip rule"
|
|
|
|
|
,"for m/d/y or d/m/y dates, use date-format %-m/%-d/%Y or date-format %-d/%-m/%Y"
|
|
|
|
|
]
|
|
|
|
|
where
|
|
|
|
@ -923,10 +918,10 @@ transactionFromCsvRecord sourcepos rules record = t
|
|
|
|
|
status =
|
|
|
|
|
case fieldval "status" of
|
|
|
|
|
Nothing -> Unmarked
|
|
|
|
|
Just s -> either statuserror id $ runParser (statusp <* eof) "" $ T.pack s
|
|
|
|
|
Just s -> either statuserror id $ runParser (statusp <* eof) "" s
|
|
|
|
|
where
|
|
|
|
|
statuserror err = error' $ unlines
|
|
|
|
|
["error: could not parse \""++s++"\" as a cleared status (should be *, ! or empty)"
|
|
|
|
|
["error: could not parse \""<>T.unpack s<>"\" as a cleared status (should be *, ! or empty)"
|
|
|
|
|
,"the parse error is: "++customErrorBundlePretty err
|
|
|
|
|
]
|
|
|
|
|
code = maybe "" singleline $ fieldval "code"
|
|
|
|
@ -934,14 +929,16 @@ transactionFromCsvRecord sourcepos rules record = t
|
|
|
|
|
comment = maybe "" singleline $ fieldval "comment"
|
|
|
|
|
precomment = maybe "" singleline $ fieldval "precomment"
|
|
|
|
|
|
|
|
|
|
singleline = T.unwords . filter (not . T.null) . map T.strip . T.lines
|
|
|
|
|
|
|
|
|
|
----------------------------------------------------------------------
|
|
|
|
|
-- 3. Generate the postings for which an account has been assigned
|
|
|
|
|
-- (possibly indirectly due to an amount or balance assignment)
|
|
|
|
|
|
|
|
|
|
p1IsVirtual = (accountNamePostingType . T.pack <$> fieldval "account1") == Just VirtualPosting
|
|
|
|
|
p1IsVirtual = (accountNamePostingType <$> fieldval "account1") == Just VirtualPosting
|
|
|
|
|
ps = [p | n <- [1..maxpostings]
|
|
|
|
|
,let comment = T.pack $ fromMaybe "" $ fieldval ("comment"++show n)
|
|
|
|
|
,let currency = fromMaybe "" (fieldval ("currency"++show n) <|> fieldval "currency")
|
|
|
|
|
,let comment = fromMaybe "" $ fieldval ("comment"<> T.pack (show n))
|
|
|
|
|
,let currency = fromMaybe "" (fieldval ("currency"<> T.pack (show n)) <|> fieldval "currency")
|
|
|
|
|
,let mamount = getAmount rules record currency p1IsVirtual n
|
|
|
|
|
,let mbalance = getBalance rules record currency n
|
|
|
|
|
,Just (acct,isfinal) <- [getAccount rules record mamount mbalance n] -- skips Nothings
|
|
|
|
@ -965,10 +962,10 @@ transactionFromCsvRecord sourcepos rules record = t
|
|
|
|
|
,tdate = date'
|
|
|
|
|
,tdate2 = mdate2'
|
|
|
|
|
,tstatus = status
|
|
|
|
|
,tcode = T.pack code
|
|
|
|
|
,tdescription = T.pack description
|
|
|
|
|
,tcomment = T.pack comment
|
|
|
|
|
,tprecedingcomment = T.pack precomment
|
|
|
|
|
,tcode = code
|
|
|
|
|
,tdescription = description
|
|
|
|
|
,tcomment = comment
|
|
|
|
|
,tprecedingcomment = precomment
|
|
|
|
|
,tpostings = ps
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
@ -979,7 +976,7 @@ transactionFromCsvRecord sourcepos rules record = t
|
|
|
|
|
-- For postings 1 or 2 it also looks at "amount", "amount-in", "amount-out".
|
|
|
|
|
-- If more than one of these has a value, it looks for one that is non-zero.
|
|
|
|
|
-- If there's multiple non-zeros, or no non-zeros but multiple zeros, it throws an error.
|
|
|
|
|
getAmount :: CsvRules -> CsvRecord -> String -> Bool -> Int -> Maybe MixedAmount
|
|
|
|
|
getAmount :: CsvRules -> CsvRecord -> Text -> Bool -> Int -> Maybe MixedAmount
|
|
|
|
|
getAmount rules record currency p1IsVirtual n =
|
|
|
|
|
-- Warning, many tricky corner cases here.
|
|
|
|
|
-- docs: hledger_csv.m4.md #### amount
|
|
|
|
@ -988,14 +985,15 @@ getAmount rules record currency p1IsVirtual n =
|
|
|
|
|
unnumberedfieldnames = ["amount","amount-in","amount-out"]
|
|
|
|
|
|
|
|
|
|
-- amount field names which can affect this posting
|
|
|
|
|
fieldnames = map (("amount"++show n)++) ["","-in","-out"]
|
|
|
|
|
fieldnames = map (("amount"<> T.pack(show n))<>) ["","-in","-out"]
|
|
|
|
|
-- For posting 1, also recognise the old amount/amount-in/amount-out names.
|
|
|
|
|
-- For posting 2, the same but only if posting 1 needs balancing.
|
|
|
|
|
++ if n==1 || n==2 && not p1IsVirtual then unnumberedfieldnames else []
|
|
|
|
|
|
|
|
|
|
-- assignments to any of these field names with non-empty values
|
|
|
|
|
assignments = [(f,a') | f <- fieldnames
|
|
|
|
|
, Just v@(_:_) <- [strip . renderTemplate rules record <$> hledgerField rules record f]
|
|
|
|
|
, Just v <- [T.strip . renderTemplate rules record <$> hledgerField rules record f]
|
|
|
|
|
, not $ T.null v
|
|
|
|
|
, let a = parseAmount rules record currency v
|
|
|
|
|
-- With amount/amount-in/amount-out, in posting 2,
|
|
|
|
|
-- flip the sign and convert to cost, as they did before 1.17
|
|
|
|
@ -1006,7 +1004,7 @@ getAmount rules record currency p1IsVirtual n =
|
|
|
|
|
assignments' | any isnumbered assignments = filter isnumbered assignments
|
|
|
|
|
| otherwise = assignments
|
|
|
|
|
where
|
|
|
|
|
isnumbered (f,_) = any (flip elem ['0'..'9']) f
|
|
|
|
|
isnumbered (f,_) = T.any (flip elem ['0'..'9']) f
|
|
|
|
|
|
|
|
|
|
-- if there's more than one value and only some are zeros, discard the zeros
|
|
|
|
|
assignments''
|
|
|
|
@ -1017,24 +1015,24 @@ getAmount rules record currency p1IsVirtual n =
|
|
|
|
|
in case -- dbg0 ("amounts for posting "++show n)
|
|
|
|
|
assignments'' of
|
|
|
|
|
[] -> Nothing
|
|
|
|
|
[(f,a)] | "-out" `isSuffixOf` f -> Just (-a) -- for -out fields, flip the sign
|
|
|
|
|
[(f,a)] | "-out" `T.isSuffixOf` f -> Just (-a) -- for -out fields, flip the sign
|
|
|
|
|
[(_,a)] -> Just a
|
|
|
|
|
fs -> error' $ unlines $ [ -- PARTIAL:
|
|
|
|
|
fs -> error' . T.unpack . T.unlines $ [ -- PARTIAL:
|
|
|
|
|
"multiple non-zero amounts or multiple zero amounts assigned,"
|
|
|
|
|
,"please ensure just one. (https://hledger.org/csv.html#amount)"
|
|
|
|
|
," " ++ showRecord record
|
|
|
|
|
," for posting: " ++ show n
|
|
|
|
|
," " <> showRecord record
|
|
|
|
|
," for posting: " <> T.pack (show n)
|
|
|
|
|
]
|
|
|
|
|
++ [" assignment: " ++ f ++ " " ++
|
|
|
|
|
fromMaybe "" (hledgerField rules record f) ++
|
|
|
|
|
"\t=> value: " ++ showMixedAmount a -- XXX not sure this is showing all the right info
|
|
|
|
|
++ [" assignment: " <> f <> " " <>
|
|
|
|
|
fromMaybe "" (hledgerField rules record f) <>
|
|
|
|
|
"\t=> value: " <> T.pack (showMixedAmount a) -- XXX not sure this is showing all the right info
|
|
|
|
|
| (f,a) <- fs]
|
|
|
|
|
|
|
|
|
|
-- | Figure out the expected balance (assertion or assignment) specified for posting N,
|
|
|
|
|
-- if any (and its parse position).
|
|
|
|
|
getBalance :: CsvRules -> CsvRecord -> String -> Int -> Maybe (Amount, GenericSourcePos)
|
|
|
|
|
getBalance :: CsvRules -> CsvRecord -> Text -> Int -> Maybe (Amount, GenericSourcePos)
|
|
|
|
|
getBalance rules record currency n = do
|
|
|
|
|
v <- (fieldval ("balance"++show n)
|
|
|
|
|
v <- (fieldval ("balance"<> T.pack (show n))
|
|
|
|
|
-- for posting 1, also recognise the old field name
|
|
|
|
|
<|> if n==1 then fieldval "balance" else Nothing)
|
|
|
|
|
case v of
|
|
|
|
@ -1043,30 +1041,29 @@ getBalance rules record currency n = do
|
|
|
|
|
parseBalanceAmount rules record currency n s
|
|
|
|
|
,nullsourcepos -- parse position to show when assertion fails,
|
|
|
|
|
) -- XXX the csv record's line number would be good
|
|
|
|
|
|
|
|
|
|
where
|
|
|
|
|
fieldval = fmap strip . hledgerFieldValue rules record :: HledgerFieldName -> Maybe String
|
|
|
|
|
fieldval = fmap T.strip . hledgerFieldValue rules record :: HledgerFieldName -> Maybe Text
|
|
|
|
|
|
|
|
|
|
-- | Given a non-empty amount string (from CSV) to parse, along with a
|
|
|
|
|
-- possibly non-empty currency symbol to prepend,
|
|
|
|
|
-- parse as a hledger MixedAmount (as in journal format), or raise an error.
|
|
|
|
|
-- The whole CSV record is provided for the error message.
|
|
|
|
|
parseAmount :: CsvRules -> CsvRecord -> String -> String -> MixedAmount
|
|
|
|
|
parseAmount :: CsvRules -> CsvRecord -> Text -> Text -> MixedAmount
|
|
|
|
|
parseAmount rules record currency s =
|
|
|
|
|
either mkerror (Mixed . (:[])) $ -- PARTIAL:
|
|
|
|
|
runParser (evalStateT (amountp <* eof) journalparsestate) "" $
|
|
|
|
|
T.pack $ (currency++) $ simplifySign s
|
|
|
|
|
either mkerror (Mixed . (:[])) $ -- PARTIAL:
|
|
|
|
|
runParser (evalStateT (amountp <* eof) journalparsestate) "" $
|
|
|
|
|
currency <> simplifySign s
|
|
|
|
|
where
|
|
|
|
|
journalparsestate = nulljournal{jparsedecimalmark=parseDecimalMark rules}
|
|
|
|
|
mkerror e = error' $ unlines
|
|
|
|
|
["error: could not parse \""++s++"\" as an amount"
|
|
|
|
|
mkerror e = error' . T.unpack $ T.unlines
|
|
|
|
|
["error: could not parse \"" <> s <> "\" as an amount"
|
|
|
|
|
,showRecord record
|
|
|
|
|
,showRules rules record
|
|
|
|
|
-- ,"the default-currency is: "++fromMaybe "unspecified" (getDirective "default-currency" rules)
|
|
|
|
|
,"the parse error is: "++customErrorBundlePretty e
|
|
|
|
|
,"you may need to "
|
|
|
|
|
++"change your amount*, balance*, or currency* rules, "
|
|
|
|
|
++"or add or change your skip rule"
|
|
|
|
|
,"the parse error is: " <> T.pack (customErrorBundlePretty e)
|
|
|
|
|
,"you may need to \
|
|
|
|
|
\change your amount*, balance*, or currency* rules, \
|
|
|
|
|
\or add or change your skip rule"
|
|
|
|
|
]
|
|
|
|
|
|
|
|
|
|
-- XXX unify these ^v
|
|
|
|
@ -1076,30 +1073,30 @@ parseAmount rules record currency s =
|
|
|
|
|
-- possibly non-empty currency symbol to prepend,
|
|
|
|
|
-- parse as a hledger Amount (as in journal format), or raise an error.
|
|
|
|
|
-- The CSV record and the field's numeric suffix are provided for the error message.
|
|
|
|
|
parseBalanceAmount :: CsvRules -> CsvRecord -> String -> Int -> String -> Amount
|
|
|
|
|
parseBalanceAmount :: CsvRules -> CsvRecord -> Text -> Int -> Text -> Amount
|
|
|
|
|
parseBalanceAmount rules record currency n s =
|
|
|
|
|
either (mkerror n s) id $
|
|
|
|
|
runParser (evalStateT (amountp <* eof) journalparsestate) "" $
|
|
|
|
|
T.pack $ (currency++) $ simplifySign s
|
|
|
|
|
currency <> simplifySign s
|
|
|
|
|
-- the csv record's line number would be good
|
|
|
|
|
where
|
|
|
|
|
journalparsestate = nulljournal{jparsedecimalmark=parseDecimalMark rules}
|
|
|
|
|
mkerror n s e = error' $ unlines
|
|
|
|
|
["error: could not parse \""++s++"\" as balance"++show n++" amount"
|
|
|
|
|
mkerror n s e = error' . T.unpack $ T.unlines
|
|
|
|
|
["error: could not parse \"" <> s <> "\" as balance"<> T.pack (show n) <> " amount"
|
|
|
|
|
,showRecord record
|
|
|
|
|
,showRules rules record
|
|
|
|
|
-- ,"the default-currency is: "++fromMaybe "unspecified" mdefaultcurrency
|
|
|
|
|
,"the parse error is: "++customErrorBundlePretty e
|
|
|
|
|
,"the parse error is: "<> T.pack (customErrorBundlePretty e)
|
|
|
|
|
]
|
|
|
|
|
|
|
|
|
|
-- Read a valid decimal mark from the decimal-mark rule, if any.
|
|
|
|
|
-- If the rule is present with an invalid argument, raise an error.
|
|
|
|
|
parseDecimalMark :: CsvRules -> Maybe DecimalMark
|
|
|
|
|
parseDecimalMark rules =
|
|
|
|
|
case rules `csvRule` "decimal-mark" of
|
|
|
|
|
Nothing -> Nothing
|
|
|
|
|
Just [c] | isDecimalMark c -> Just c
|
|
|
|
|
Just s -> error' $ "decimal-mark's argument should be \".\" or \",\" (not \""++s++"\")"
|
|
|
|
|
parseDecimalMark rules = do
|
|
|
|
|
s <- rules `csvRule` "decimal-mark"
|
|
|
|
|
case T.uncons s of
|
|
|
|
|
Just (c, rest) | T.null rest && isDecimalMark c -> return c
|
|
|
|
|
_ -> error' . T.unpack $ "decimal-mark's argument should be \".\" or \",\" (not \""<>s<>"\")"
|
|
|
|
|
|
|
|
|
|
-- | Make a balance assertion for the given amount, with the given parse
|
|
|
|
|
-- position (to be shown in assertion failures), with the assertion type
|
|
|
|
@ -1116,8 +1113,8 @@ mkBalanceAssertion rules record (amt, pos) = assrt{baamount=amt, baposition=pos}
|
|
|
|
|
Just "==" -> nullassertion{batotal=True}
|
|
|
|
|
Just "=*" -> nullassertion{bainclusive=True}
|
|
|
|
|
Just "==*" -> nullassertion{batotal=True, bainclusive=True}
|
|
|
|
|
Just x -> error' $ unlines -- PARTIAL:
|
|
|
|
|
[ "balance-type \"" ++ x ++"\" is invalid. Use =, ==, =* or ==*."
|
|
|
|
|
Just x -> error' . T.unpack $ T.unlines -- PARTIAL:
|
|
|
|
|
[ "balance-type \"" <> x <>"\" is invalid. Use =, ==, =* or ==*."
|
|
|
|
|
, showRecord record
|
|
|
|
|
, showRules rules record
|
|
|
|
|
]
|
|
|
|
@ -1128,8 +1125,8 @@ mkBalanceAssertion rules record (amt, pos) = assrt{baamount=amt, baposition=pos}
|
|
|
|
|
getAccount :: CsvRules -> CsvRecord -> Maybe MixedAmount -> Maybe (Amount, GenericSourcePos) -> Int -> Maybe (AccountName, Bool)
|
|
|
|
|
getAccount rules record mamount mbalance n =
|
|
|
|
|
let
|
|
|
|
|
fieldval = hledgerFieldValue rules record :: HledgerFieldName -> Maybe String
|
|
|
|
|
maccount = T.pack <$> fieldval ("account"++show n)
|
|
|
|
|
fieldval = hledgerFieldValue rules record :: HledgerFieldName -> Maybe Text
|
|
|
|
|
maccount = fieldval ("account"<> T.pack (show n))
|
|
|
|
|
in case maccount of
|
|
|
|
|
-- accountN is set to the empty string - no posting will be generated
|
|
|
|
|
Just "" -> Nothing
|
|
|
|
@ -1150,7 +1147,7 @@ getAccount rules record mamount mbalance n =
|
|
|
|
|
unknownExpenseAccount = "expenses:unknown"
|
|
|
|
|
unknownIncomeAccount = "income:unknown"
|
|
|
|
|
|
|
|
|
|
type CsvAmountString = String
|
|
|
|
|
type CsvAmountString = Text
|
|
|
|
|
|
|
|
|
|
-- | Canonicalise the sign in a CSV amount string.
|
|
|
|
|
-- Such strings can have a minus sign, negating parentheses,
|
|
|
|
@ -1171,18 +1168,20 @@ type CsvAmountString = String
|
|
|
|
|
-- >>> simplifySign "((1))"
|
|
|
|
|
-- "1"
|
|
|
|
|
simplifySign :: CsvAmountString -> CsvAmountString
|
|
|
|
|
simplifySign ('(':s) | lastMay s == Just ')' = simplifySign $ negateStr $ init s
|
|
|
|
|
simplifySign ('-':'(':s) | lastMay s == Just ')' = simplifySign $ init s
|
|
|
|
|
simplifySign ('-':'-':s) = s
|
|
|
|
|
simplifySign s = s
|
|
|
|
|
simplifySign amtstr
|
|
|
|
|
| Just ('(',t) <- T.uncons amtstr, Just (amt,')') <- T.unsnoc t = simplifySign $ negateStr amt
|
|
|
|
|
| Just ('-',b) <- T.uncons amtstr, Just ('(',t) <- T.uncons b, Just (amt,')') <- T.unsnoc t = simplifySign amt
|
|
|
|
|
| Just ('-',m) <- T.uncons amtstr, Just ('-',amt) <- T.uncons m = amt
|
|
|
|
|
| otherwise = amtstr
|
|
|
|
|
|
|
|
|
|
negateStr :: String -> String
|
|
|
|
|
negateStr ('-':s) = s
|
|
|
|
|
negateStr s = '-':s
|
|
|
|
|
negateStr :: Text -> Text
|
|
|
|
|
negateStr amtstr = case T.uncons amtstr of
|
|
|
|
|
Just ('-',s) -> s
|
|
|
|
|
_ -> T.cons '-' amtstr
|
|
|
|
|
|
|
|
|
|
-- | Show a (approximate) recreation of the original CSV record.
|
|
|
|
|
showRecord :: CsvRecord -> String
|
|
|
|
|
showRecord r = "record values: "++intercalate "," (map show r)
|
|
|
|
|
showRecord :: CsvRecord -> Text
|
|
|
|
|
showRecord r = "record values: "<>T.intercalate "," (map (wrap "\"" "\"") r)
|
|
|
|
|
|
|
|
|
|
-- | Given the conversion rules, a CSV record and a hledger field name, find
|
|
|
|
|
-- the value template ultimately assigned to this field, if any, by a field
|
|
|
|
@ -1217,47 +1216,48 @@ getEffectiveAssignment rules record f = lastMay $ map snd $ assignments
|
|
|
|
|
-- - any quotes enclosing field values are removed
|
|
|
|
|
-- - and the field separator is always comma
|
|
|
|
|
-- which means that a field containing a comma will look like two fields.
|
|
|
|
|
wholecsvline = dbg7 "wholecsvline" $ intercalate "," record
|
|
|
|
|
matcherMatches (FieldMatcher _ csvfieldref pat) = regexMatch pat csvfieldvalue
|
|
|
|
|
wholecsvline = dbg7 "wholecsvline" . T.unpack $ T.intercalate "," record
|
|
|
|
|
matcherMatches (FieldMatcher _ csvfieldref pat) = regexMatch pat $ T.unpack csvfieldvalue
|
|
|
|
|
where
|
|
|
|
|
-- the value of the referenced CSV field to match against.
|
|
|
|
|
csvfieldvalue = dbg7 "csvfieldvalue" $ replaceCsvFieldReference rules record csvfieldref
|
|
|
|
|
|
|
|
|
|
-- | Render a field assignment's template, possibly interpolating referenced
|
|
|
|
|
-- CSV field values. Outer whitespace is removed from interpolated values.
|
|
|
|
|
renderTemplate :: CsvRules -> CsvRecord -> FieldTemplate -> String
|
|
|
|
|
renderTemplate rules record t = maybe t concat $ parseMaybe
|
|
|
|
|
renderTemplate :: CsvRules -> CsvRecord -> FieldTemplate -> Text
|
|
|
|
|
renderTemplate rules record t = maybe t mconcat $ parseMaybe
|
|
|
|
|
(many $ takeWhile1P Nothing (/='%')
|
|
|
|
|
<|> replaceCsvFieldReference rules record <$> referencep)
|
|
|
|
|
t
|
|
|
|
|
where
|
|
|
|
|
referencep = liftA2 (:) (char '%') (takeWhile1P (Just "reference") isDescriptorChar) :: Parsec CustomErr String String
|
|
|
|
|
referencep = liftA2 T.cons (char '%') (takeWhile1P (Just "reference") isDescriptorChar) :: Parsec CustomErr Text Text
|
|
|
|
|
isDescriptorChar c = isAscii c && (isAlphaNum c || c == '_' || c == '-')
|
|
|
|
|
|
|
|
|
|
-- | Replace something that looks like a reference to a csv field ("%date" or "%1)
|
|
|
|
|
-- with that field's value. If it doesn't look like a field reference, or if we
|
|
|
|
|
-- can't find such a field, leave it unchanged.
|
|
|
|
|
replaceCsvFieldReference :: CsvRules -> CsvRecord -> CsvFieldReference -> String
|
|
|
|
|
replaceCsvFieldReference rules record s@('%':fieldname) = fromMaybe s $ csvFieldValue rules record fieldname
|
|
|
|
|
replaceCsvFieldReference _ _ s = s
|
|
|
|
|
replaceCsvFieldReference :: CsvRules -> CsvRecord -> CsvFieldReference -> Text
|
|
|
|
|
replaceCsvFieldReference rules record s = case T.uncons s of
|
|
|
|
|
Just ('%', fieldname) -> fromMaybe s $ csvFieldValue rules record fieldname
|
|
|
|
|
_ -> s
|
|
|
|
|
|
|
|
|
|
-- | Get the (whitespace-stripped) value of a CSV field, identified by its name or
|
|
|
|
|
-- column number, ("date" or "1"), from the given CSV record, if such a field exists.
|
|
|
|
|
csvFieldValue :: CsvRules -> CsvRecord -> CsvFieldName -> Maybe String
|
|
|
|
|
csvFieldValue :: CsvRules -> CsvRecord -> CsvFieldName -> Maybe Text
|
|
|
|
|
csvFieldValue rules record fieldname = do
|
|
|
|
|
fieldindex <- if | all isDigit fieldname -> readMay fieldname
|
|
|
|
|
| otherwise -> lookup (map toLower fieldname) $ rcsvfieldindexes rules
|
|
|
|
|
fieldvalue <- strip <$> atMay record (fieldindex-1)
|
|
|
|
|
fieldindex <- if | T.all isDigit fieldname -> readMay $ T.unpack fieldname
|
|
|
|
|
| otherwise -> lookup (T.toLower fieldname) $ rcsvfieldindexes rules
|
|
|
|
|
fieldvalue <- T.strip <$> atMay record (fieldindex-1)
|
|
|
|
|
return fieldvalue
|
|
|
|
|
|
|
|
|
|
-- | Parse the date string using the specified date-format, or if unspecified
|
|
|
|
|
-- the "simple date" formats (YYYY/MM/DD, YYYY-MM-DD, YYYY.MM.DD, leading
|
|
|
|
|
-- zeroes optional).
|
|
|
|
|
parseDateWithCustomOrDefaultFormats :: Maybe DateFormat -> String -> Maybe Day
|
|
|
|
|
parseDateWithCustomOrDefaultFormats :: Maybe DateFormat -> Text -> Maybe Day
|
|
|
|
|
parseDateWithCustomOrDefaultFormats mformat s = asum $ map parsewith formats
|
|
|
|
|
where
|
|
|
|
|
parsewith = flip (parseTimeM True defaultTimeLocale) s
|
|
|
|
|
formats = maybe
|
|
|
|
|
parsewith = flip (parseTimeM True defaultTimeLocale) (T.unpack s)
|
|
|
|
|
formats = map T.unpack $ maybe
|
|
|
|
|
["%Y/%-m/%-d"
|
|
|
|
|
,"%Y-%-m-%-d"
|
|
|
|
|
,"%Y.%-m.%-d"
|
|
|
|
|