lib: Remove unnecessary try in parsers, replace unnecessary string' with string, rewrite some parsers in applicative style.
This commit is contained in:
parent
a82c383370
commit
696d9c73b0
@ -12,6 +12,7 @@ are thousands separated by comma, significant decimal places and so on.
|
|||||||
|
|
||||||
module Hledger.Data.Commodity
|
module Hledger.Data.Commodity
|
||||||
where
|
where
|
||||||
|
import Control.Applicative (liftA2)
|
||||||
import Data.Char (isDigit)
|
import Data.Char (isDigit)
|
||||||
import Data.List
|
import Data.List
|
||||||
import Data.Maybe (fromMaybe)
|
import Data.Maybe (fromMaybe)
|
||||||
@ -27,12 +28,14 @@ import Hledger.Utils
|
|||||||
|
|
||||||
-- characters that may not be used in a non-quoted commodity symbol
|
-- characters that may not be used in a non-quoted commodity symbol
|
||||||
isNonsimpleCommodityChar :: Char -> Bool
|
isNonsimpleCommodityChar :: Char -> Bool
|
||||||
isNonsimpleCommodityChar c = isDigit c || c `textElem` otherChars
|
isNonsimpleCommodityChar = liftA2 (||) isDigit isOther
|
||||||
where
|
where
|
||||||
otherChars = "-+.@*;\t\n \"{}=" :: T.Text
|
otherChars = "-+.@*;\t\n \"{}=" :: T.Text
|
||||||
textElem = T.any . (==)
|
isOther c = T.any (==c) otherChars
|
||||||
|
|
||||||
quoteCommoditySymbolIfNeeded s | T.any (isNonsimpleCommodityChar) s = "\"" <> s <> "\""
|
quoteCommoditySymbolIfNeeded :: T.Text -> T.Text
|
||||||
|
quoteCommoditySymbolIfNeeded s
|
||||||
|
| T.any isNonsimpleCommodityChar s = "\"" <> s <> "\""
|
||||||
| otherwise = s
|
| otherwise = s
|
||||||
|
|
||||||
commodity = ""
|
commodity = ""
|
||||||
|
|||||||
@ -83,11 +83,13 @@ where
|
|||||||
import Prelude ()
|
import Prelude ()
|
||||||
import "base-compat-batteries" Prelude.Compat hiding (fail)
|
import "base-compat-batteries" Prelude.Compat hiding (fail)
|
||||||
import qualified "base-compat-batteries" Control.Monad.Fail.Compat as Fail (MonadFail, fail)
|
import qualified "base-compat-batteries" Control.Monad.Fail.Compat as Fail (MonadFail, fail)
|
||||||
|
import Control.Applicative (liftA2)
|
||||||
import Control.Applicative.Permutations
|
import Control.Applicative.Permutations
|
||||||
import Control.Monad (guard, unless)
|
import Control.Monad (guard, unless)
|
||||||
import "base-compat-batteries" Data.List.Compat
|
import "base-compat-batteries" Data.List.Compat
|
||||||
import Data.Default
|
import Data.Default
|
||||||
import Data.Foldable (asum)
|
import Data.Foldable (asum)
|
||||||
|
import Data.Function (on)
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
import qualified Data.Set as Set
|
import qualified Data.Set as Set
|
||||||
import Data.Text (Text)
|
import Data.Text (Text)
|
||||||
@ -877,13 +879,13 @@ monIndex name = maybe 0 (+1) $ T.toLower name `elemIndex` monthabbrevs
|
|||||||
|
|
||||||
month :: TextParser m SmartDate
|
month :: TextParser m SmartDate
|
||||||
month = do
|
month = do
|
||||||
m <- choice $ map (try . string') months
|
m <- choice $ map string' months
|
||||||
let i = monthIndex m
|
let i = monthIndex m
|
||||||
return ("",show i,"")
|
return ("",show i,"")
|
||||||
|
|
||||||
mon :: TextParser m SmartDate
|
mon :: TextParser m SmartDate
|
||||||
mon = do
|
mon = do
|
||||||
m <- choice $ map (try . string') monthabbrevs
|
m <- choice $ map string' monthabbrevs
|
||||||
let i = monIndex m
|
let i = monIndex m
|
||||||
return ("",show i,"")
|
return ("",show i,"")
|
||||||
|
|
||||||
@ -896,9 +898,9 @@ weekday = do
|
|||||||
show wday <> " in " <> show (weekdays ++ weekdayabbrevs)
|
show wday <> " in " <> show (weekdays ++ weekdayabbrevs)
|
||||||
|
|
||||||
today,yesterday,tomorrow :: TextParser m SmartDate
|
today,yesterday,tomorrow :: TextParser m SmartDate
|
||||||
today = string' "today" >> return ("","","today")
|
today = string' "today" *> return ("","","today")
|
||||||
yesterday = string' "yesterday" >> return ("","","yesterday")
|
yesterday = string' "yesterday" *> return ("","","yesterday")
|
||||||
tomorrow = string' "tomorrow" >> return ("","","tomorrow")
|
tomorrow = string' "tomorrow" *> return ("","","tomorrow")
|
||||||
|
|
||||||
lastthisnextthing :: TextParser m SmartDate
|
lastthisnextthing :: TextParser m SmartDate
|
||||||
lastthisnextthing = do
|
lastthisnextthing = do
|
||||||
@ -1085,41 +1087,36 @@ periodexprdatespanp rdate = choice $ map try [
|
|||||||
-- -- >>> parsewith (doubledatespan (parsedate "2018/01/01") <* eof) "20180101-201804"
|
-- -- >>> parsewith (doubledatespan (parsedate "2018/01/01") <* eof) "20180101-201804"
|
||||||
-- Right DateSpan 2018-01-01..2018-04-01
|
-- Right DateSpan 2018-01-01..2018-04-01
|
||||||
doubledatespanp :: Day -> TextParser m DateSpan
|
doubledatespanp :: Day -> TextParser m DateSpan
|
||||||
doubledatespanp rdate = do
|
doubledatespanp rdate = liftA2 fromToSpan
|
||||||
optional (string' "from" >> skipNonNewlineSpaces)
|
(optional (string' "from" *> skipNonNewlineSpaces) *> smartdate)
|
||||||
b <- smartdate
|
(skipNonNewlineSpaces *> choice [string' "to", string "..", string "-"]
|
||||||
skipNonNewlineSpaces
|
*> skipNonNewlineSpaces *> smartdate)
|
||||||
optional (choice [string' "to", string "..", string' "-"] >> skipNonNewlineSpaces)
|
where
|
||||||
DateSpan (Just $ fixSmartDate rdate b) . Just . fixSmartDate rdate <$> smartdate
|
fromToSpan = DateSpan `on` (Just . fixSmartDate rdate)
|
||||||
|
|
||||||
fromdatespanp :: Day -> TextParser m DateSpan
|
fromdatespanp :: Day -> TextParser m DateSpan
|
||||||
fromdatespanp rdate = do
|
fromdatespanp rdate = fromSpan <$> choice
|
||||||
b <- choice [
|
[ string' "from" *> skipNonNewlineSpaces *> smartdate
|
||||||
do
|
, smartdate <* choice [string "..", string "-"]
|
||||||
string' "from" >> skipNonNewlineSpaces
|
|
||||||
smartdate
|
|
||||||
,
|
|
||||||
do
|
|
||||||
d <- smartdate
|
|
||||||
choice [string "..", string' "-"]
|
|
||||||
return d
|
|
||||||
]
|
]
|
||||||
return $ DateSpan (Just $ fixSmartDate rdate b) Nothing
|
where
|
||||||
|
fromSpan b = DateSpan (Just $ fixSmartDate rdate b) Nothing
|
||||||
|
|
||||||
todatespanp :: Day -> TextParser m DateSpan
|
todatespanp :: Day -> TextParser m DateSpan
|
||||||
todatespanp rdate = do
|
todatespanp rdate =
|
||||||
choice [string' "to", string' "until", string "..", string' "-"] >> skipNonNewlineSpaces
|
choice [string' "to", string' "until", string "..", string "-"]
|
||||||
DateSpan Nothing . Just . fixSmartDate rdate <$> smartdate
|
*> skipNonNewlineSpaces
|
||||||
|
*> (DateSpan Nothing . Just . fixSmartDate rdate <$> smartdate)
|
||||||
|
|
||||||
justdatespanp :: Day -> TextParser m DateSpan
|
justdatespanp :: Day -> TextParser m DateSpan
|
||||||
justdatespanp rdate = do
|
justdatespanp rdate =
|
||||||
optional (string' "in" >> skipNonNewlineSpaces)
|
optional (string' "in" *> skipNonNewlineSpaces)
|
||||||
spanFromSmartDate rdate <$> smartdate
|
*> (spanFromSmartDate rdate <$> smartdate)
|
||||||
|
|
||||||
-- | Make a datespan from two valid date strings parseable by parsedate
|
-- | Make a datespan from two valid date strings parseable by parsedate
|
||||||
-- (or raise an error). Eg: mkdatespan \"2011/1/1\" \"2011/12/31\".
|
-- (or raise an error). Eg: mkdatespan \"2011/1/1\" \"2011/12/31\".
|
||||||
mkdatespan :: String -> String -> DateSpan
|
mkdatespan :: String -> String -> DateSpan
|
||||||
mkdatespan b = DateSpan (Just $ parsedate b) . Just . parsedate
|
mkdatespan = DateSpan `on` (Just . parsedate)
|
||||||
|
|
||||||
nulldatespan :: DateSpan
|
nulldatespan :: DateSpan
|
||||||
nulldatespan = DateSpan Nothing Nothing
|
nulldatespan = DateSpan Nothing Nothing
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user