diff --git a/app/Main.hs b/app/Main.hs index e005532..fea499a 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -7,7 +7,6 @@ import Control.Monad import Control.Monad.Trans.Class import Control.Monad.Trans.Maybe import Data.Char -import Data.Maybe import Data.Time import System.Console.Haskeline diff --git a/package.yaml b/package.yaml index 41cd4d0..38fe331 100644 --- a/package.yaml +++ b/package.yaml @@ -25,6 +25,7 @@ dependencies: - time - transformers - haskeline +- megaparsec library: source-dirs: src diff --git a/src/Cards.hs b/src/Cards.hs index 089b644..7838806 100644 --- a/src/Cards.hs +++ b/src/Cards.hs @@ -6,6 +6,7 @@ module Cards , fromCards , elementsToString , parseElements + , parseElementsMaybe , Card -- Card stuff , sides , tier @@ -21,9 +22,14 @@ module Cards , testElements ) where +import Control.Applicative +import Control.Monad import Data.List import qualified Data.Map.Strict as Map import Data.Time +import Data.Void +import Text.Megaparsec +import Text.Megaparsec.Char -- | Contains 'Card's and comments with a certain ordering. -- To update some 'Card's in an 'Elements', use 'toCards' or 'toDueCards' and @@ -65,14 +71,14 @@ data Tier = Unrevised -- Will be removed soon. testElements :: Elements testElements = Elements . Map.fromList. zip [1..] $ - [ card ["first card", "really"] - , card ["second card", "really"] - , comment "first comment" - , card ["third card", "really"] - , comment "second comment" + [ ca ["first card", "really"] + , ca ["second card", "really"] + , co "first comment" + , ca ["third card", "really"] + , co "second comment" ] - where card = ECard . createCard someutctime - comment = EComment + where ca = ECard . createCard someutctime + co = EComment someutctime = UTCTime (ModifiedJulianDay 0) (secondsToDiffTime 0) {- @@ -195,10 +201,10 @@ tierName SixtyFourDays = "64d" elementsToString :: Elements -> String elementsToString (Elements e) = let elms = map snd $ Map.toList e - in unlines $ intercalate ["", ""] $ map (\x -> [elementToString x]) elms + in unlines $ intersperse "" $ map (\x -> elementToString x) elms elementToString :: Element -> String -elementToString (EComment str) = '#' : str +elementToString (EComment str) = unlines ['#' : str] elementToString (ECard card) = cardToString card cardToString :: Card -> String @@ -207,12 +213,84 @@ cardToString Card{sides=s, tier=t, lastChecked=lc, offset=o} = ", \"last_checked\": " ++ (show $ formatTime defaultTimeLocale "%s" lc) ++ ", \"delay\": " ++ (show $ fromEnum o) ++ "}" - in unlines $ info : intersperse "::" s ++ [""] -- newline at the end + in unlines $ info : intersperse "::" s {- - Parsing -} -- | Not yet implemented. -parseElements :: String -> Maybe Elements -parseElements = undefined +type Parser = Parsec Void String + +-- useful parsers + +followedBy :: Parser a -> Parser () +followedBy = void . try . lookAhead + +-- separates sides of cards +cardSeparator :: Parser String +cardSeparator = string "::" "card separator" + +-- separates elements +separator :: Parser () +separator = void newline <|> void eof "separator" + +-- infostring + +infostring :: UTCTime -> Parser Card +infostring time = do + _ <- string ":: " + card <- between (string "{") (string "}") (innerinfo time) + return card + +-- TODO: implement +innerinfo :: UTCTime -> Parser Card +innerinfo = undefined + +-- sides of a card + +side :: Parser String +side = anyChar `manyTill` followedBy end + where end = newline >> (void cardSeparator <|> void separator) + +pSides :: Parser [String] +pSides = side `sepBy1` (try $ newline >> cardSeparator >> newline) + +-- an actual card + +pCard :: UTCTime -> Parser Card +pCard time = cardInfo time <|> cardNoInfo time + +cardInfo :: UTCTime -> Parser Card +cardInfo time = do + Card{tier=t, lastChecked=lc, offset=o} <- infostring time + _ <- newline + s <- pSides + return Card{sides=s, tier=t, lastChecked=lc, offset=o} + +cardNoInfo :: UTCTime -> Parser Card +cardNoInfo time = do + s <- pSides + return $ createCard time s + +-- an element + +comment :: Parser Element +comment = char '#' >> EComment <$> (anyChar `manyTill` followedBy end) + where end = newline >> separator + +element :: UTCTime -> Parser Element +element time = comment <|> (ECard <$> pCard time) "element" + +-- a bunch of elements + +--line :: Parser Element +--line = EComment <$> manyTill anyChar newline + +parseElements :: UTCTime -> Parser [Element] +parseElements time = sepEndBy (element time) (some newline) <* eof + +parseElementsMaybe :: UTCTime -> String -> Maybe Elements +parseElementsMaybe time str = do + elms <- parseMaybe (parseElements time) str + return $ Elements $ Map.fromList $ zip [1..] elms