packages feed

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 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 " ") ++)