From 696d9c73b011abbf12b7df05623471cf8f2c8f86 Mon Sep 17 00:00:00 2001 From: Stephen Morgan Date: Tue, 21 Jul 2020 12:42:28 +1000 Subject: [PATCH] lib: Remove unnecessary try in parsers, replace unnecessary string' with string, rewrite some parsers in applicative style. --- hledger-lib/Hledger/Data/Commodity.hs | 15 +++++--- hledger-lib/Hledger/Data/Dates.hs | 55 +++++++++++++-------------- 2 files changed, 35 insertions(+), 35 deletions(-) diff --git a/hledger-lib/Hledger/Data/Commodity.hs b/hledger-lib/Hledger/Data/Commodity.hs index 8e7685757..f01449bf5 100644 --- a/hledger-lib/Hledger/Data/Commodity.hs +++ b/hledger-lib/Hledger/Data/Commodity.hs @@ -12,6 +12,7 @@ are thousands separated by comma, significant decimal places and so on. module Hledger.Data.Commodity where +import Control.Applicative (liftA2) import Data.Char (isDigit) import Data.List import Data.Maybe (fromMaybe) @@ -27,13 +28,15 @@ import Hledger.Utils -- characters that may not be used in a non-quoted commodity symbol isNonsimpleCommodityChar :: Char -> Bool -isNonsimpleCommodityChar c = isDigit c || c `textElem` otherChars - where - otherChars = "-+.@*;\t\n \"{}=" :: T.Text - textElem = T.any . (==) +isNonsimpleCommodityChar = liftA2 (||) isDigit isOther + where + otherChars = "-+.@*;\t\n \"{}=" :: T.Text + isOther c = T.any (==c) otherChars -quoteCommoditySymbolIfNeeded s | T.any (isNonsimpleCommodityChar) s = "\"" <> s <> "\"" - | otherwise = s +quoteCommoditySymbolIfNeeded :: T.Text -> T.Text +quoteCommoditySymbolIfNeeded s + | T.any isNonsimpleCommodityChar s = "\"" <> s <> "\"" + | otherwise = s commodity = "" diff --git a/hledger-lib/Hledger/Data/Dates.hs b/hledger-lib/Hledger/Data/Dates.hs index bc952f68b..86dbd0f32 100644 --- a/hledger-lib/Hledger/Data/Dates.hs +++ b/hledger-lib/Hledger/Data/Dates.hs @@ -83,11 +83,13 @@ where import Prelude () import "base-compat-batteries" Prelude.Compat hiding (fail) import qualified "base-compat-batteries" Control.Monad.Fail.Compat as Fail (MonadFail, fail) +import Control.Applicative (liftA2) import Control.Applicative.Permutations import Control.Monad (guard, unless) import "base-compat-batteries" Data.List.Compat import Data.Default import Data.Foldable (asum) +import Data.Function (on) import Data.Maybe import qualified Data.Set as Set import Data.Text (Text) @@ -877,13 +879,13 @@ monIndex name = maybe 0 (+1) $ T.toLower name `elemIndex` monthabbrevs month :: TextParser m SmartDate month = do - m <- choice $ map (try . string') months + m <- choice $ map string' months let i = monthIndex m return ("",show i,"") mon :: TextParser m SmartDate mon = do - m <- choice $ map (try . string') monthabbrevs + m <- choice $ map string' monthabbrevs let i = monIndex m return ("",show i,"") @@ -896,9 +898,9 @@ weekday = do show wday <> " in " <> show (weekdays ++ weekdayabbrevs) today,yesterday,tomorrow :: TextParser m SmartDate -today = string' "today" >> return ("","","today") -yesterday = string' "yesterday" >> return ("","","yesterday") -tomorrow = string' "tomorrow" >> return ("","","tomorrow") +today = string' "today" *> return ("","","today") +yesterday = string' "yesterday" *> return ("","","yesterday") +tomorrow = string' "tomorrow" *> return ("","","tomorrow") lastthisnextthing :: TextParser m SmartDate lastthisnextthing = do @@ -1085,41 +1087,36 @@ periodexprdatespanp rdate = choice $ map try [ -- -- >>> parsewith (doubledatespan (parsedate "2018/01/01") <* eof) "20180101-201804" -- Right DateSpan 2018-01-01..2018-04-01 doubledatespanp :: Day -> TextParser m DateSpan -doubledatespanp rdate = do - optional (string' "from" >> skipNonNewlineSpaces) - b <- smartdate - skipNonNewlineSpaces - optional (choice [string' "to", string "..", string' "-"] >> skipNonNewlineSpaces) - DateSpan (Just $ fixSmartDate rdate b) . Just . fixSmartDate rdate <$> smartdate +doubledatespanp rdate = liftA2 fromToSpan + (optional (string' "from" *> skipNonNewlineSpaces) *> smartdate) + (skipNonNewlineSpaces *> choice [string' "to", string "..", string "-"] + *> skipNonNewlineSpaces *> smartdate) + where + fromToSpan = DateSpan `on` (Just . fixSmartDate rdate) fromdatespanp :: Day -> TextParser m DateSpan -fromdatespanp rdate = do - b <- choice [ - do - string' "from" >> skipNonNewlineSpaces - smartdate - , - do - d <- smartdate - choice [string "..", string' "-"] - return d +fromdatespanp rdate = fromSpan <$> choice + [ string' "from" *> skipNonNewlineSpaces *> smartdate + , smartdate <* choice [string "..", string "-"] ] - return $ DateSpan (Just $ fixSmartDate rdate b) Nothing + where + fromSpan b = DateSpan (Just $ fixSmartDate rdate b) Nothing todatespanp :: Day -> TextParser m DateSpan -todatespanp rdate = do - choice [string' "to", string' "until", string "..", string' "-"] >> skipNonNewlineSpaces - DateSpan Nothing . Just . fixSmartDate rdate <$> smartdate +todatespanp rdate = + choice [string' "to", string' "until", string "..", string "-"] + *> skipNonNewlineSpaces + *> (DateSpan Nothing . Just . fixSmartDate rdate <$> smartdate) justdatespanp :: Day -> TextParser m DateSpan -justdatespanp rdate = do - optional (string' "in" >> skipNonNewlineSpaces) - spanFromSmartDate rdate <$> smartdate +justdatespanp rdate = + optional (string' "in" *> skipNonNewlineSpaces) + *> (spanFromSmartDate rdate <$> smartdate) -- | Make a datespan from two valid date strings parseable by parsedate -- (or raise an error). Eg: mkdatespan \"2011/1/1\" \"2011/12/31\". mkdatespan :: String -> String -> DateSpan -mkdatespan b = DateSpan (Just $ parsedate b) . Just . parsedate +mkdatespan = DateSpan `on` (Just . parsedate) nulldatespan :: DateSpan nulldatespan = DateSpan Nothing Nothing