Clean up parsing functions a bit
This commit is contained in:
parent
560edfac3a
commit
596f3b9bde
1 changed files with 36 additions and 47 deletions
83
src/Cards.hs
83
src/Cards.hs
|
|
@ -89,7 +89,8 @@ updateElements (Elements old) (Elements new) = Elements $ Map.union new old
|
||||||
-- As long as the same numbers are assosiated to the same cards as they were
|
-- As long as the same numbers are assosiated to the same cards as they were
|
||||||
-- originally, this can safely be used to update the original 'Elements'.
|
-- originally, this can safely be used to update the original 'Elements'.
|
||||||
fromCards :: [(Integer, Card)] -> Elements
|
fromCards :: [(Integer, Card)] -> Elements
|
||||||
fromCards = Elements . Map.fromList . mapSnd fromCard
|
fromCards = Elements . Map.fromList . mapSnd ECard
|
||||||
|
where mapSnd f = map (\(a, b) -> (a, f b))
|
||||||
|
|
||||||
-- | Extract all 'Card's from an 'Elements'.
|
-- | Extract all 'Card's from an 'Elements'.
|
||||||
--
|
--
|
||||||
|
|
@ -97,7 +98,7 @@ fromCards = Elements . Map.fromList . mapSnd fromCard
|
||||||
-- and stay associated to their original 'Card'.
|
-- and stay associated to their original 'Card'.
|
||||||
toCards :: Elements -> [(Integer, Card)]
|
toCards :: Elements -> [(Integer, Card)]
|
||||||
toCards (Elements elms) =
|
toCards (Elements elms) =
|
||||||
[(key, card) | (key, Just card) <- mapSnd toCard $ Map.toList elms]
|
[(key, card) | (key, ECard card) <- Map.toList elms]
|
||||||
|
|
||||||
-- | Extract all 'Card's which are due from an 'Elements'.
|
-- | Extract all 'Card's which are due from an 'Elements'.
|
||||||
--
|
--
|
||||||
|
|
@ -106,20 +107,6 @@ toCards (Elements elms) =
|
||||||
toDueCards :: UTCTime -> Elements -> [(Integer, Card)]
|
toDueCards :: UTCTime -> Elements -> [(Integer, Card)]
|
||||||
toDueCards time = filter (isDue time . snd) . toCards
|
toDueCards time = filter (isDue time . snd) . toCards
|
||||||
|
|
||||||
mapSnd :: (b -> c) -> [(a, b)] -> [(a, c)]
|
|
||||||
mapSnd f l = [(a, f b) | (a, b) <- l]
|
|
||||||
|
|
||||||
{-
|
|
||||||
- Element stuff
|
|
||||||
-}
|
|
||||||
|
|
||||||
toCard :: Element -> Maybe Card
|
|
||||||
toCard (ECard c) = Just c
|
|
||||||
toCard _ = Nothing
|
|
||||||
|
|
||||||
fromCard :: Card -> Element
|
|
||||||
fromCard = ECard
|
|
||||||
|
|
||||||
{-
|
{-
|
||||||
- Card stuff
|
- Card stuff
|
||||||
-}
|
-}
|
||||||
|
|
@ -211,24 +198,23 @@ nomToInteger = (truncate :: Double -> Integer) . realToFrac
|
||||||
elementsToString :: Elements -> String
|
elementsToString :: Elements -> String
|
||||||
elementsToString (Elements e) =
|
elementsToString (Elements e) =
|
||||||
let elms = map snd $ sortBy (compare `on` fst) $ Map.toList e
|
let elms = map snd $ sortBy (compare `on` fst) $ Map.toList e
|
||||||
in unlines $ intercalate ["", ""] $ map (\x -> elementToString x) elms
|
in unlines $ intercalate ["", ""] $ map elementToLines elms
|
||||||
|
|
||||||
elementToString :: Element -> [String]
|
elementToLines :: Element -> [String]
|
||||||
elementToString (EComment str) = ['#' : str]
|
elementToLines (EComment str) = lines ('#' : str)
|
||||||
elementToString (ECard card) = cardToString card
|
elementToLines (ECard card) = cardToLines card
|
||||||
|
|
||||||
cardToString :: Card -> [String]
|
cardToLines :: Card -> [String]
|
||||||
cardToString Card{sides=s, tier=t, lastChecked=lc, offset=o}
|
cardToLines Card{sides=s, tier=t, lastChecked=lc, offset=o} =
|
||||||
| t == minBound =
|
let infoTier = show $ fromEnum t
|
||||||
let info = ":: {\"level\": " ++ (show $ fromEnum t) ++
|
infoLastChecked = formatTime defaultTimeLocale "%s" lc
|
||||||
"}"
|
infoOffset = show $ nomToInteger o
|
||||||
in info : intersperse "::" s
|
info = ":: {\"level\": " ++ infoTier ++
|
||||||
| otherwise =
|
if t /= minBound
|
||||||
let info = ":: {\"level\": " ++ (show $ fromEnum t) ++
|
then ", \"last_checked\": " ++ infoLastChecked ++
|
||||||
", \"last_checked\": " ++ formatTime defaultTimeLocale "%s" lc ++
|
", \"delay\": " ++ infoOffset ++ "}"
|
||||||
", \"delay\": " ++ (show $ nomToInteger o) ++
|
else "}"
|
||||||
"}"
|
in info : intercalate ["::"] (map lines s)
|
||||||
in info : intersperse "::" s
|
|
||||||
|
|
||||||
{-
|
{-
|
||||||
- Parsing
|
- Parsing
|
||||||
|
|
@ -237,14 +223,15 @@ cardToString Card{sides=s, tier=t, lastChecked=lc, offset=o}
|
||||||
-- | Simple alias to clean up type signatures.
|
-- | Simple alias to clean up type signatures.
|
||||||
type Parser = Parsec Void String
|
type Parser = Parsec Void String
|
||||||
|
|
||||||
-- useful parsers
|
|
||||||
|
|
||||||
sc :: Parser ()
|
sc :: Parser ()
|
||||||
sc = L.space space1 empty empty
|
sc = L.space space1 empty empty
|
||||||
|
|
||||||
symbol :: String -> Parser String
|
symbol :: String -> Parser String
|
||||||
symbol = L.symbol sc
|
symbol = L.symbol sc
|
||||||
|
|
||||||
|
nonemptyLine :: Parser String
|
||||||
|
nonemptyLine = anyChar `someTill` newline
|
||||||
|
|
||||||
-- Combines try and lookAhead: Never modifies the stack.
|
-- Combines try and lookAhead: Never modifies the stack.
|
||||||
followedBy :: Parser a -> Parser ()
|
followedBy :: Parser a -> Parser ()
|
||||||
followedBy = void . try . lookAhead
|
followedBy = void . try . lookAhead
|
||||||
|
|
@ -260,7 +247,7 @@ separator = void newline <|> void eof <?> "separator"
|
||||||
-- infostring
|
-- infostring
|
||||||
|
|
||||||
infostring :: UTCTime -> Parser Card
|
infostring :: UTCTime -> Parser Card
|
||||||
infostring time = do
|
infostring time = label "infostring" $ do
|
||||||
_ <- string ":: "
|
_ <- string ":: "
|
||||||
cardModifiers <- between (string "{") (string "}") (innerinfo `sepBy` symbol ",")
|
cardModifiers <- between (string "{") (string "}") (innerinfo `sepBy` symbol ",")
|
||||||
let card = createCard time []
|
let card = createCard time []
|
||||||
|
|
@ -270,7 +257,7 @@ innerinfo :: Parser (Card -> Card)
|
||||||
innerinfo = try tierInfo
|
innerinfo = try tierInfo
|
||||||
<|> try lastCheckedInfo
|
<|> try lastCheckedInfo
|
||||||
<|> offsetInfo
|
<|> offsetInfo
|
||||||
<?> "tier info or last checked info or offset info"
|
<?> "inner info"
|
||||||
|
|
||||||
integer :: Parser Integer
|
integer :: Parser Integer
|
||||||
integer = do
|
integer = do
|
||||||
|
|
@ -302,16 +289,16 @@ offsetInfo = do
|
||||||
-- sides of a card
|
-- sides of a card
|
||||||
|
|
||||||
side :: Parser String
|
side :: Parser String
|
||||||
side = anyChar `manyTill` followedBy end
|
side = unlines <$> (nonemptyLine `someTill` followedBy end)
|
||||||
where end = newline >> (void cardSeparator <|> void separator)
|
where end = void cardSeparator <|> void separator
|
||||||
|
|
||||||
pSides :: Parser [String]
|
pSides :: Parser [String]
|
||||||
pSides = side `sepBy1` (try $ newline >> cardSeparator >> newline)
|
pSides = side `sepBy1` (try $ cardSeparator >> newline)
|
||||||
|
|
||||||
-- an actual card
|
-- an actual card
|
||||||
|
|
||||||
pCard :: UTCTime -> Parser Card
|
pCard :: UTCTime -> Parser Card
|
||||||
pCard time = cardInfo time <|> cardNoInfo time
|
pCard time = cardInfo time <|> cardNoInfo time <?> "card"
|
||||||
|
|
||||||
cardInfo :: UTCTime -> Parser Card
|
cardInfo :: UTCTime -> Parser Card
|
||||||
cardInfo time = do
|
cardInfo time = do
|
||||||
|
|
@ -328,8 +315,10 @@ cardNoInfo time = do
|
||||||
-- an element
|
-- an element
|
||||||
|
|
||||||
comment :: Parser Element
|
comment :: Parser Element
|
||||||
comment = char '#' >> EComment <$> (anyChar `manyTill` followedBy end)
|
comment = do
|
||||||
where end = newline >> separator
|
_ <- char '#'
|
||||||
|
text <- nonemptyLine `manyTill` followedBy separator
|
||||||
|
return $ EComment $ unlines text
|
||||||
|
|
||||||
element :: UTCTime -> Parser Element
|
element :: UTCTime -> Parser Element
|
||||||
element time = comment <|> (ECard <$> pCard time) <?> "element"
|
element time = comment <|> (ECard <$> pCard time) <?> "element"
|
||||||
|
|
@ -339,13 +328,13 @@ element time = comment <|> (ECard <$> pCard time) <?> "element"
|
||||||
-- | A megaparsec parser parsing a list of elements in the format of the original python script.
|
-- | A megaparsec parser parsing a list of elements in the format of the original python script.
|
||||||
--
|
--
|
||||||
-- Use this parser if you want nice error messages to display.
|
-- Use this parser if you want nice error messages to display.
|
||||||
parseElements :: UTCTime -> Parser [Element]
|
parseElements :: UTCTime -> Parser Elements
|
||||||
parseElements time = sepEndBy (element time) (some newline) <* eof
|
parseElements time = do
|
||||||
|
elms <- (element time `sepEndBy` some newline) <* label "end of file" eof
|
||||||
|
return $ Elements $ Map.fromList $ zip [1..] elms
|
||||||
|
|
||||||
-- | The 'parseElements' parser, but simpler to use.
|
-- | The 'parseElements' parser, but simpler to use.
|
||||||
--
|
--
|
||||||
-- Use this when the user doesn't need to see any error messages.
|
-- Use this when the user doesn't need to see any error messages.
|
||||||
parseElementsMaybe :: UTCTime -> String -> Maybe Elements
|
parseElementsMaybe :: UTCTime -> String -> Maybe Elements
|
||||||
parseElementsMaybe time str = do
|
parseElementsMaybe time = parseMaybe (parseElements time)
|
||||||
elms <- parseMaybe (parseElements time) str
|
|
||||||
return $ Elements $ Map.fromList $ zip [1..] elms
|
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue