bookhound 0.1.2.0 → 0.1.3.0
raw patch · 23 files changed
+257/−264 lines, 23 filesdep −splitPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependencies removed: split
API changes (from Hackage documentation)
- Parser: toEither :: ParseResult a -> Either ParseError a
- Parser: type Input = String
- ParserCombinators: instance ParserCombinators.IsMatch GHC.Integer.Type.Integer
- ParserCombinators: instance ParserCombinators.IsMatch GHC.Types.Double
- ParserCombinators: instance ParserCombinators.IsMatch GHC.Types.Int
- Parsers.DateTime: range :: Ord a => a -> a -> a -> Bool
- Parsers.DateTime: secondDecimals :: Parser Integer
- Utils.String: instance Utils.String.ToString GHC.Base.String
+ ParserCombinators: infixl 3 <&>
+ ParserCombinators: infixl 6 >>>
+ ParserCombinators: instance (GHC.Num.Num a, GHC.Read.Read a, GHC.Show.Show a) => ParserCombinators.IsMatch a
+ Parsers.Collections: csvOf :: Parser a -> Parser [a]
- Utils.Map: showMap :: Show a => String -> (String -> String) -> (a -> String) -> Map String a -> [String]
+ Utils.Map: showMap :: String -> (String -> String) -> (a -> String) -> Map String a -> [String]
Files
- bookhound.cabal +29/−2
- src/Operations/Finder.hs +31/−33
- src/Operations/ToJson.hs +9/−11
- src/Operations/ToXml.hs +8/−9
- src/Operations/ToYaml.hs +6/−13
- src/Parser.hs +27/−28
- src/ParserCombinators.hs +23/−27
- src/Parsers/Char.hs +0/−1
- src/Parsers/Collections.hs +14/−14
- src/Parsers/DateTime.hs +34/−40
- src/Parsers/Json.hs +10/−11
- src/Parsers/Number.hs +4/−6
- src/Parsers/String.hs +5/−4
- src/Parsers/Toml.hs +15/−15
- src/Parsers/Xml.hs +8/−10
- src/Parsers/Yaml.hs +15/−14
- src/SyntaxTrees/Json.hs +2/−4
- src/SyntaxTrees/Toml.hs +4/−4
- src/SyntaxTrees/Xml.hs +1/−3
- src/SyntaxTrees/Yaml.hs +7/−7
- src/Utils/DateTime.hs +2/−0
- src/Utils/Map.hs +1/−1
- src/Utils/String.hs +2/−7
bookhound.cabal view
@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: bookhound-version: 0.1.2.0+version: 0.1.3.0 synopsis: Simple Parser Combinators & Parsers for usual data formats description: Please see the README on GitHub at <https://github.com/albertprz/bookhound#readme> category: Parsers@@ -53,9 +53,36 @@ Paths_bookhound hs-source-dirs: src+ default-extensions:+ LambdaCase+ EmptyCase+ EmptyDataDecls+ MultiWayIf+ ApplicativeDo+ TupleSections+ NamedFieldPuns+ PostfixOperators+ BangPatterns+ PatternSynonyms+ FlexibleContexts+ FlexibleInstances+ MultiParamTypeClasses+ GADTs+ TypeFamilies+ FunctionalDependencies+ TypeFamilyDependencies+ TypeApplications+ ScopedTypeVariables+ DataKinds+ PolyKinds+ DeriveFunctor+ DeriveFoldable+ DeriveTraversable+ DeriveGeneric+ GeneralizedNewtypeDeriving+ ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints build-depends: base >=4.7 && <5 , containers >=0.6 && <1- , split >=0.2.3 && <0.3 , time >=1.9 && <2 default-language: Haskell2010
src/Operations/Finder.hs view
@@ -1,6 +1,4 @@-{-# LANGUAGE PostfixOperators #-}--module Operations.Finder where+module Operations.Finder (Finder(..)) where import Parser (runParser)@@ -39,7 +37,7 @@ findByPath path = findByKeys pathSeq where pathSeq = fromRight [] $ runParser parsePath path- parsePath = is '$' *> (index <|> key |*)+ parsePath = is '$' *> ((index <|> key) |*) index = show <$> withinSquareBrackets unsignedInt key = dot *> word@@ -48,38 +46,38 @@ instance Finder JsExpression where- toList expr = case expr of- null @ JsNull -> [("", null)]- n @ (JsNumber _) -> [("", n)]- bool @ (JsBool _) -> [("", bool)]- str @ (JsString _) -> [("", str)]- JsArray arr -> zip (show <$> [0 .. length arr - 1]) arr- JsObject obj -> Map.toList obj+ toList = \case+ nil@JsNull -> [("", nil)]+ n@(JsNumber _) -> [("", n)]+ bool@(JsBool _) -> [("", bool)]+ str@(JsString _) -> [("", str)]+ JsArray arr -> zip (show <$> [0 .. length arr - 1]) arr+ JsObject obj -> Map.toList obj instance Finder YamlExpression where- toList expr = case expr of- null @ YamlNull -> [("", null)]- n @ (YamlInteger _) -> [("", n)]- n @ (YamlFloat _) -> [("", n)]- bool @ (YamlBool _) -> [("", bool)]- str @ (YamlString _) -> [("", str)]- date @ (YamlDate _) -> [("", date)]- time @ (YamlTime _) -> [("", time)]- dateTime @ (YamlDateTime _) -> [("", dateTime)]- YamlList _ arr -> zip (show <$> [0 .. length arr - 1]) arr- YamlMap _ obj -> Map.toList obj+ toList = \case+ nil@YamlNull -> [("", nil)]+ n@(YamlInteger _) -> [("", n)]+ n@(YamlFloat _) -> [("", n)]+ bool@(YamlBool _) -> [("", bool)]+ str@(YamlString _) -> [("", str)]+ date@(YamlDate _) -> [("", date)]+ time@(YamlTime _) -> [("", time)]+ dateTime@(YamlDateTime _) -> [("", dateTime)]+ YamlList _ arr -> zip (show <$> [0 .. length arr - 1]) arr+ YamlMap _ obj -> Map.toList obj instance Finder TomlExpression where- toList expr = case expr of- null @ TomlNull -> [("", null)]- n @ (TomlInteger _) -> [("", n)]- n @ (TomlFloat _) -> [("", n)]- bool @ (TomlBool _) -> [("", bool)]- str @ (TomlString _) -> [("", str)]- date @ (TomlDate _) -> [("", date)]- time @ (TomlTime _) -> [("", time)]- dateTime @ (TomlDateTime _) -> [("", dateTime)]- TomlArray arr -> zip (show <$> [0 .. length arr - 1]) arr- TomlTable _ obj -> Map.toList obj+ toList = \case+ nil@TomlNull -> [("", nil)]+ n@(TomlInteger _) -> [("", n)]+ n@(TomlFloat _) -> [("", n)]+ bool@(TomlBool _) -> [("", bool)]+ str@(TomlString _) -> [("", str)]+ date@(TomlDate _) -> [("", date)]+ time@(TomlTime _) -> [("", time)]+ dateTime@(TomlDateTime _) -> [("", dateTime)]+ TomlArray arr -> zip (show <$> [0 .. length arr - 1]) arr+ TomlTable _ obj -> Map.toList obj
src/Operations/ToJson.hs view
@@ -1,6 +1,4 @@-{-# LANGUAGE PostfixOperators, FlexibleInstances, IncoherentInstances #-}--module Operations.ToJson where+module Operations.ToJson (ToJson(..)) where import SyntaxTrees.Json (JsExpression(..)) import SyntaxTrees.Xml (XmlExpression(..))@@ -8,11 +6,11 @@ import SyntaxTrees.Toml (TomlExpression(..)) import Parsers.Json (json) import Parsers.String (spacing)-import Parser (Parser(parse), toEither)+import Parser (runParser) import ParserCombinators (IsMatch(..), (<|>), (|*), maybeWithin) import qualified Data.Map as Map-import Data.Map (Map, elems, mapKeys)+import Data.Map (Map, elems) import Data.Either (fromRight) @@ -20,10 +18,13 @@ toJson :: a -> JsExpression +instance {-# OVERLAPPABLE #-} ToJson JsExpression where+ toJson = id+ instance ToJson XmlExpression where toJson XmlExpression { tagName = tag, fields = flds, expressions = exprs }- | tag == "literal" = fromRight JsNull . toEither . parse literalParser .+ | tag == "literal" = fromRight JsNull . runParser literalParser . head . elems $ flds | tag == "array" = JsArray $ childExprToJson <$> exprs | tag == "object" = JsObject . Map.fromList $ (\x -> (tagName x, childExprToJson x)) <$>@@ -37,7 +38,7 @@ instance ToJson YamlExpression where - toJson expr = case expr of+ toJson = \case YamlNull -> JsNull YamlInteger n -> JsNumber $ fromIntegral n YamlFloat n -> JsNumber n@@ -52,7 +53,7 @@ instance ToJson TomlExpression where - toJson expr = case expr of+ toJson = \case TomlNull -> JsNull TomlInteger n -> JsNumber $ fromIntegral n TomlFloat n -> JsNumber n@@ -64,9 +65,6 @@ TomlArray list -> JsArray $ toJson <$> list TomlTable _ mapping -> JsObject $ toJson <$> mapping --instance ToJson JsExpression where- toJson = id instance ToJson String where
src/Operations/ToXml.hs view
@@ -1,6 +1,6 @@-{-# LANGUAGE PostfixOperators, FlexibleInstances, UndecidableInstances, IncoherentInstances #-}+{-# LANGUAGE UndecidableInstances #-} -module Operations.ToXml where+module Operations.ToXml (ToXml(..)) where import SyntaxTrees.Xml (XmlExpression(..), literalExpression) import SyntaxTrees.Json (JsExpression(..))@@ -14,13 +14,16 @@ toXml :: a -> XmlExpression +instance {-# OVERLAPPABLE #-} ToJson a => ToXml a where+ toXml = toXml . toJson+ instance ToXml XmlExpression where toXml = id instance ToXml JsExpression where - toXml x = case x of+ toXml = \case JsNull -> literalExpression "null" JsNumber n -> literalExpression $ show n JsBool bool -> literalExpression $ toLower <$> show bool@@ -28,16 +31,12 @@ JsArray arr -> XmlExpression "array" Map.empty (elemExpr <$> arr) where - elemExpr elem = XmlExpression { tagName = "elem",+ elemExpr element = XmlExpression { tagName = "elem", fields = Map.empty,- expressions = [toXml elem] }+ expressions = [toXml element] } JsObject obj -> XmlExpression "object" Map.empty (keyValueExpr <$> Map.toList obj) where keyValueExpr (key, value) = XmlExpression { tagName = key, fields = Map.empty, expressions = [toXml value] }---instance ToJson a => ToXml a where- toXml = toXml . toJson
src/Operations/ToYaml.hs view
@@ -1,36 +1,29 @@-{-# LANGUAGE FlexibleInstances, UndecidableInstances, IncoherentInstances #-}+{-# LANGUAGE UndecidableInstances #-} -module Operations.ToYaml where+module Operations.ToYaml (ToYaml(..)) where import SyntaxTrees.Yaml (YamlExpression(..), CollectionType(..)) import SyntaxTrees.Json (JsExpression(..)) import Operations.ToJson (ToJson(..))-import Parsers.String (spacing) import Parsers.Number (intLike)-import ParserCombinators ((<|>))-import Parser (Parser(), runParser)--import Data.Char (toLower)+import Parser (runParser) class ToYaml a where toYaml :: a -> YamlExpression +instance {-# OVERLAPPABLE #-} ToJson a => ToYaml a where+ toYaml = toYaml . toJson instance ToYaml YamlExpression where toYaml = id - instance ToYaml JsExpression where - toYaml x = case x of+ toYaml = \case JsNull -> YamlNull JsNumber n -> either (const (YamlFloat n)) YamlInteger $ runParser intLike $ show n JsBool bool -> YamlBool bool JsString str -> YamlString str JsArray arr -> YamlList Standard $ toYaml <$> arr JsObject obj -> YamlMap Standard $ toYaml <$> obj---instance ToJson a => ToYaml a where- toYaml = toYaml . toJson
src/Parser.hs view
@@ -1,7 +1,8 @@-module Parser where+module Parser (Parser(..), ParseResult(..), ParseError(..), runParser, errorParser,+ andThen, exactly, isMatch, check, except, anyOf, allOf, char) where -import Data.Maybe (maybeToList) import Data.Either (fromRight)+import Data.Functor((<&>)) type Input = String @@ -28,7 +29,7 @@ instance Functor ParseResult where fmap f (Result i a) = Result i (f a)- fmap f (Error pe) = Error pe+ fmap _ (Error pe) = Error pe instance Functor Parser where@@ -36,64 +37,62 @@ instance Applicative Parser where pure a = P (`Result` a)- (<*>) mf ma = mf >>= (\f -> ma >>= (pure . f))+ (<*>) mf ma = mf >>= (ma <&>) instance Monad Parser where (>>=) (P p) f = P (- \i -> case p i of+ \x -> case p x of Result i a -> parse (f a) i Error pe -> Error pe) runParser :: Parser a -> Input -> Either ParseError a-runParser p i = toEither $ parse p i+runParser p i = toEither $ parse p i where + toEither = \case+ Error pe -> Left pe+ Result input a -> if null input then Right a+ else Left $ ExpectedEof input -toEither :: ParseResult a -> Either ParseError a-toEither result = case result of- Error pe -> Left pe- Result input a -> if null input then Right a- else Left $ ExpectedEof input+errorParser :: ParseError -> Parser a+errorParser = P . const . Error char :: Parser Char char = P parseIt where parseIt [] = Error UnexpectedEof- parseIt (char : rest) = Result rest char+ parseIt (ch : rest) = Result rest ch -errorParser :: ParseError -> Parser a-errorParser = P . const . Error - andThen :: Parser Input -> Parser a -> Parser a andThen p1 p2 = P (\i -> parse p2 $ fromRight i $ runParser p1 i) exactly :: Parser a -> Parser a exactly (P p) = P (- \i -> case p i of- result @ (Result "" _) -> result- result @ (Result i _) -> Error $ ExpectedEof i- error @ (Error _) -> error)+ \x -> case p x of+ result@(Result "" _) -> result+ Result i _ -> Error $ ExpectedEof i+ err@(Error _) -> err) anyOf :: [Parser a] -> Parser a anyOf [] = errorParser UnexpectedEof anyOf [x] = x anyOf ((P p) : rest) = P (- \i -> case p i of- result @ (Result _ _) -> result- error @ (Error _) -> parse (anyOf rest) i)+ \x -> case p x of+ result@(Result _ _) -> result+ Error _ -> parse (anyOf rest) x) allOf :: [Parser a] -> Parser a allOf [] = errorParser UnexpectedEof allOf [x] = x allOf ((P p) : rest) = P (- \i -> case p i of- result @ (Result _ _) -> parse (allOf rest) i- error @ (Error _) -> error)+ \x -> case p x of+ Result i _ -> parse (allOf rest) i+ err@(Error _) -> err) isMatch :: (Char -> Char -> Bool) -> Parser Char -> Char -> Parser Char@@ -116,6 +115,6 @@ except :: Show a => Parser a -> Parser a -> Parser a except alt (P p) = P (- \i -> case p i of- result @ (Result _ a) -> Error $ UnexpectedString (show a)- error @ (Error _) -> parse alt i)+ \x -> case p x of+ Result _ a -> Error $ UnexpectedString (show a)+ Error _ -> parse alt x)
src/ParserCombinators.hs view
@@ -1,54 +1,46 @@-{-# LANGUAGE FlexibleInstances, IncoherentInstances, PostfixOperators #-}+{-# LANGUAGE UndecidableInstances #-} -module ParserCombinators where+module ParserCombinators (IsMatch(..), satisfies, contains, notContains,+ times, maybeTimes, anyTimes, someTimes, manyTimes,+ within, maybeWithin, withinBoth, maybeWithinBoth,+ (<|>), (<&>), (<#>), (>>>), (|?), (|*), (|+), (|++)) where import Parser (Parser, char, isMatch, check, anyOf, allOf, except) import Utils.Foldable (hasSome, hasMany) import Utils.String (ToString(..)) import Utils.Applicative (extract) -import Data.Maybe (listToMaybe, maybeToList)+import Data.Maybe (listToMaybe) import Data.List (isInfixOf) class IsMatch a where- is :: a -> Parser a- isNot :: a -> Parser a- oneOf :: [a] -> Parser a- noneOf :: [a] -> Parser a+ is :: a -> Parser a+ isNot :: a -> Parser a+ oneOf :: [a] -> Parser a+ noneOf :: [a] -> Parser a inverse :: Parser a -> Parser a - oneOf xs = anyOf $ is <$> xs+ oneOf xs = anyOf $ is <$> xs noneOf xs = allOf $ isNot <$> xs instance IsMatch Char where- is = isMatch (==) char- isNot = isMatch (/=) char+ is = isMatch (==) char+ isNot = isMatch (/=) char inverse = except char instance IsMatch String where- is = traverse is- isNot = traverse isNot+ is = traverse is+ isNot = traverse isNot inverse = except (char |*) -instance IsMatch Integer where- is n = read <$> (is . show) n- isNot n = read <$> (isNot . show) n- inverse p = read <$> inverse (show <$> p)--instance IsMatch Int where- is n = read <$> (is . show) n- isNot n = read <$> (isNot . show) n- inverse p = read <$> inverse (show <$> p)--instance IsMatch Double where- is n = read <$> (is . show) n- isNot n = read <$> (isNot . show) n+instance {-# OVERLAPPABLE #-} (Num a, Read a, Show a) => IsMatch a where+ is n = read <$> (is . show) n+ isNot n = read <$> (isNot . show) n inverse p = read <$> inverse (show <$> p) - -- Condition combinators satisfies :: Parser a -> (a -> Bool) -> Parser a satisfies parser cond = check "satisfies" cond parser@@ -90,17 +82,21 @@ maybeWithinBoth :: Parser a -> Parser b -> Parser c -> Parser c maybeWithinBoth p1 p2 = extract (p1 |?) (p2 |?) - -- Parser Binary Operators++infixl 3 <|> (<|>) :: Parser a -> Parser a -> Parser a (<|>) p1 p2 = anyOf [p1, p2] +infixl 3 <&> (<&>) :: Parser a -> Parser a -> Parser a (<&>) p1 p2 = allOf [p1, p2] +infixl 6 <#> (<#>) :: Parser a -> Integer -> Parser [a] (<#>) = times +infixl 6 >>> (>>>) :: (ToString a, ToString b) => Parser a -> Parser b -> Parser String (>>>) p1 p2 = p1 >>= (\x -> (x ++) <$> (toString <$> p2)) . toString
src/Parsers/Char.hs view
@@ -3,7 +3,6 @@ import qualified Parser import Parser (Parser) import ParserCombinators (IsMatch(..), (<|>))-import Data.Data (ConstrRep(CharConstr)) char :: Parser Char
src/Parsers/Collections.hs view
@@ -1,11 +1,9 @@-{-# LANGUAGE PostfixOperators #-}--module Parsers.Collections where+module Parsers.Collections (collOf, listOf, tupleOf, mapOf, csvOf) where import Parser (Parser)-import ParserCombinators (IsMatch(..), (<|>), (|*), (|?), maybeWithin)-import Parsers.Char (colon, comma, openSquare, closeSquare,- openParens, closeParens, openCurly, closeCurly)+import ParserCombinators ((|*), (|?), maybeWithin)+import Parsers.Char (comma, openSquare, closeSquare, openParens,+ closeParens, openCurly, closeCurly) import Parsers.String(spacing) import qualified Data.Foldable as Foldable@@ -16,9 +14,9 @@ collOf :: Parser a -> Parser b -> Parser c -> Parser d -> Parser [d] collOf sep start end elemParser = do start elems <- ((maybeWithin spacing $ elemParser <* sep) |*)- elem <- maybeWithin spacing (elemParser |?)+ element <- maybeWithin spacing (elemParser |?) end- pure (elems ++ Foldable.toList elem)+ pure (elems ++ Foldable.toList element) listOf :: Parser a -> Parser [a]@@ -28,10 +26,12 @@ tupleOf = collOf comma openParens closeParens mapOf :: Ord b => Parser a -> Parser b -> Parser c -> Parser (Map b c)-mapOf sep p1 p2 = Map.fromList <$> collOf comma openCurly closeCurly- (mapEntryOf p1 p2) where+mapOf sep p1 p2 = Map.fromList <$> collOf comma openCurly closeCurly mapEntry where - mapEntryOf p1 p2 = do key <- p1- maybeWithin spacing sep- value <- p2- pure (key, value)+ mapEntry = do key <- p1+ maybeWithin spacing sep+ value <- p2+ pure (key, value)++csvOf :: Parser a -> Parser [a]+csvOf = collOf comma (pure ()) (pure ())
src/Parsers/DateTime.hs view
@@ -1,9 +1,8 @@-{-# LANGUAGE PostfixOperators #-}--module Parsers.DateTime where+module Parsers.DateTime (date, time, timeZoneOffset, localDateTime, offsetDateTime,+ dateTime, year, day, month, hour, minute, second) where import Parser(Parser(..), check)-import ParserCombinators (IsMatch(..), (<|>), (<#>), (|?), (|*), (|+), within)+import ParserCombinators (IsMatch(..), (<|>), (<#>), (|?), (|+), within) import Parsers.Char (digit, dash, colon, plus) import Data.Time (Day, LocalTime(..), TimeOfDay(..), TimeZone, ZonedTime(..),@@ -11,6 +10,36 @@ import Data.Maybe (fromMaybe) +date :: Parser Day+date = fromGregorian <$> year <*> within dash month <*> day+++time :: Parser TimeOfDay+time = do h <- hour+ m <- colon *> minute+ s <- colon *> second+ decimals <- fromMaybe 0 <$> ((colon *> secondDecimals) |?)+ pure $ TimeOfDay h m $ read (show s ++ "." ++ show decimals)+++timeZoneOffset :: Parser TimeZone+timeZoneOffset = do pos <- (True <$ plus) <|> (False <$ dash)+ h <- hour+ m <- fromMaybe 0 <$> ((colon *> minute) |?)+ pure $ minutesToTimeZone $ (if pos then 1 else (-1)) * (h * 60 + m)++localDateTime :: Parser LocalTime+localDateTime = LocalTime <$> (date <* oneOf ['T', 't']) <*> time++offsetDateTime :: Parser ZonedTime+offsetDateTime = ZonedTime <$> localDateTime <*> timeZoneOffset++dateTime :: Parser ZonedTime+dateTime = ((`ZonedTime` minutesToTimeZone 0) <$> localDateTime <* is 'Z') <|>+ offsetDateTime+++ year :: Parser Integer year = read <$> digit <#> 4 @@ -34,42 +63,7 @@ -date :: Parser Day-date = do y <- year- m <- within dash month- d <- day- pure $ fromGregorian y m d -time :: Parser TimeOfDay-time = do h <- hour- min <- colon *> minute- s <- colon *> second- decimals <- fromMaybe (toInteger 0) <$> ((colon *> secondDecimals) |?)- pure $ TimeOfDay h min $ read (show s ++ "." ++ show decimals)---timeZoneOffset :: Parser TimeZone-timeZoneOffset = do pos <- (True <$ plus) <|> (False <$ dash)- h <- hour- min <- fromMaybe 0 <$> ((colon *> minute) |?)- pure $ minutesToTimeZone $ (if pos then 1 else (-1)) * (h * 60 + min)--localDateTime :: Parser LocalTime-localDateTime = do d <- date- oneOf ['T', 't']- t <- time- pure $ LocalTime d t--offsetDateTime :: Parser ZonedTime-offsetDateTime = do localTime <- localDateTime- offset <- timeZoneOffset- pure $ ZonedTime localTime offset--dateTime :: Parser ZonedTime-dateTime = ((`ZonedTime` minutesToTimeZone 0) <$> localDateTime <* is 'Z') <|>- offsetDateTime-- range :: Ord a => a -> a -> a -> Bool-range min max x = x >= min && x <= max+range mn mx x = x >= mn && x <= mx
src/Parsers/Json.hs view
@@ -1,17 +1,20 @@-{-# LANGUAGE PostfixOperators #-}- module Parsers.Json (json, nil, number, bool, string, array, object) where -import Parser(Parser(parse), exactly)-import ParserCombinators (IsMatch(..), (<|>), (>>>), (|*), (|?), maybeWithin)+import Parser(Parser, exactly)+import ParserCombinators (IsMatch(..), (<|>), (|*), maybeWithin) import Parsers.Number (double) import Parsers.Collections (listOf, mapOf)-import Parsers.Char (char, doubleQuote, colon)+import Parsers.Char (doubleQuote, colon) import Parsers.String (withinDoubleQuotes, spacing) import SyntaxTrees.Json (JsExpression(..)) +json :: Parser JsExpression+json = maybeWithin spacing jsValue where + jsValue = element <|> container++ nil :: Parser JsExpression nil = JsNull <$ is "null" @@ -20,8 +23,8 @@ bool :: Parser JsExpression-bool = JsBool <$> (True <$ is "true") <|>- (False <$ is "false")+bool = JsBool <$> (True <$ is "true" <|>+ False <$ is "false") string :: Parser JsExpression@@ -43,10 +46,6 @@ container = array <|> object -json :: Parser JsExpression-json = maybeWithin spacing jsValue where-- jsValue = element <|> container text :: Parser String
src/Parsers/Number.hs view
@@ -1,9 +1,7 @@-{-# LANGUAGE PostfixOperators #-}--module Parsers.Number where+module Parsers.Number (int, double, posInt, negInt, unsignedInt, hexInt, octInt, intLike) where import Parser (Parser, errorParser, ParseError(..))-import ParserCombinators (IsMatch(..), (>>>), (<|>), (|*), (|+), (|?))+import ParserCombinators (IsMatch(..), (>>>), (<|>), (|+), (|?)) import Parsers.Char (digit, dot, dash, plus) @@ -39,7 +37,7 @@ double :: Parser Double-double = read <$> int >>> (decimals |?) >>> (exp |?) where+double = read <$> int >>> (decimals |?) >>> (expn |?) where decimals = dot >>> unsignedInt- exp = oneOf ['e', 'E'] >>> int+ expn = oneOf ['e', 'E'] >>> int
src/Parsers/String.hs view
@@ -1,10 +1,11 @@-{-# LANGUAGE PostfixOperators #-}- module Parsers.String where import Parser (Parser)-import ParserCombinators (IsMatch(..), (|*), (|+), (|?), (<|>), (>>>), within, withinBoth)-import Parsers.Char+import ParserCombinators (IsMatch(..), (|*), (|+), (|?), (>>>), within, withinBoth)+import Parsers.Char (char, digit, upper, lower, letter, alpha, alphaNum,+ space, tab, spaceOrTab, whiteSpace, newLine, quote,+ doubleQuote, openParens, closeParens, openSquare,+ closeSquare, openCurly, closeCurly, openAngle, closeAngle) string :: Parser String
src/Parsers/Toml.hs view
@@ -1,26 +1,30 @@-{-# LANGUAGE PostfixOperators #-}--module Parsers.Toml (toml, nil, integer, float, bool, string, array, inlineTable) where+module Parsers.Toml (toml, nil, integer, float, bool, string,+ array, inlineTable) where -import Parser(Parser(..), ParseError(..), errorParser, check, andThen, exactly)+import Parser(Parser) import ParserCombinators (IsMatch(..), (<|>), (>>>), (<#>), (|?), (|*), (|+), maybeWithin, within) import Parsers.Number (double, hexInt, int, octInt) import Parsers.String (blankLine, withinQuotes, withinDoubleQuotes,- spacesOrTabs, spaces, withinSquareBrackets, spacing, blankLines)-import Parsers.Char (quote, doubleQuote, whiteSpace, hashTag, space, newLine,+ spacesOrTabs, withinSquareBrackets, spacing, blankLines)+import Parsers.Char (quote, doubleQuote, whiteSpace, hashTag, newLine, dot, digit, letter, underscore, dash, equal, spaceOrTab) import SyntaxTrees.Toml (TomlExpression(..), TableType(..)) import Parsers.Collections (mapOf, listOf) import qualified Parsers.DateTime as Dt import qualified Data.Map as Map-import Data.Map (Map) import Data.Maybe (maybeToList) --- TODO: Add support for anchors and aliases +toml :: Parser TomlExpression+toml = maybeWithin (((pure <$> whiteSpace) <|> comment) |+) topLevelTable++++-- TODO: Add support for table arrays+ nil :: Parser TomlExpression nil = TomlNull <$ is "null" @@ -31,8 +35,8 @@ float = TomlFloat <$> double bool :: Parser TomlExpression-bool = TomlBool <$> (True <$ is "true") <|>- (False <$ is "false")+bool = TomlBool <$> (True <$ is "true" <|>+ False <$ is "false") dateTime :: Parser TomlExpression@@ -69,7 +73,7 @@ withinDoubleQuotes (inverse doubleQuote |*) <|> withinQuotes (inverse quote |*) - freeText = (letter <|> digit <|> underscore <|> dash |+)+ freeText = ((letter <|> digit <|> underscore <|> dash) |+) inlineTable :: Parser TomlExpression@@ -118,7 +122,3 @@ tomlExpr = maybeWithin (((pure <$> spaceOrTab) <|> comment) |+) tomlValue where tomlValue = element <|> container---toml :: Parser TomlExpression-toml = maybeWithin (((pure <$> whiteSpace) <|> comment) |+) topLevelTable
src/Parsers/Xml.hs view
@@ -1,11 +1,8 @@-{-# LANGUAGE PostfixOperators #-}- module Parsers.Xml (xml, branchExpr, leafExpr, literal) where import Parser (Parser)-import ParserCombinators (IsMatch(..), (<|>), (>>>), (|*), (|+), maybeWithin)-import Parsers.Number (double)-import Parsers.Char (space, doubleQuote)+import ParserCombinators (IsMatch(..), (<|>), (|*), (|+), maybeWithin)+import Parsers.Char (doubleQuote) import Parsers.String (withinDoubleQuotes, withinAngleBrackets, spacing) import SyntaxTrees.Xml ( XmlExpression(..), literalExpression ) @@ -14,6 +11,12 @@ +xml :: Parser XmlExpression+xml = maybeWithin ((header <|> comment) |+) $+ maybeWithin spacing $ branchExpr <|> leafExpr+++ field :: Parser (String, String) field = do x <- text is '='@@ -52,11 +55,6 @@ comment :: Parser String comment = maybeWithin spacing $ is "<!--" *> (isNot '-' |*) <* is "-->" ---xml :: Parser XmlExpression-xml = maybeWithin ((header <|> comment) |+) $- maybeWithin spacing $ branchExpr <|> leafExpr text :: Parser String
src/Parsers/Yaml.hs view
@@ -1,10 +1,9 @@-{-# LANGUAGE PostfixOperators #-}--module Parsers.Yaml (yaml, nil, integer, float, bool, string, list, mapping) where+module Parsers.Yaml (yaml, nil, integer, float, bool, string,+ list, mapping) where import SyntaxTrees.Yaml (YamlExpression(..), CollectionType(..))-import Parser(Parser(..), ParseError(..), errorParser, check, andThen, exactly)+import Parser(Parser(..), check, andThen, exactly) import ParserCombinators (IsMatch(..), (<|>), (<#>), (>>>), (|?), (|*), (|+), (|++), maybeWithin) import Parsers.Number (double, hexInt, int, octInt) import Parsers.String (spaces, spacesOrTabs, withinDoubleQuotes, withinQuotes,@@ -15,12 +14,18 @@ import qualified Parsers.DateTime as Dt import qualified Data.Map as Map-import Data.Map (Map) import Data.List (nub) --- TODO: Add support for table arrays +yaml :: Parser YamlExpression+yaml = normalize `andThen` yamlWithIndent (-1)+++++-- TODO: Add support for anchors and aliases+ nil :: Parser YamlExpression nil = YamlNull <$ oneOf ["null", "Null", "NULL"] @@ -31,8 +36,8 @@ float = YamlFloat <$> double bool :: Parser YamlExpression-bool = YamlBool <$> (True <$ oneOf ["true", "True", "TRUE"]) <|>- (False <$ oneOf ["false", "False", "FALSE"])+bool = YamlBool <$> (True <$ oneOf ["true", "True", "TRUE"] <|>+ False <$ oneOf ["false", "False", "FALSE"]) dateTime :: Parser YamlExpression@@ -56,8 +61,8 @@ elemParser = do n <- length <$> (space |*) sep *> whiteSpace- elem <- yamlWithIndent n- pure (n, elem)+ elm <- yamlWithIndent n+ pure (n, elm) list :: Int -> Parser YamlExpression@@ -114,10 +119,6 @@ docStart = dash <#> 3 docEnd = dot <#> 3 ---yaml :: Parser YamlExpression-yaml = normalize `andThen` yamlWithIndent (-1)
src/SyntaxTrees/Json.hs view
@@ -1,6 +1,4 @@-{-# LANGUAGE PostfixOperators, TupleSections #-}--module SyntaxTrees.Json where+module SyntaxTrees.Json (JsExpression(..)) where import Utils.Foldable (stringify) import Utils.Map (showMap)@@ -18,7 +16,7 @@ instance Show JsExpression where- show expr = case expr of+ show = \case JsNull -> "null" JsNumber n -> show n JsBool bool -> toLower <$> show bool
src/SyntaxTrees/Toml.hs view
@@ -1,12 +1,12 @@-module SyntaxTrees.Toml where+module SyntaxTrees.Toml (TomlExpression(..), TableType(..)) where import Utils.DateTime (showDateTime) import Utils.Foldable (stringify) import Utils.Map (showMap) -import Data.Map (Map, keys, elems)+import Data.Map (Map) import qualified Data.Map as Map-import Data.Time (Day, TimeOfDay, ZonedTime(..), LocalTime(..))+import Data.Time (Day, TimeOfDay, ZonedTime(..)) import Data.Char (toLower) @@ -24,7 +24,7 @@ instance Show TomlExpression where- show expr = case expr of+ show = \case TomlNull -> "null" TomlInteger n -> show n TomlFloat n -> show n
src/SyntaxTrees/Xml.hs view
@@ -1,6 +1,4 @@-{-# LANGUAGE NamedFieldPuns #-}--module SyntaxTrees.Xml where+module SyntaxTrees.Xml (XmlExpression(..), literalExpression, flatten, findAll, find) where import Utils.Foldable (stringify)
src/SyntaxTrees/Yaml.hs view
@@ -1,13 +1,13 @@ module SyntaxTrees.Yaml (YamlExpression(..), CollectionType(..)) where -import Utils.DateTime (showDateTime)+import Utils.DateTime () import Utils.Foldable (stringify) import Utils.Map (showMap) import Data.Map (Map) import qualified Data.Map as Map import Data.Char (toLower)-import Data.Time (Day, TimeOfDay, ZonedTime(..), LocalTime(..))+import Data.Time (Day, TimeOfDay, ZonedTime(..)) @@ -23,7 +23,7 @@ instance Show YamlExpression where- show expr = case expr of+ show = \case YamlNull -> "null" YamlInteger n -> show n YamlFloat n -> show n@@ -51,11 +51,11 @@ else "") ++ (if not $ any (`elem` str) forbiddenChar then str- else if '"' `elem` str then "'" ++ indented str 3 ++ "'"- else "\"" ++ indented str 3) ++ "\"" where+ else if '"' `elem` str then "'" ++ indented 3 ++ "'"+ else "\"" ++ indented 3) ++ "\"" where - indented str n = head (lines str) ++- mconcat ((("\n" ++ replicate n ' ') ++) <$> tail (lines str))+ indented n = head (lines str) +++ mconcat ((("\n" ++ replicate n ' ') ++) <$> tail (lines str)) forbiddenChar = ['#', '&', '*', ',', '?', '-', ':', '[', ']', '{', '}'] ++ ['>', '|', ':', '!']
src/Utils/DateTime.hs view
@@ -1,3 +1,5 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+ module Utils.DateTime where import Data.Time (ZonedTime(..), LocalTime(..))
src/Utils/Map.hs view
@@ -3,6 +3,6 @@ import Data.Map (Map, keys, elems) -showMap :: Show a => String -> (String -> String) -> (a -> String) -> Map String a -> [String]+showMap :: String -> (String -> String) -> (a -> String) -> Map String a -> [String] showMap sep showKey showValue mapping = (\(k, v) -> showKey k ++ sep ++ showValue v) <$> tuples where tuples = zip (keys mapping) (elems mapping)
src/Utils/String.hs view
@@ -1,5 +1,3 @@-{-# LANGUAGE FlexibleInstances, UndecidableInstances, IncoherentInstances #-}- module Utils.String where import Data.List (intercalate) @@ -7,9 +5,6 @@ class ToString a where toString :: a -> String -instance ToString String where- toString = id- instance ToString Char where toString = pure @@ -31,5 +26,5 @@ indent :: Int -> String -> String-indent n str = intercalate "\n" $ indentLine n <$> lines str where- indentLine n = (concat (replicate n " ") ++)+indent n str = intercalate "\n" $ indentLine <$> lines str where+ indentLine = (concat (replicate n " ") ++)