bookhound 0.1.9.0 → 0.1.10.0

raw patch · 49 files changed

+1740/−1652 lines, 49 filesdep +textPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: text

API changes (from Hackage documentation)

Files

• bookhound.cabal +27/−26
• src/Bookhound/Internal/Applicative.hs +5/−0
• src/Bookhound/Internal/DateTime.hs +19/−0
• src/Bookhound/Internal/Foldable.hs +22/−0
• src/Bookhound/Internal/Map.hs +8/−0
• src/Bookhound/Internal/String.hs +36/−0
• src/Bookhound/Operations/Finder.hs +85/−0
• src/Bookhound/Operations/ToJson.hs +97/−0
• src/Bookhound/Operations/ToXml.hs +42/−0
• src/Bookhound/Operations/ToYaml.hs +32/−0
• src/Bookhound/Parser.hs +168/−0
• src/Bookhound/ParserCombinators.hs +153/−0
• src/Bookhound/Parsers/Char.hs +104/−0
• src/Bookhound/Parsers/Collections.hs +32/−0
• src/Bookhound/Parsers/DateTime.hs +74/−0
• src/Bookhound/Parsers/Json.hs +58/−0
• src/Bookhound/Parsers/Number.hs +50/−0
• src/Bookhound/Parsers/String.hs +99/−0
• src/Bookhound/Parsers/Toml.hs +138/−0
• src/Bookhound/Parsers/Xml.hs +66/−0
• src/Bookhound/Parsers/Yaml.hs +213/−0
• src/Bookhound/SyntaxTrees/Json.hs +28/−0
• src/Bookhound/SyntaxTrees/Toml.hs +57/−0
• src/Bookhound/SyntaxTrees/Xml.hs +58/−0
• src/Bookhound/SyntaxTrees/Yaml.hs +69/−0
• src/Operations/Finder.hs +0/−84
• src/Operations/ToJson.hs +0/−95
• src/Operations/ToXml.hs +0/−42
• src/Operations/ToYaml.hs +0/−29
• src/Parser.hs +0/−159
• src/ParserCombinators.hs +0/−148
• src/Parsers/Char.hs +0/−104
• src/Parsers/Collections.hs +0/−27
• src/Parsers/DateTime.hs +0/−69
• src/Parsers/Json.hs +0/−53
• src/Parsers/Number.hs +0/−43
• src/Parsers/String.hs +0/−98
• src/Parsers/Toml.hs +0/−127
• src/Parsers/Xml.hs +0/−57
• src/Parsers/Yaml.hs +0/−196
• src/SyntaxTrees/Json.hs +0/−28
• src/SyntaxTrees/Toml.hs +0/−57
• src/SyntaxTrees/Xml.hs +0/−58
• src/SyntaxTrees/Yaml.hs +0/−69
• src/Utils/Applicative.hs +0/−5
• src/Utils/DateTime.hs +0/−18
• src/Utils/Foldable.hs +0/−22
• src/Utils/Map.hs +0/−8
• src/Utils/String.hs +0/−30

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           bookhound-version:        0.1.9.0+version:        0.1.10.0 synopsis:       Simple Parser Combinators & Parsers description:    Please see the README on GitHub at <https://github.com/albertprz/bookhound#readme> category:       Parsers@@ -26,30 +26,30 @@  library   exposed-modules:-      Operations.Finder-      Operations.ToJson-      Operations.ToXml-      Operations.ToYaml-      Parser-      ParserCombinators-      Parsers.Char-      Parsers.Collections-      Parsers.DateTime-      Parsers.Json-      Parsers.Number-      Parsers.String-      Parsers.Toml-      Parsers.Xml-      Parsers.Yaml-      SyntaxTrees.Json-      SyntaxTrees.Toml-      SyntaxTrees.Xml-      SyntaxTrees.Yaml-      Utils.Applicative-      Utils.DateTime-      Utils.Foldable-      Utils.Map-      Utils.String+      Bookhound.Internal.Applicative+      Bookhound.Internal.DateTime+      Bookhound.Internal.Foldable+      Bookhound.Internal.Map+      Bookhound.Internal.String+      Bookhound.Operations.Finder+      Bookhound.Operations.ToJson+      Bookhound.Operations.ToXml+      Bookhound.Operations.ToYaml+      Bookhound.Parser+      Bookhound.ParserCombinators+      Bookhound.Parsers.Char+      Bookhound.Parsers.Collections+      Bookhound.Parsers.DateTime+      Bookhound.Parsers.Json+      Bookhound.Parsers.Number+      Bookhound.Parsers.String+      Bookhound.Parsers.Toml+      Bookhound.Parsers.Xml+      Bookhound.Parsers.Yaml+      Bookhound.SyntaxTrees.Json+      Bookhound.SyntaxTrees.Toml+      Bookhound.SyntaxTrees.Xml+      Bookhound.SyntaxTrees.Yaml   other-modules:       Paths_bookhound   hs-source-dirs:@@ -85,9 +85,10 @@       DeriveTraversable       DeriveGeneric       GeneralizedNewtypeDeriving-  ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints+  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wpartial-fields -Wincomplete-uni-patterns -Wredundant-constraints   build-depends:       base >=4.7 && <5     , containers >=0.6 && <1+    , text >=2.0 && <3     , time >=1.9 && <2   default-language: Haskell2010

@@ -0,0 +1,5 @@+module Bookhound.Internal.Applicative where+++extract :: Applicative m => m a1 -> m a2 -> m b -> m b+extract start end inner = start *> inner <* end

@@ -0,0 +1,19 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Bookhound.Internal.DateTime where++import Data.Time (LocalTime (..), ZonedTime (..))+++instance Eq ZonedTime where+  (==) x y = (zonedTimeToLocalTime x == zonedTimeToLocalTime y) &&+             (zonedTimeZone x == zonedTimeZone y)++instance Ord ZonedTime where+  compare x y = compare (zonedTimeToLocalTime x) (zonedTimeToLocalTime y)+++showDateTime :: ZonedTime -> String+showDateTime (ZonedTime (LocalTime date time) offset) =+  show date <> "T" <> show time+  <> take 3 (show offset) <> ":" <> drop 3 (show offset)

@@ -0,0 +1,22 @@+module Bookhound.Internal.Foldable where++import Bookhound.Internal.String (indent)+import Data.Foldable             as Foldable (Foldable (toList))+import Data.List                 (intercalate)+++hasNone :: Foldable m => m a -> Bool+hasNone = null++hasSome :: Foldable m => m a -> Bool+hasSome = not . hasNone++hasMany :: Foldable m => m a -> Bool+hasMany xs = all hasSome $ [id, tail] <*> [Foldable.toList xs]+++stringify :: (Foldable m) => String -> String -> String -> Int -> m String -> String+stringify sep start end n xs = start <> indent n str <> end+  where+    str = intercalate sep list+    list = toList xs

@@ -0,0 +1,8 @@+module Bookhound.Internal.Map where++import Data.Map (Map, elems, keys)+++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)

@@ -0,0 +1,36 @@+module Bookhound.Internal.String where++import Data.List (intercalate)+import Data.Text (Text, unpack)+++class ToString a where+  toString :: a -> String++instance ToString Char where+  toString = pure++instance ToString Int where+  toString = show++instance ToString Text where+  toString = unpack++instance ToString Integer where+  toString = show++instance ToString Float where+  toString = show++instance ToString Double where+  toString = show++instance (ToString a, Foldable m) => ToString (m a) where+  toString = concatMap toString++++indent :: Int -> String -> String+indent n str = intercalate "\n" $ indentLine <$> lines str+  where+    indentLine = (concat (replicate n " ") <>)

@@ -0,0 +1,85 @@+module Bookhound.Operations.Finder (Finder(..)) where+++import Bookhound.Parser            (runParser)+import Bookhound.ParserCombinators (IsMatch (..), (<|>), (|*))+import Bookhound.Parsers.Char      (dot)+import Bookhound.Parsers.Number    (unsignedInt)+import Bookhound.Parsers.String    (withinSquareBrackets)+import Bookhound.SyntaxTrees.Json  (JsExpression (..))+import Bookhound.SyntaxTrees.Toml  (TomlExpression (..))+import Bookhound.SyntaxTrees.Yaml  (YamlExpression (..))+++import Data.Either (fromRight)+import Data.Maybe  (listToMaybe)++import qualified Data.Map  as Map+import           Data.Text (pack)++++class Finder a where++  toList :: a -> [(String, a)]+  findAll :: ((String, a) -> Bool) -> a -> [a]+  find :: ((String, a) -> Bool) -> a -> Maybe a+  findByKeys :: [String] -> a -> Maybe a+  findByPath :: String -> a -> Maybe a+++  findAll f = fmap snd . filter f . toList+  find f = listToMaybe . findAll f++  findByKeys []       expr = Just expr+  findByKeys (x : xs) expr = findByKey x expr >>= findByKeys xs  where++    findByKey key = find (\(str, _) -> str == key)++  findByPath path = findByKeys pathSeq where++    pathSeq = fromRight [] $ runParser parsePath $ pack path+    parsePath = is '$' *> ((index <|> key) |*)++    index = show <$> withinSquareBrackets unsignedInt+    key   = dot *> word+    word  = (noneOf ['.', '['] |*)++++instance Finder JsExpression where+  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 = \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 = \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

@@ -0,0 +1,97 @@+module Bookhound.Operations.ToJson (ToJson(..)) where++import Bookhound.Parser            (runParser)+import Bookhound.ParserCombinators (IsMatch (..), maybeWithin, (<|>), (|*))+import Bookhound.Parsers.Json      (json)+import Bookhound.Parsers.String    (spacing)+import Bookhound.SyntaxTrees.Json  (JsExpression (..))+import Bookhound.SyntaxTrees.Toml  (TomlExpression (..))+import Bookhound.SyntaxTrees.Xml   (XmlExpression (..))+import Bookhound.SyntaxTrees.Yaml  (YamlExpression (..))++import Data.Either (fromRight)+import Data.Text   (pack)++import           Data.Map (Map, elems)+import qualified Data.Map as Map+++class ToJson a where+  toJson :: a -> JsExpression+++instance {-# OVERLAPPABLE #-} ToJson JsExpression where+  toJson = id++instance ToJson XmlExpression where++  toJson XmlExpression { tagName = tag, expressions = exprs, .. }+    | tag == "literal"  = fromRight JsNull . runParser literalParser .+                              pack . head . elems $ fields+    | tag == "array"    = JsArray $ childExprToJson <$> exprs+    | tag == "object"   = JsObject . Map.fromList $ (\x -> (tagName x, childExprToJson x)) <$>+                                        exprs+    | otherwise          = JsNull   where++        literalParser = json <|> (JsString <$> maybeWithin spacing (isNot '<' |*))++        childExprToJson = toJson . head . (expressions)+++instance ToJson YamlExpression where++  toJson = \case+    YamlNull              -> JsNull+    YamlInteger n         -> JsNumber $ fromIntegral n+    YamlFloat n           -> JsNumber n+    YamlBool bool         -> JsBool bool+    YamlString str        -> JsString str+    YamlDate date         -> JsString $ show date+    YamlTime time         -> JsString $ show time+    YamlDateTime dateTime -> JsString $ show dateTime+    YamlList _ list       -> JsArray $ toJson <$> list+    YamlMap  _ mapping    -> JsObject $ toJson <$> mapping+++instance ToJson TomlExpression where++  toJson = \case+    TomlNull              -> JsNull+    TomlInteger n         -> JsNumber $ fromIntegral n+    TomlFloat n           -> JsNumber n+    TomlBool bool         -> JsBool bool+    TomlString str        -> JsString str+    TomlDate date         -> JsString $ show date+    TomlTime time         -> JsString $ show time+    TomlDateTime dateTime -> JsString $ show dateTime+    TomlArray list        -> JsArray $ toJson <$> list+    TomlTable _ mapping   -> JsObject $ toJson <$> mapping++++instance ToJson String where+  toJson = JsString++instance ToJson Char where+  toJson = JsString . pure++instance ToJson Int where+  toJson = JsNumber . fromIntegral++instance ToJson Integer where+  toJson = JsNumber . fromIntegral++instance ToJson Double where+  toJson = JsNumber++instance ToJson Bool where+  toJson = JsBool++instance ToJson a => ToJson [a] where+  toJson = JsArray . fmap toJson++instance ToJson a => ToJson (Map String a) where+  toJson = JsObject . fmap toJson++instance ToJson a => ToJson (Maybe a) where+  toJson = maybe JsNull toJson

@@ -0,0 +1,42 @@+{-# LANGUAGE UndecidableInstances #-}++module Bookhound.Operations.ToXml (ToXml(..)) where++import Bookhound.Operations.ToJson (ToJson (..))+import Bookhound.SyntaxTrees.Json  (JsExpression (..))+import Bookhound.SyntaxTrees.Xml   (XmlExpression (..), literalExpression)++import           Data.Char (toLower)+import qualified Data.Map  as Map+++class ToXml a where+  toXml :: a -> XmlExpression+++instance {-# OVERLAPPABLE #-} ToJson a => ToXml a where+  toXml = toXml . toJson++instance ToXml XmlExpression where+  toXml = id+++instance ToXml JsExpression where++  toXml = \case+    JsNull       -> literalExpression "null"+    JsNumber n   -> literalExpression $ show n+    JsBool bool  -> literalExpression $ toLower <$> show bool+    JsString str -> literalExpression str++    JsArray arr  -> XmlExpression "array" Map.empty (elemExpr <$> arr) where++      elemExpr element = XmlExpression { tagName = "elem",+                                       fields = Map.empty,+                                       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] }

@@ -0,0 +1,32 @@+{-# LANGUAGE UndecidableInstances #-}++module Bookhound.Operations.ToYaml (ToYaml(..)) where++import Bookhound.Operations.ToJson (ToJson (..))+import Bookhound.Parser            (runParser)+import Bookhound.Parsers.Number    (intLike)+import Bookhound.SyntaxTrees.Json  (JsExpression (..))+import Bookhound.SyntaxTrees.Yaml  (CollectionType (..), YamlExpression (..))+import Data.Text                   (pack)++++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 = \case+    JsNull       -> YamlNull+    JsNumber n   -> either (const (YamlFloat n)) YamlInteger $+      runParser intLike $ pack $ show n+    JsBool bool  -> YamlBool bool+    JsString str -> YamlString str+    JsArray arr  -> YamlList Standard $ toYaml <$> arr+    JsObject obj -> YamlMap  Standard $ toYaml <$> obj

@@ -0,0 +1,168 @@+module Bookhound.Parser (Parser, ParseResult, ParseError(..), runParser, errorParser,+               andThen, exactly, isMatch, check, except, anyOf, allOf, char,+               withTransform, withError) where++import Control.Applicative (liftA2)+import Control.Monad       (join)+import Data.Either         (fromRight)+import Data.List           (find)+import Data.Maybe          (isJust)+import Data.Text           (Text, pack, uncons, unpack)++type Input = Text++data Parser a+  = P+      { parse     :: Input -> ParseResult a+      , transform :: forall b. Maybe (Parser b -> Parser b)+      }++data ParseResult a+  = Result Input a+  | Error ParseError+  deriving (Eq)++data ParseError+  = UnexpectedEof+  | ExpectedEof Input+  | UnexpectedChar Char+  | UnexpectedString String+  | NoMatch String+  deriving (Eq, Show)+++instance Show a => Show (ParseResult a) where+  show (Result i a)                 = "Pending: " <> " >" <> unpack i <> "< " <>+                                      "\n\nResult: \n" <> show a+  show (Error UnexpectedEof)        = "Unexpected end of stream"+  show (Error (ExpectedEof i))      = "Expected end of stream, but got >"+                                       <> unpack i <> "<"+  show (Error (UnexpectedChar c))   = "Unexpected char: "   <> "[" <> show c <> "]"+  show (Error (UnexpectedString s)) = "Unexpected string: " <> "[" <> show s <> "]"+  show (Error (NoMatch s))          = "Did not match condition: " <> s+++instance Functor ParseResult where+  fmap f (Result i a) = Result i (f a)+  fmap _ (Error pe)   = Error pe+++instance Functor Parser where+  fmap f (P p t) = applyTransform t $ mkParser (fmap f . p)++instance Applicative Parser where+  pure a      = mkParser (`Result` a)+  (liftA2) f (P p t) mb@(P _ t') =+    applyTransform (findJust t t') combinedParser+    where+      combinedParser = mkParser (+        \x -> case p x of+        Result i a -> parse ((f a) <$> mb) i+        Error pe   -> Error pe)++instance Monad Parser where+  (>>=) (P p t) f = applyTransform t combinedParser+    where+      combinedParser = mkParser (+        \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 (exactly p) i where++  toEither = \case+    Error pe   -> Left pe+    Result _ a -> Right a++errorParser :: ParseError -> Parser a+errorParser = mkParser . const . Error+++char :: Parser Char+char = mkParser $+   maybe (Error UnexpectedEof) (\(ch, rest) -> Result rest ch) . uncons+++andThen :: Parser String -> Parser a -> Parser a+andThen p1 p2@(P _ t) = applyTransform t $+  P (\i -> parse p2 $ fromRight i $ pack <$> runParser p1 i) t+++exactly :: Parser a -> Parser a+exactly (P p t) = applyTransform t $ mkParser (+  \x -> case p x of+    result@(Result i _) | i == mempty -> result+    Result i _                        -> Error $ ExpectedEof i+    err@(Error _)                     -> err)++anyOf :: [Parser a] -> Parser a+anyOf ps = anyOfHelper ps Nothing++allOf :: [Parser a] -> Parser a+allOf ps = allOfHelper ps Nothing+++anyOfHelper :: [Parser a] -> (forall b. Maybe (Parser b -> Parser b)) -> Parser a+anyOfHelper [] _  = errorParser $ NoMatch "anyOf"+anyOfHelper [p] _ = p+anyOfHelper ((P p t) : rest) t' = applyTransform (findJust t t') $+  mkParser (+   \x -> case p x of+    result@(Result _ _) -> result+    Error _             -> parse (anyOfHelper rest t) x)++++allOfHelper :: [Parser a] -> (forall b. Maybe (Parser b -> Parser b)) -> Parser a+allOfHelper [] _ = errorParser $ NoMatch "allOf"+allOfHelper [p] _ = p+allOfHelper ((P p t) : rest) t' = applyTransform (findJust t t') $+  mkParser (+   \x -> case p x of+    Result _ _    -> parse (allOfHelper rest t) x+    err@(Error _) -> err)++++isMatch :: (Char -> Char -> Bool) -> Parser Char -> Char -> Parser Char+isMatch cond parser c1 =+  do c2 <- parser+     if cond c1 c2+       then pure c2+       else errorParser $ UnexpectedChar c2++check :: String -> (a -> Bool) -> Parser a -> Parser a+check condName cond parser =+  do c2 <- parser+     if cond c2+       then pure c2+       else  errorParser $ NoMatch condName+++except :: Show a => Parser a -> Parser a -> Parser a+except (P p t) (P p' _) = applyTransform t $ mkParser (+  \x -> case p' x of+    Result _ a -> Error $ UnexpectedString (show a)+    Error _    -> p x)++withError :: String -> Parser a -> Parser a+withError str parser@(P p _) = parser { parse =+  \i -> case p i of+    r@(Result _ _) -> r+    Error _        -> Error $ NoMatch str+  }++withTransform :: (forall b. Parser b -> Parser b) -> Parser a -> Parser a+withTransform f = applyTransform $ Just f+++applyTransform :: (forall a. Maybe (Parser a -> Parser a)) -> Parser b -> Parser b+applyTransform f p =  maybe p (\f' -> (f' p){transform = f} ) f++mkParser :: (Input -> ParseResult a) -> Parser a+mkParser p = P {parse = p, transform = Nothing}++findJust :: forall a. Maybe a -> Maybe a -> Maybe a+findJust ma mb = join $ find isJust ([ma, mb] :: [Maybe a])

@@ -0,0 +1,153 @@+{-# LANGUAGE UndecidableInstances #-}++module Bookhound.ParserCombinators (IsMatch(..), satisfies, contains, notContains,+                          containsAnyOf, containsNoneOf,+                          times, maybeTimes, anyTimes, someTimes, manyTimes,+                          within, maybeWithin, withinBoth, maybeWithinBoth,+                          anySepBy, someSepBy, manySepBy, sepByOp,+                          (<|>), (<?>), (<#>), (>>>), (|?), (|*), (|+), (|++))  where++import Bookhound.Internal.Applicative (extract)+import Bookhound.Internal.Foldable    (hasMany, hasSome)+import Bookhound.Internal.String      (ToString (..))+import Bookhound.Parser               (Parser, allOf, anyOf, char, check,+                                       except, isMatch, withError)++import Data.List  (isInfixOf)+import Data.Maybe (listToMaybe)++import           Data.Bifunctor (Bifunctor (first))+import qualified Data.Foldable  as Foldable+++class IsMatch a where+  is      :: a -> Parser a+  isNot   :: a -> Parser a+  inverse :: Parser a -> Parser a+  oneOf   :: [a] -> Parser a+  noneOf  :: [a] -> Parser a++  oneOf xs  = anyOf $ is <$> xs+  noneOf xs = allOf $ isNot <$> xs+++instance   IsMatch Char where+  is      = isMatch (==) char+  isNot   = isMatch (/=) char+  inverse = except char++instance   IsMatch String where+  is      = traverse (isMatch (==) char)+  isNot   = traverse (isMatch (/=) char)+  inverse = except (char |*)++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 :: (a -> Bool) -> Parser a -> Parser a+satisfies cond p = check "satisfies" cond p++contains :: Eq a => [a] -> Parser [a] -> Parser [a]+contains val p = check "contains" (isInfixOf val) p++notContains :: Eq a => [a] -> Parser [a] -> Parser [a]+notContains val p = check "notContains" (isInfixOf val) p++containsAnyOf :: (Foldable t, Eq a) => t [a] -> Parser [a] -> Parser [a]+containsAnyOf x y = foldr contains y x++containsNoneOf :: (Foldable t, Eq a) => t [a] -> Parser [a] -> Parser [a]+containsNoneOf x y = foldr notContains y x+++ -- Frequency combinators+times :: Integer -> Parser a  -> Parser [a]+times n p = sequence $ p <$ [1 .. n]+++maybeTimes :: Parser a -> Parser (Maybe a)+maybeTimes = (listToMaybe <$>) . check "maybeTimes" (not . hasMany) . anyTimes++anyTimes :: Parser a -> Parser [a]+anyTimes parser = (parser >>= \x -> (x :) <$> anyTimes parser) <|> pure []++someTimes :: Parser a -> Parser [a]+someTimes = check "someTimes" hasSome . anyTimes++manyTimes :: Parser a -> Parser [a]+manyTimes = check "manyTimes" hasMany . anyTimes+++-- Within combinators+within :: Parser a -> Parser b -> Parser b+within p = extract p p++maybeWithin :: Parser a -> Parser b -> Parser b+maybeWithin p = within (p |?)++withinBoth :: Parser a -> Parser b -> Parser c -> Parser c+withinBoth = extract++maybeWithinBoth :: Parser a -> Parser b -> Parser c -> Parser c+maybeWithinBoth p1 p2 = extract (p1 |?) (p2 |?)+++-- Separated by combinators+sepBy :: (Parser b -> Parser (Maybe b)) -> (Parser b -> Parser [b])+                -> Parser a -> Parser b -> Parser [b]+sepBy freq1 freq2 sep p = (<>) <$> (Foldable.toList <$> freq1 p)+                               <*> freq2 (sep *> p)++anySepBy :: Parser a -> Parser b -> Parser [b]+anySepBy = sepBy (|?) (|*)++someSepBy :: Parser a -> Parser b -> Parser [b]+someSepBy = sepBy (fmap Just) (|*)++manySepBy :: Parser a -> Parser b -> Parser [b]+manySepBy = sepBy (fmap Just) (|+)++sepByOps :: Parser a -> Parser b -> Parser ([a], [b])+sepByOps sep p = do x <-  p+                    y <- (((,) <$> sep <*> p) |+)+                    pure $ (fst <$> y, x : (snd <$> y))++sepByOp :: Parser a -> Parser b -> Parser (a, [b])+sepByOp sep p = first head <$> sepByOps sep p+++-- Parser Binary Operators+infixl 3 <|>+(<|>) :: Parser a -> Parser a -> Parser a+(<|>) p1 p2 = anyOf [p1, p2]++infixl 6 <?>+(<?>) :: Parser a -> String -> Parser a+(<?>) = flip withError++infixl 6 <#>+(<#>) :: Parser a -> Integer -> Parser [a]+(<#>) = flip times++infixl 6 >>>+(>>>) :: (ToString a, ToString b) => Parser a -> Parser b -> Parser String+(>>>) p1 p2 = (<>) <$> (toString <$> p1)+                   <*> (toString <$> p2)+++-- Parser Unary Operators+(|?) :: Parser a -> Parser (Maybe a)+(|?) = maybeTimes++(|*) :: Parser a -> Parser [a]+(|*) = anyTimes++(|+) :: Parser a -> Parser [a]+(|+) = someTimes++(|++) :: Parser a -> Parser [a]+(|++) = manyTimes

@@ -0,0 +1,104 @@+module Bookhound.Parsers.Char where++import Bookhound.ParserCombinators (IsMatch (..), (<|>))++import           Bookhound.Parser (Parser)+import qualified Bookhound.Parser as Parser+++char :: Parser Char+char = Parser.char++digit :: Parser Char+digit = oneOf ['0' .. '9']++upper :: Parser Char+upper = oneOf ['A' .. 'Z']++lower :: Parser Char+lower = oneOf ['a' .. 'z']++letter :: Parser Char+letter = upper <|> lower++alpha :: Parser Char+alpha = letter++alphaNum :: Parser Char+alphaNum = alpha <|> digit++++space :: Parser Char+space = is ' '++tab :: Parser Char+tab = is '\t'++spaceOrTab :: Parser Char+spaceOrTab = space <|> tab++whiteSpace :: Parser Char+whiteSpace = space <|> tab <|> newLine++newLine :: Parser Char+newLine = is '\n'++comma :: Parser Char+comma = is ','++dot :: Parser Char+dot = is '.'++colon :: Parser Char+colon = is ':'++quote :: Parser Char+quote = is '\''++doubleQuote :: Parser Char+doubleQuote = is '"'++dash :: Parser Char+dash = is '-'++plus :: Parser Char+plus = is '+'++equal :: Parser Char+equal = is '='++underscore :: Parser Char+underscore = is '_'++hashTag :: Parser Char+hashTag = is '#'++question :: Parser Char+question = is '?'++++openParens :: Parser Char+openParens = is '('++closeParens :: Parser Char+closeParens = is ')'++openSquare :: Parser Char+openSquare = is '['++closeSquare :: Parser Char+closeSquare = is ']'++openCurly :: Parser Char+openCurly = is '{'++closeCurly :: Parser Char+closeCurly = is '}'++openAngle :: Parser Char+openAngle = is '<'++closeAngle :: Parser Char+closeAngle = is '>'

@@ -0,0 +1,32 @@+module Bookhound.Parsers.Collections (collOf, listOf, tupleOf, mapOf) where++import Bookhound.Parser            (Parser, withError)+import Bookhound.ParserCombinators (anySepBy, maybeWithin, satisfies)+import Bookhound.Parsers.Char      (closeCurly, closeParens, closeSquare, comma,+                                    openCurly, openParens, openSquare)+import Bookhound.Parsers.String    (spacing)++import           Data.Map (Map)+import qualified Data.Map as Map+++collOf :: Parser a -> Parser b -> Parser c -> Parser d -> Parser [d]+collOf start end sep elemParser = withError "Collection"+  $ start *> elemsParser <* end+  where+    elemsParser = anySepBy sep $ maybeWithin spacing elemParser++listOf :: Parser a -> Parser [a]+listOf = withError "List"+  . collOf openSquare closeSquare comma++tupleOf :: Parser a -> Parser [a]+tupleOf = withError "Tuple"+  . satisfies ((>= 2) . length)+  . collOf openParens closeParens comma++mapOf :: Ord b => Parser a -> Parser b -> Parser c -> Parser (Map b c)+mapOf sep p1 p2 = withError "Map"+  $ Map.fromList <$> collOf openCurly closeCurly comma mapEntry+  where+    mapEntry = (,) <$> p1 <* maybeWithin spacing sep <*> p2

@@ -0,0 +1,74 @@+module Bookhound.Parsers.DateTime (date, time, timeZoneOffset, localDateTime, offsetDateTime, dateTime, year, day, month, hour, minute, second) where++import Bookhound.Parser            (Parser, check, withError)+import Bookhound.ParserCombinators (IsMatch (..), within, (<#>), (<|>), (|+),+                                    (|?))+import Bookhound.Parsers.Char      (colon, dash, digit, plus)++import Data.Maybe (fromMaybe)+import Data.Time  (Day, LocalTime (..), TimeOfDay (..), TimeZone,+                   ZonedTime (..), fromGregorian, minutesToTimeZone)+++date :: Parser Day+date = withError "Date"+  $ fromGregorian <$> year <*> within dash month <*> day+++time :: Parser TimeOfDay+time = withError "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 = withError "Timezone Offset"+  $ 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 = withError "Local DateTime"+  $ LocalTime <$> (date <* oneOf ['T', 't']) <*> time++offsetDateTime :: Parser ZonedTime+offsetDateTime = withError "Offset DateTime"+  $ ZonedTime <$> localDateTime <*> timeZoneOffset++dateTime :: Parser ZonedTime+dateTime = withError "DateTime"+  $ ((`ZonedTime` minutesToTimeZone 0) <$> localDateTime <* is 'Z') <|>+            offsetDateTime++++year :: Parser Integer+year = read <$> digit <#> 4++day :: Parser Int+day = check "Day" (range 1 31) $ read <$> digit <#> 2++month :: Parser Int+month = check "Month" (range 1 12) $ read <$> digit <#> 2++hour :: Parser Int+hour = check "Hour" (range 0 23) $ read <$> digit <#> 2++minute :: Parser Int+minute = check "Minute" (range 0 59) $ read <$> digit <#> 2++second :: Parser Int+second = check "Second" (range 0 59) $ read <$> digit <#> 2++secondDecimals :: Parser Integer+secondDecimals = read <$> check "Pico Seconds" ((<= 12) . length) (digit |+)+++++range :: Ord a => a -> a -> a -> Bool+range mn mx x = x >= mn && x <= mx

@@ -0,0 +1,58 @@+module Bookhound.Parsers.Json (json, nil, number, bool, string, array, object) where++import Bookhound.Parser              (Parser, withError)+import Bookhound.ParserCombinators   (IsMatch (..), maybeWithin, (<|>), (|*))+import Bookhound.Parsers.Char        (colon, doubleQuote)+import Bookhound.Parsers.Collections (listOf, mapOf)+import Bookhound.Parsers.Number      (double)+import Bookhound.Parsers.String      (spacing, withinDoubleQuotes)+import Bookhound.SyntaxTrees.Json    (JsExpression (..))+++json :: Parser JsExpression+json = maybeWithin spacing jsValue+  where+    jsValue = element <|> container+++nil :: Parser JsExpression+nil = withError "Json Null"+  $ JsNull <$ is "null"++number :: Parser JsExpression+number = withError "Json Number"+  $ JsNumber <$> double+++bool :: Parser JsExpression+bool = withError "Json Bool"+  $ JsBool <$> (True  <$ is "true" <|>+                False <$ is "false")+++string :: Parser JsExpression+string = withError "Json String"+  $ JsString <$> text+++array :: Parser JsExpression+array = withError "Json Array"+  $ JsArray <$> listOf json+++object :: Parser JsExpression+object = withError "Json Object"+  $ JsObject <$> mapOf colon text json++++element :: Parser JsExpression+element = number <|> bool <|> nil <|> string++container :: Parser JsExpression+container = array <|> object++++text :: Parser String+text = withinDoubleQuotes (inverse doubleQuote |*)

@@ -0,0 +1,50 @@+module Bookhound.Parsers.Number (int, double, posInt, negInt, unsignedInt, hexInt, octInt, intLike) where++import Bookhound.Parser            (ParseError (..), Parser, errorParser,+                                    withError)+import Bookhound.ParserCombinators (IsMatch (..), (<|>), (>>>), (|+), (|?))+import Bookhound.Parsers.Char      (dash, digit, dot, plus)+++hexInt :: Parser Integer+hexInt = withError "Hex Int"+ $ read <$> (is "0x" >>> ((digit <|> oneOf ['A' .. 'F'] <|> oneOf ['a' .. 'f']) |+))++octInt :: Parser Integer+octInt = withError "Oct Int"+  $ read <$> (is "0o" >>> (oneOf ['0' .. '7'] |+))++unsignedInt :: Parser Integer+unsignedInt = withError "Unsigned Int"+  $ read <$> (digit |+)++posInt :: Parser Integer+posInt = withError "Positive Int"+  $ read <$> (plus |?) >>> (digit |+)++negInt :: Parser Integer+negInt = withError "Negative Int"+  $ read <$> dash >>> (digit |+)++int :: Parser Integer+int = withError "Int" $ negInt <|> posInt++intLike :: Parser Integer+intLike = parser <|> int+  where+    parser = do n1      <- show <$> int+                n2      <- show <$> (dot *> unsignedInt)+                expNum  <- oneOf ['e', 'E'] *> int++                if length n1 + length n2 <= fromInteger expNum then+                  pure . read $ n1 <> "." <> n2 <> "E" <> show expNum+                else+                  errorParser $ NoMatch "Int Like"+++double :: Parser Double+double = withError "Double"+  $ read <$> int >>> (decimals |?) >>> (expn |?) where++  decimals = dot >>> unsignedInt+  expn      = oneOf ['e', 'E'] >>> int

@@ -0,0 +1,99 @@+module Bookhound.Parsers.String where++import Bookhound.Parser            (Parser)+import Bookhound.ParserCombinators (IsMatch (..), maybeWithin, maybeWithinBoth,+                                    within, withinBoth, (>>>), (|*), (|+), (|?))+import Bookhound.Parsers.Char      (alpha, alphaNum, char, closeAngle,+                                    closeCurly, closeParens, closeSquare, digit,+                                    doubleQuote, letter, lower, newLine,+                                    openAngle, openCurly, openParens,+                                    openSquare, quote, space, spaceOrTab, tab,+                                    upper, whiteSpace)+++string :: Parser String+string = (char |*)++word :: Parser String+word = (inverse whiteSpace |+)++digits :: Parser String+digits = (digit |+)++uppers :: Parser String+uppers = (upper |+)++lowers :: Parser String+lowers = (lower |+)++letters :: Parser String+letters = (letter |+)++alphas :: Parser String+alphas = (alpha |+)++alphaNums :: Parser String+alphaNums = (alphaNum |+)++++spaces :: Parser String+spaces = (space |+)++tabs :: Parser String+tabs = (tab |+)++newLines :: Parser String+newLines = (newLine |+)++spacesOrTabs :: Parser String+spacesOrTabs = (spaceOrTab |+)++spacing :: Parser String+spacing = (whiteSpace |+)++blankLine :: Parser String+blankLine = (spacesOrTabs |?) >>> newLine++blankLines :: Parser String+blankLines = mconcat <$> (blankLine |+)++++withinQuotes :: Parser b -> Parser b+withinQuotes = within quote++withinDoubleQuotes :: Parser b -> Parser b+withinDoubleQuotes = within doubleQuote++withinParens :: Parser b -> Parser b+withinParens = withinBoth openParens closeParens++withinSquareBrackets :: Parser b -> Parser b+withinSquareBrackets = withinBoth openSquare closeSquare++withinCurlyBrackets :: Parser b -> Parser b+withinCurlyBrackets = withinBoth openCurly closeCurly++withinAngleBrackets :: Parser b -> Parser b+withinAngleBrackets = withinBoth openAngle closeAngle++++maybeWithinQuotes :: Parser b -> Parser b+maybeWithinQuotes = maybeWithin quote++maybeWithinDoubleQuotes :: Parser b -> Parser b+maybeWithinDoubleQuotes = maybeWithin doubleQuote++maybeWithinParens :: Parser b -> Parser b+maybeWithinParens = maybeWithinBoth openParens closeParens++maybeWithinSquareBrackets :: Parser b -> Parser b+maybeWithinSquareBrackets = maybeWithinBoth openSquare closeSquare++maybeWithinCurlyBrackets :: Parser b -> Parser b+maybeWithinCurlyBrackets = maybeWithinBoth openCurly closeCurly++maybeWithinAngleBrackets :: Parser b -> Parser b+maybeWithinAngleBrackets = maybeWithinBoth openAngle closeAngle

@@ -0,0 +1,138 @@+module Bookhound.Parsers.Toml (toml, nil, integer, float, bool, string,+                     array, inlineTable) where++import Bookhound.Parser              (Parser, withError)+import Bookhound.ParserCombinators   (IsMatch (..), maybeWithin, within, (<#>),+                                      (<|>), (>>>), (|*), (|+), (|?))+import Bookhound.Parsers.Char        (dash, digit, dot, doubleQuote, equal,+                                      hashTag, letter, newLine, quote,+                                      spaceOrTab, underscore, whiteSpace)+import Bookhound.Parsers.Collections (listOf, mapOf)+import Bookhound.Parsers.Number      (double, hexInt, int, octInt)+import Bookhound.Parsers.String      (blankLine, blankLines, spacesOrTabs,+                                      spacing, withinDoubleQuotes, withinQuotes,+                                      withinSquareBrackets)+import Bookhound.SyntaxTrees.Toml    (TableType (..), TomlExpression (..))++import qualified Bookhound.Parsers.DateTime as Dt++import qualified Data.Map   as Map+import           Data.Maybe (maybeToList)++++toml :: Parser TomlExpression+toml = maybeWithin (((pure <$> whiteSpace) <|> comment) |+) topLevelTable++++-- TODO: Add support for table arrays++nil :: Parser TomlExpression+nil = withError "Toml Null"+  $ TomlNull <$ is "null"++integer :: Parser TomlExpression+integer = withError "Toml Integer"+  $ TomlInteger <$> (hexInt <|> octInt <|> int)++float :: Parser TomlExpression+float = withError "Toml Float"+  $ TomlFloat <$> double++bool :: Parser TomlExpression+bool = withError "Toml Bool"+  $ TomlBool <$> (True  <$ is "true"  <|>+                False <$ is "false")+++dateTime :: Parser TomlExpression+dateTime = withError "Toml DateTime"+  $ TomlDateTime <$> Dt.dateTime++date :: Parser TomlExpression+date = withError "Toml Date"+  $ TomlDate <$> Dt.date++time :: Parser TomlExpression+time = withError "Toml Time"+  $ TomlTime <$> Dt.time+++string :: Parser TomlExpression+string = withError "Toml String"+  $ TomlString <$> text+  where+    text = within (doubleQuote <#> 3) (multiline (inverse doubleQuote |*)) <|>+           within  (quote <#> 3)      (multiline (inverse quote |*))       <|>+           withinDoubleQuotes         (inverse doubleQuote |*)             <|>+           withinQuotes               (inverse quote       |*)++    multiline parser = mconcat <$> (((blankLine |?) *> line parser) |*)++    line parser = is "\\" *> (whiteSpace |*) *> parser+++array :: Parser TomlExpression+array = withError "Toml Array"+  $ TomlArray <$> listOf (maybeWithin spacing tomlExpr)+++key :: Parser String+key = keyParser >>> ((dot >>> keyParser) |*)+  where+    keyParser = maybeWithin spacesOrTabs $ freeText      <|>+                withinDoubleQuotes (inverse doubleQuote |*) <|>+                withinQuotes (inverse quote |*)++    freeText = ((letter <|> digit <|> underscore <|> dash) |+)+++inlineTable :: Parser TomlExpression+inlineTable = withError "Toml Table"+  $ TomlTable Inline <$> mapOf equal key tomlExpr+++topLevelTable :: Parser TomlExpression+topLevelTable = withError "Toml Table"+  $ TomlTable TopLevel . Map.fromList <$> maybeWithin spacing tables+  where+    tables = do xs <- keyValueSeqParser+                ys <- (tableParser |*)+                pure (ys <> [("", TomlTable Standard . Map.fromList $ xs)])++    tableParser = do k <- withinSquareBrackets key+                     v <- maybeWithin spacing standardTable+                     pure (k, v)++    standardTable = TomlTable Standard . Map.fromList <$> keyValueSeqParser+++    keyValueSeqParser = do xs <- ((keyValueParser <* (blankLine *> (blankLines |?))) |*)+                           x  <- (keyValueParser |?)+                           pure  (xs <> maybeToList x)++    keyValueParser = do k <- key+                        maybeWithin spacesOrTabs equal+                        v <- tomlExpr+                        pure (k, v)++++element :: Parser TomlExpression+element = dateTime <|> date <|> time <|> float <|>+          integer  <|> bool <|> nil  <|> string+++container :: Parser TomlExpression+container = array <|> inlineTable+++comment :: Parser String+comment = hashTag *> (inverse newLine |+) <* newLine+++tomlExpr :: Parser TomlExpression+tomlExpr = maybeWithin (((pure <$> spaceOrTab) <|> comment) |+) tomlValue+  where+    tomlValue = element <|> container

@@ -0,0 +1,66 @@+module Bookhound.Parsers.Xml (xml, branchExpr, leafExpr, literal) where++import Bookhound.Parser            (Parser, withError)+import Bookhound.ParserCombinators (IsMatch (..), maybeWithin, (<|>), (|*),+                                    (|+))+import Bookhound.Parsers.Char      (doubleQuote)+import Bookhound.Parsers.String    (spacing, withinAngleBrackets,+                                    withinDoubleQuotes)+import Bookhound.SyntaxTrees.Xml   (XmlExpression (..), literalExpression)++import           Data.Map (Map)+import qualified Data.Map as Map+++xml :: Parser XmlExpression+xml = maybeWithin  ((header <|> comment) |+)+    $ maybeWithin spacing $ branchExpr <|> leafExpr++++field :: Parser (String, String)+field = withError "Xml Field" $+  (,) <$> text <* is '=' <*> quotedText+  where+    quotedText = withinDoubleQuotes (inverse doubleQuote |*)+++fullTag :: Parser (String, Map String String)+fullTag = withError "Xml Tag" $+  do tag  <- text+     flds <- Map.fromList <$> ((spacing *> field) |*)+     pure (tag, flds)+++branchExpr :: Parser XmlExpression+branchExpr = withError "Xml Branch Expression" $+  do (tag, flds) <- withinAngleBrackets fullTag+     exprs       <- (xml |+) <|> literal+     maybeWithin spacing (is ("</" <> tag <> ">"))+     pure $ XmlExpression { tagName = tag, fields = flds, expressions = exprs }+++literal :: Parser [XmlExpression]+literal = withError "Xml Literal" $+  pure . literalExpression <$> maybeWithin spacing (isNot '<' |*)+++leafExpr :: Parser XmlExpression+leafExpr = withError "Xml Leaf Expression" $+  do (tag, flds) <- withinAngleBrackets (fullTag <* is '/')+     pure $ XmlExpression { tagName = tag, fields = flds, expressions = [] }+++header :: Parser String+header = maybeWithin spacing $+  is "<?" *> (isNot '?' |*) <* is "?>"+++comment :: Parser String+comment = maybeWithin spacing $+  is "<!--" *> (isNot '-' |*) <* is "-->"++++text :: Parser String+text = (noneOf ['/', '>', ' ', '='] |+)

@@ -0,0 +1,213 @@+module Bookhound.Parsers.Yaml (yaml, nil, integer, float, bool, string,+                     list, mapping) where+++import Bookhound.Parser              (Parser, andThen, check, exactly,+                                      withError)+import Bookhound.ParserCombinators   (IsMatch (..), maybeWithin, (<#>), (<|>),+                                      (>>>), (|*), (|+), (|++), (|?))+import Bookhound.Parsers.Char        (char, colon, dash, dot, doubleQuote,+                                      hashTag, newLine, question, quote, space,+                                      whiteSpace)+import Bookhound.Parsers.Collections (listOf, mapOf)+import Bookhound.Parsers.Number      (double, hexInt, int, octInt)+import Bookhound.Parsers.String      (blankLine, blankLines, spaces,+                                      spacesOrTabs, tabs, withinDoubleQuotes,+                                      withinQuotes)+import Bookhound.SyntaxTrees.Yaml    (CollectionType (..), YamlExpression (..))++import qualified Bookhound.Parsers.DateTime as Dt++import           Data.List (nub)+import qualified Data.Map  as Map++++yaml :: Parser YamlExpression+yaml =  normalize `andThen` yamlWithIndent (-1)+++++-- TODO: Add support for anchors and aliases++nil :: Parser YamlExpression+nil = withError "Yaml Null"+  $ YamlNull <$ oneOf ["null", "Null", "NULL"]++integer :: Parser YamlExpression+integer = withError "Yaml Integer"+  $ YamlInteger <$> (hexInt <|> octInt <|> int)++float :: Parser YamlExpression+float = withError "Yaml Float"+  $ YamlFloat <$> double++bool :: Parser YamlExpression+bool = withError "Yaml Bool"+  $ YamlBool <$> (True  <$ oneOf ["true", "True", "TRUE"]    <|>+                  False <$ oneOf ["false", "False", "FALSE"])+++dateTime :: Parser YamlExpression+dateTime = withError "Yaml DateTime"+  $ YamlDateTime <$> Dt.dateTime++date :: Parser YamlExpression+date = withError "Yaml Date"+  $ YamlDate <$> Dt.date++time :: Parser YamlExpression+time = withError "Yaml Time"+  $ YamlTime <$> Dt.time+++string :: Int -> Parser YamlExpression+string indent = withError "Yaml String"+  $ YamlString <$> text indent+++sequential :: Parser a -> Int -> Parser [YamlExpression]+sequential sep indent = listParser+  where++  listParser = indentationCheck elemParser indent++  elemParser = do n <- length <$> (space |*)+                  sep *> whiteSpace+                  elm <- yamlWithIndent n+                  pure (n, elm)+++list :: Int -> Parser YamlExpression+list indent = withError "Json List"+  $   (YamlList Inline   <$> jsonList)+  <|> (YamlList Standard <$> yamlList)+  where+    yamlList = sequential dash indent+    jsonList = maybeWithin spacesOrTabs $ listOf $ yamlWithIndent (-1)+++set :: Int -> Parser YamlExpression+set indent = withError "Yaml Set"+  $ YamlList Standard . nub <$> sequential question indent+++mapping :: Int -> Parser YamlExpression+mapping indent = withError "Yaml Mapping"+  $   (YamlMap Inline   <$> jsonMap)+  <|> (YamlMap Standard <$> yamlMap)+  where+    yamlMap = Map.fromList <$> mapParser+    jsonMap = maybeWithin spacesOrTabs $ mapOf colon (text 100) $ yamlWithIndent (-1)++    mapParser = indentationCheck keyValueParser indent++    keyValueParser = do n <- length <$> (space |*)+                        key <- show <$> element indent+                        (spacesOrTabs |?)+                        colon *> whiteSpace+                        value <- yamlWithIndent n+                        pure (n, (key, value))++++element :: Int -> Parser YamlExpression+element indent = exactly (dateTime <|> date <|> time <|> float <|>+                          integer <|> bool <|> nil) <|>+                    string indent++container :: Int -> Parser YamlExpression+container indent = list indent <|> mapping indent <|> set indent++++yamlWithIndent :: Int -> Parser YamlExpression+yamlWithIndent indent = maybeWithin ((blankLine <|> comment <|> directive <|>+                                      docStart <|> docEnd) |+)+                        yamlValue+  where+    yamlValue = container indent <|> maybeWithin spacesOrTabs (element indent)+    comment = hashTag *> (inverse newLine |+) <* newLine+    directive = is "%" *> (inverse space *> (inverse newLine |+)) <* newLine+    docStart = dash <#> 3+    docEnd = dot <#> 3++++text :: Int -> Parser String+text indent = withinDoubleQuotes (quotedParser (inverse doubleQuote |*))                      <|>+              withinQuotes       (quotedParser (inverse quote       |*))                      <|>+              (is "|" *> blankLine *> plainTextParser literalLineParser)                      <|>+              (is ">" *> blankLine *> (spacesOrTabs |?) *> plainTextParser foldingLineParser) <|>+              plainTextParser foldingLineParser+  where++    quotedParser parser = mconcat <$> ((snd <$> foldingLineParser parser) |*)++    plainTextParser styleParser = allowedStart >>> allowedString >>>+                                  (indentationCheck (styleParser allowedString) indent |*)++    foldingLineParser parser = do sep <- ("\n" <$ newLine <* blankLines) <|> (" " <$ newLine)+                                  n   <- maybeWithin tabs $ length <$> (space |*)+                                  str <- parser+                                  pure (n, sep <> str)++    literalLineParser parser = do sep <- pure <$> newLine+                                  n   <- length <$> (space |*)+                                  str <- parser+                                  pure (n, sep <> replicate (n - indent) ' ' <> str)++    allowedStart = noneOf $ forbiddenChar <> ['>', '|', ':', '!']++    allowedString = (noneOf forbiddenChar |*)++    forbiddenChar = ['\n', '#', '&', '*', ',', '?', '-', ':', '[', ']', '{', '}']++++indentationCheck :: Parser (Int, a) -> Int -> Parser [a]+indentationCheck parser indent = ((snd <$> check "indentation"+                                  (\(n, _) -> n > indent) parser) |+)+++normalize :: Parser String+normalize = withError "Normalize Yaml"+  $ (parserActions >>> normalize) <|> (char |*)+  where++    parserActions = spreadDashes     <|>+                    spreadDashKey    <|>+                    spreadKeyDash    <|>+                    next++    next = pure <$> char++    spreadDashes = ((<>) "- ") . genDashes <$> dashesParser++    genDashes (offset, n) = concatMap (\x -> "- " <> replicate (offset + 2 * x) ' ')+                                      [1 .. n - 1]++    dashesParser = do offset <- length <$> (spaces |?)+                      n <- length <$> ((dash <* spacesOrTabs) |++)+                      pure (offset, n)+++    spreadDashKey = (\(offset, key) -> replicate offset ' ' <> "- " <>+                                      replicate (offset + 2) ' ' <> key <> ": ")+                    <$> dashKeyParser++    dashKeyParser = do offset <- length <$> (spaces |?)+                       dash <* spacesOrTabs+                       key <- text 100 <* maybeWithin spacesOrTabs colon+                       pure (offset, key)+++    spreadKeyDash = (\(offset, key) -> replicate offset ' ' <> key <> ": " <>+                                      replicate (offset + 2) ' ' <> "- ")+                    <$> keyDashParser++    keyDashParser = do offset <- length <$> (spaces |?)+                       key <- text 100 <* maybeWithin spacesOrTabs colon+                       dash <* spacesOrTabs+                       pure (offset, key)

@@ -0,0 +1,28 @@+module Bookhound.SyntaxTrees.Json (JsExpression(..)) where++import Bookhound.Internal.Foldable (stringify)+import Bookhound.Internal.Map      (showMap)++import Data.Char (toLower)+import Data.Map  (Map)++++data JsExpression+  = JsNumber Double+  | JsBool Bool+  | JsString String+  | JsArray [JsExpression]+  | JsObject (Map String JsExpression)+  | JsNull+  deriving (Eq, Ord)+++instance Show JsExpression where+  show = \case+    JsNull       -> "null"+    JsNumber n   -> show n+    JsBool bool  -> toLower <$> show bool+    JsString str -> show str+    JsArray arr  -> stringify ",\n" "[\n" "\n]" 2 $ show   <$> arr+    JsObject obj -> stringify ",\n" "{\n" "\n}" 2 $ showMap ": " id show obj

@@ -0,0 +1,57 @@+module Bookhound.SyntaxTrees.Toml (TomlExpression(..), TableType(..)) where++import Bookhound.Internal.DateTime (showDateTime)+import Bookhound.Internal.Foldable (stringify)+import Bookhound.Internal.Map      (showMap)++import Data.Char (toLower)+import Data.Time (Day, TimeOfDay, ZonedTime (..))++import           Data.Map (Map)+import qualified Data.Map as Map++++data TomlExpression+  = TomlInteger Integer+  | TomlFloat Double+  | TomlBool Bool+  | TomlString String+  | TomlDate Day+  | TomlTime TimeOfDay+  | TomlDateTime ZonedTime+  | TomlArray [TomlExpression]+  | TomlTable TableType (Map String TomlExpression)+  | TomlNull+  deriving (Eq, Ord)+++data TableType+  = TopLevel+  | Standard+  | Inline+  deriving (Eq, Ord)+++instance Show TomlExpression where+  show = \case+    TomlNull                   -> "null"+    TomlInteger n              -> show n+    TomlFloat n                -> show n+    TomlBool bool              -> toLower <$> show bool+    TomlDate date              -> show date+    TomlTime time              -> show time+    TomlDateTime dateTime      -> showDateTime dateTime+    TomlString str             -> show str++    TomlTable Standard table   -> stringify "\n" "" "" 0 $ showMap " = " id show table++    TomlTable TopLevel table   -> stringify "\n\n" "\n" "\n" 0 $ showMap "" showTableHeader show table where+      showTableHeader header = if header /= "" then "[" <> header <> "]" <> "\n"  else ""++    TomlTable Inline table     -> stringify (", " <> sep) ("{ " <> sep) (" }" <> sep) n $+                                    showMap " = " id show table where+      (sep, n) = if (length . mconcat) (show <$> Map.toList table) >= 80 then ("\n", 2) else ("", 0)++    TomlArray arr              -> stringify (", " <> sep) ("[ " <> sep) (" ]" <> sep) n $ show <$> arr where+      (sep, n) = if (length . mconcat) (show <$> arr) >= 80 then ("\n", 2) else ("", 0)

@@ -0,0 +1,58 @@+module Bookhound.SyntaxTrees.Xml (XmlExpression(..), literalExpression, flatten, findAll, find) where++import Bookhound.Internal.Foldable (stringify)++import Data.Maybe (listToMaybe)++import           Data.Map (Map, elems, keys)+import qualified Data.Map as Map+++data XmlExpression+  = XmlExpression+      { tagName     :: String+      , fields      :: Map String String+      , expressions :: [XmlExpression]+      }+  deriving (Eq, Ord)+++instance Show XmlExpression where++  show XmlExpression { tagName = tag, .. }+    | tag == "literal" = head . elems $ fields+    | otherwise        = "<" <> tag <> flds <> innerExprs   where++        innerExprs = if | null expressions -> "/>"+                        | otherwise        -> ">"  <> ending++        (sep, n) = if | ((tagName) . head) expressions == "literal" -> ("", 0)+                      | otherwise                                   -> ("\n", 2)++        ending = stringify sep sep sep n (show <$> expressions) <> "</" <> tag <> ">"++        flds | null fields = ""+             | otherwise = " " <> fieldsString where++            fieldsString = stringify " " "" "" 0 $ showFn <$> tuples+            showFn (x, y) = x <> "=" <> show y+            tuples = zip (keys fields) (elems fields)++++literalExpression :: String -> XmlExpression+literalExpression val = XmlExpression { tagName = "literal",+                                        fields = Map.fromList [("value", val)],+                                        expressions = [] }+++flatten :: XmlExpression -> [XmlExpression]+flatten expr = expr : expressions expr >>= flatten+++findAll :: (XmlExpression -> Bool) -> XmlExpression -> [XmlExpression]+findAll f = filter f . flatten+++find :: (XmlExpression -> Bool) -> XmlExpression -> Maybe XmlExpression+find f = listToMaybe . findAll f

@@ -0,0 +1,69 @@+module Bookhound.SyntaxTrees.Yaml (YamlExpression(..), CollectionType(..)) where++import Bookhound.Internal.DateTime ()+import Bookhound.Internal.Foldable (stringify)+import Bookhound.Internal.Map      (showMap)++import           Data.Char (toLower)+import           Data.Map  (Map)+import qualified Data.Map  as Map+import           Data.Time (Day, TimeOfDay, ZonedTime (..))++++data YamlExpression+  = YamlInteger Integer+  | YamlFloat Double+  | YamlBool Bool+  | YamlString String+  | YamlDate Day+  | YamlTime TimeOfDay+  | YamlDateTime ZonedTime+  | YamlList CollectionType [YamlExpression]+  | YamlMap CollectionType (Map String YamlExpression)+  | YamlNull+  deriving (Eq, Ord)++data CollectionType+  = Standard+  | Inline+  deriving (Eq, Ord)+++instance Show YamlExpression where+  show = \case+    YamlNull                   -> "null"+    YamlInteger n              -> show n+    YamlFloat n                -> show n+    YamlBool bool              -> toLower <$> show bool+    YamlDate date              -> show date+    YamlTime time              -> show time+    YamlDateTime dateTime      -> show dateTime+    YamlString str             -> showStr str+    YamlList Standard list     -> stringify "\n" "\n" "" 2 $ ("- " <>) . show <$> list+    YamlMap  Standard mapping  -> stringify "\n" "\n" "" 2 $ showMap ": " id show mapping++    YamlList Inline   list     -> stringify (", " <> sep) ("[ " <> sep) (" ]" <> sep) n $ show <$> list where+      (sep, n) = if (length . mconcat) (show <$> list) >= 80 then ("\n", 2) else ("", 0)++    YamlMap  Inline   mapping  -> stringify (", " <> sep) ("{ " <> sep) (" }" <> sep) n $+                                    showMap ": " id show mapping where+      (sep, n) = if (length . mconcat) (show <$> Map.toList mapping) >= 80 then ("\n", 2) else ("", 0)++++showStr :: String -> String+showStr str = (if (length (lines str) > 1) && not (any (`elem` str) forbiddenChar)+                    then "| \n"+                    else if length (lines str) > 1 then "\n"+                    else "") <>++                   (if not $ any (`elem` str) forbiddenChar  then str+                   else if '"' `elem` str  then "'"  <> indented 3 <> "'"+                   else                         "\"" <> indented 3) <> "\""  where++  indented n = head (lines str) <>+               mconcat ((("\n" <> replicate n ' ') <>) <$> tail (lines str))++  forbiddenChar = ['#', '&', '*', ',', '?', '-', ':', '[', ']', '{', '}'] <>+                  ['>', '|', ':', '!']

@@ -1,84 +0,0 @@-module Operations.Finder (Finder(..)) where---import Parser            (runParser)-import ParserCombinators (IsMatch (..), (<|>), (|*))-import Parsers.Char      (dot)-import Parsers.Number    (unsignedInt)-import Parsers.String    (withinSquareBrackets)-import SyntaxTrees.Json  (JsExpression (..))-import SyntaxTrees.Toml  (TomlExpression (..))-import SyntaxTrees.Yaml  (YamlExpression (..))---import Data.Either (fromRight)-import Data.Maybe  (listToMaybe)--import qualified Data.Map as Map----class Finder a where--  toList :: a -> [(String, a)]-  findAll :: ((String, a) -> Bool) -> a -> [a]-  find :: ((String, a) -> Bool) -> a -> Maybe a-  findByKeys :: [String] -> a -> Maybe a-  findByPath :: String -> a -> Maybe a---  findAll f = fmap snd . filter f . toList-  find f = listToMaybe . findAll f--  findByKeys []       expr = Just expr-  findByKeys (x : xs) expr = findByKey x expr >>= findByKeys xs  where--    findByKey key = find (\(str, _) -> str == key)--  findByPath path = findByKeys pathSeq where--    pathSeq = fromRight [] $ runParser parsePath path-    parsePath = is '$' *> ((index <|> key) |*)--    index = show <$> withinSquareBrackets unsignedInt-    key   = dot *> word-    word  = (noneOf ['.', '['] |*)----instance Finder JsExpression where-  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 = \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 = \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

@@ -1,95 +0,0 @@-module Operations.ToJson (ToJson(..)) where--import Parser            (runParser)-import ParserCombinators (IsMatch (..), maybeWithin, (<|>), (|*))-import Parsers.Json      (json)-import Parsers.String    (spacing)-import SyntaxTrees.Json  (JsExpression (..))-import SyntaxTrees.Toml  (TomlExpression (..))-import SyntaxTrees.Xml   (XmlExpression (..))-import SyntaxTrees.Yaml  (YamlExpression (..))--import           Data.Either (fromRight)-import           Data.Map    (Map, elems)-import qualified Data.Map    as Map---class ToJson a where-  toJson :: a -> JsExpression---instance {-# OVERLAPPABLE #-} ToJson JsExpression where-  toJson = id--instance ToJson XmlExpression where--  toJson XmlExpression { tagName = tag, expressions = exprs, .. }-    | tag == "literal"  = fromRight JsNull . runParser literalParser .-                              head . elems $ fields-    | tag == "array"    = JsArray $ childExprToJson <$> exprs-    | tag == "object"   = JsObject . Map.fromList $ (\x -> (tagName x, childExprToJson x)) <$>-                                        exprs-    | otherwise          = JsNull   where--        literalParser = json <|> (JsString <$> maybeWithin spacing (isNot '<' |*))--        childExprToJson = toJson . head . (expressions)---instance ToJson YamlExpression where--  toJson = \case-    YamlNull              -> JsNull-    YamlInteger n         -> JsNumber $ fromIntegral n-    YamlFloat n           -> JsNumber n-    YamlBool bool         -> JsBool bool-    YamlString str        -> JsString str-    YamlDate date         -> JsString $ show date-    YamlTime time         -> JsString $ show time-    YamlDateTime dateTime -> JsString $ show dateTime-    YamlList _ list       -> JsArray $ toJson <$> list-    YamlMap  _ mapping    -> JsObject $ toJson <$> mapping---instance ToJson TomlExpression where--  toJson = \case-    TomlNull              -> JsNull-    TomlInteger n         -> JsNumber $ fromIntegral n-    TomlFloat n           -> JsNumber n-    TomlBool bool         -> JsBool bool-    TomlString str        -> JsString str-    TomlDate date         -> JsString $ show date-    TomlTime time         -> JsString $ show time-    TomlDateTime dateTime -> JsString $ show dateTime-    TomlArray list        -> JsArray $ toJson <$> list-    TomlTable _ mapping   -> JsObject $ toJson <$> mapping----instance ToJson String where-  toJson = JsString--instance ToJson Char where-  toJson = JsString . pure--instance ToJson Int where-  toJson = JsNumber . fromIntegral--instance ToJson Integer where-  toJson = JsNumber . fromIntegral--instance ToJson Double where-  toJson = JsNumber--instance ToJson Bool where-  toJson = JsBool--instance ToJson a => ToJson [a] where-  toJson = JsArray . fmap toJson--instance ToJson a => ToJson (Map String a) where-  toJson = JsObject . fmap toJson--instance ToJson a => ToJson (Maybe a) where-  toJson = maybe JsNull toJson

@@ -1,42 +0,0 @@-{-# LANGUAGE UndecidableInstances #-}--module Operations.ToXml (ToXml(..)) where--import Operations.ToJson (ToJson (..))-import SyntaxTrees.Json  (JsExpression (..))-import SyntaxTrees.Xml   (XmlExpression (..), literalExpression)--import           Data.Char (toLower)-import qualified Data.Map  as Map---class ToXml a where-  toXml :: a -> XmlExpression---instance {-# OVERLAPPABLE #-} ToJson a => ToXml a where-  toXml = toXml . toJson--instance ToXml XmlExpression where-  toXml = id---instance ToXml JsExpression where--  toXml = \case-    JsNull       -> literalExpression "null"-    JsNumber n   -> literalExpression $ show n-    JsBool bool  -> literalExpression $ toLower <$> show bool-    JsString str -> literalExpression str--    JsArray arr  -> XmlExpression "array" Map.empty (elemExpr <$> arr) where--      elemExpr element = XmlExpression { tagName = "elem",-                                       fields = Map.empty,-                                       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] }

@@ -1,29 +0,0 @@-{-# LANGUAGE UndecidableInstances #-}--module Operations.ToYaml (ToYaml(..)) where--import Operations.ToJson (ToJson (..))-import Parser            (runParser)-import Parsers.Number    (intLike)-import SyntaxTrees.Json  (JsExpression (..))-import SyntaxTrees.Yaml  (CollectionType (..), YamlExpression (..))---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 = \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

@@ -1,159 +0,0 @@-module Parser (Parser, ParseResult, ParseError(..), runParser, errorParser,-               andThen, exactly, isMatch, check, except, anyOf, allOf, char,-               withTransform) where--import Control.Applicative (liftA2)-import Control.Monad       (join)-import Data.Either         (fromRight)-import Data.List           (find)-import Data.Maybe          (isJust)--type Input = String--data Parser a-  = P-      { parse     :: Input -> ParseResult a-      , transform :: forall b. Maybe (Parser b -> Parser b)-      }--data ParseResult a-  = Result Input a-  | Error ParseError-  deriving (Eq)--data ParseError-  = UnexpectedEof-  | ExpectedEof Input-  | UnexpectedChar Char-  | UnexpectedString String-  | NoMatch String-  deriving (Eq, Show)---instance Show a => Show (ParseResult a) where-  show (Result i a)                 = "Pending: " ++ " >" ++ i ++ "< " ++-                                      "\n\nResult: \n" ++ show a-  show (Error UnexpectedEof)        = "Unexpected end of stream"-  show (Error (ExpectedEof i))      = "Expected end of stream, but got >" ++ i ++ "<"-  show (Error (UnexpectedChar c))   = "Unexpected char: "   ++ "[" ++ show c ++ "]"-  show (Error (UnexpectedString s)) = "Unexpected string: " ++ "[" ++ show s ++ "]"-  show (Error (NoMatch s))          = "Did not match condition: " ++ s---instance Functor ParseResult where-  fmap f (Result i a) = Result i (f a)-  fmap _ (Error pe)   = Error pe--instance Functor Parser where-  fmap f (P p t) = applyTransform t $ mkParser (fmap f . p)--instance Applicative Parser where-  pure a      = mkParser (`Result` a)-  (liftA2) f (P p t) mb@(P _ t') =-    applyTransform (findJust t t') combinedParser-    where-      combinedParser = mkParser (-        \x -> case p x of-        Result i a -> parse ((f a) <$> mb) i-        Error pe   -> Error pe)--instance Monad Parser where-  (>>=) (P p t) f = applyTransform t combinedParser-    where-      combinedParser = mkParser (-        \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 (exactly p) i where--  toEither = \case-    Error pe   -> Left pe-    Result _ a -> Right a--errorParser :: ParseError -> Parser a-errorParser = mkParser . const . Error---char :: Parser Char-char = mkParser parseIt  where-  parseIt []          = Error UnexpectedEof-  parseIt (ch : rest) = Result rest ch----andThen :: Parser Input -> Parser a -> Parser a-andThen p1 p2@(P _ t) = applyTransform t $ P (\i -> parse p2 $ fromRight i $ runParser p1 i) t---exactly :: Parser a -> Parser a-exactly (P p t) = applyTransform t $ mkParser (-  \x -> case p x of-    result@(Result "" _) -> result-    Result i _           -> Error $ ExpectedEof i-    err@(Error _)        -> err)--anyOf :: [Parser a] -> Parser a-anyOf ps = anyOfHelper ps Nothing--allOf :: [Parser a] -> Parser a-allOf ps = allOfHelper ps Nothing---anyOfHelper :: [Parser a] -> (forall b. Maybe (Parser b -> Parser b)) -> Parser a-anyOfHelper [] _  = errorParser $ NoMatch "anyOf"-anyOfHelper [p] _ = p-anyOfHelper ((P p t) : rest) t' = applyTransform (findJust t t') $-  mkParser (-   \x -> case p x of-    result@(Result _ _) -> result-    Error _             -> parse (anyOfHelper rest t) x)----allOfHelper :: [Parser a] -> (forall b. Maybe (Parser b -> Parser b)) -> Parser a-allOfHelper [] _ = errorParser $ NoMatch "allOf"-allOfHelper [p] _ = p-allOfHelper ((P p t) : rest) t' = applyTransform (findJust t t') $-  mkParser (-   \x -> case p x of-    Result _ _    -> parse (allOfHelper rest t) x-    err@(Error _) -> err)----isMatch :: (Char -> Char -> Bool) -> Parser Char -> Char -> Parser Char-isMatch cond parser c1 =-  do c2 <- parser-     if cond c1 c2-       then pure c2-       else errorParser $ UnexpectedChar c2--check :: String -> (a -> Bool) -> Parser a -> Parser a-check condName cond parser =-  do c2 <- parser-     if cond c2-       then pure c2-       else  errorParser $ NoMatch condName---except :: Show a => Parser a -> Parser a -> Parser a-except (P p t) (P p' _) = applyTransform t $ mkParser (-  \x -> case p' x of-    Result _ a -> Error $ UnexpectedString (show a)-    Error _    -> p x)--withTransform :: (forall b. Parser b -> Parser b) -> Parser a -> Parser a-withTransform f = applyTransform $ Just f---applyTransform :: (forall a. Maybe (Parser a -> Parser a)) -> Parser b -> Parser b-applyTransform f p =  maybe p (\f' -> (f' p){transform = f} ) f--mkParser :: (Input -> ParseResult a) -> Parser a-mkParser p = P {parse = p, transform = Nothing}--findJust :: forall a. Maybe a -> Maybe a -> Maybe a-findJust ma mb = join $ find isJust [ma, mb]

@@ -1,148 +0,0 @@-{-# LANGUAGE UndecidableInstances #-}--module ParserCombinators (IsMatch(..), satisfies, contains, notContains,-                          containsAnyOf, containsNoneOf,-                          times, maybeTimes, anyTimes, someTimes, manyTimes,-                          within, maybeWithin, withinBoth, maybeWithinBoth,-                          anySepBy, someSepBy, manySepBy, sepByOp,-                          (<|>), (<&>), (<#>), (>>>), (|?), (|*), (|+), (|++))  where--import Parser            (Parser, allOf, anyOf, char, check, except, isMatch)-import Utils.Applicative (extract)-import Utils.Foldable    (hasMany, hasSome)-import Utils.String      (ToString (..))--import Data.List  (isInfixOf)-import Data.Maybe (listToMaybe)--import qualified Data.Foldable as Foldable---class IsMatch a where-  is      :: a -> Parser a-  isNot   :: a -> Parser a-  inverse :: Parser a -> Parser a-  oneOf   :: [a] -> Parser a-  noneOf  :: [a] -> Parser a--  oneOf xs  = anyOf $ is <$> xs-  noneOf xs = allOf $ isNot <$> xs---instance IsMatch Char where-  is      = isMatch (==) char-  isNot   = isMatch (/=) char-  inverse = except char--instance IsMatch String where-  is      = traverse is-  isNot   = traverse isNot-  inverse = except (char |*)--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 :: (a -> Bool) -> Parser a -> Parser a-satisfies cond p = check "satisfies" cond p--contains :: Eq a => [a] -> Parser [a] -> Parser [a]-contains val p = check "contains" (isInfixOf val) p--containsAnyOf :: (Foldable t, Eq a) => t [a] -> Parser [a] -> Parser [a]-containsAnyOf x y = foldr contains y x--notContains :: Eq a => [a] -> Parser [a] -> Parser [a]-notContains val p = check "notContains" (isInfixOf val) p--containsNoneOf :: (Foldable t, Eq a) => t [a] -> Parser [a] -> Parser [a]-containsNoneOf x y = foldr notContains y x--- -- Frequency combinators-times :: Integer -> Parser a  -> Parser [a]-times n p = sequence $ p <$ [1 .. n]---maybeTimes :: Parser a -> Parser (Maybe a)-maybeTimes = (listToMaybe <$>) . check "maybeTimes" (not . hasMany) . anyTimes--anyTimes :: Parser a -> Parser [a]-anyTimes parser = (parser >>= \x -> (x :) <$> anyTimes parser) <|> pure []--someTimes :: Parser a -> Parser [a]-someTimes = check "someTimes" hasSome . anyTimes--manyTimes :: Parser a -> Parser [a]-manyTimes = check "manyTimes" hasMany . anyTimes----- Within combinators-within :: Parser a -> Parser b -> Parser b-within p = extract p p--maybeWithin :: Parser a -> Parser b -> Parser b-maybeWithin p = within (p |?)--withinBoth :: Parser a -> Parser b -> Parser c -> Parser c-withinBoth = extract--maybeWithinBoth :: Parser a -> Parser b -> Parser c -> Parser c-maybeWithinBoth p1 p2 = extract (p1 |?) (p2 |?)----- Separated by combinators-sepBy :: (Parser b -> Parser (Maybe b)) -> (Parser b -> Parser [b])-                -> Parser a -> Parser b -> Parser [b]-sepBy freq1 freq2 sep p = (++) <$> (Foldable.toList <$> freq1 p)-                               <*> freq2 (sep *> p)--anySepBy :: Parser a -> Parser b -> Parser [b]-anySepBy = sepBy (|?) (|*)--someSepBy :: Parser a -> Parser b -> Parser [b]-someSepBy = sepBy (fmap Just) (|*)--manySepBy :: Parser a -> Parser b -> Parser [b]-manySepBy = sepBy (fmap Just) (|+)--sepByOp :: Parser a -> Parser b -> Parser (a, [b])-sepByOp sep p = do x1 <- p-                   op <- sep-                   xs <- someSepBy sep p-                   pure $ (op, x1 : xs)---- 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]-(<#>) = flip times--infixl 6 >>>-(>>>) :: (ToString a, ToString b) => Parser a -> Parser b -> Parser String-(>>>) p1 p2 = (++) <$> (toString <$> p1)-                   <*> (toString <$> p2)----- Parser Unary Operators-(|?) :: Parser a -> Parser (Maybe a)-(|?) = maybeTimes--(|*) :: Parser a -> Parser [a]-(|*) = anyTimes--(|+) :: Parser a -> Parser [a]-(|+) = someTimes--(|++) :: Parser a -> Parser [a]-(|++) = manyTimes

@@ -1,104 +0,0 @@-module Parsers.Char where--import ParserCombinators (IsMatch (..), (<|>))--import           Parser (Parser)-import qualified Parser---char :: Parser Char-char = Parser.char--digit :: Parser Char-digit = oneOf ['0' .. '9']--upper :: Parser Char-upper = oneOf ['A' .. 'Z']--lower :: Parser Char-lower = oneOf ['a' .. 'z']--letter :: Parser Char-letter = upper <|> lower--alpha :: Parser Char-alpha = letter--alphaNum :: Parser Char-alphaNum = alpha <|> digit----space :: Parser Char-space = is ' '--tab :: Parser Char-tab = is '\t'--spaceOrTab :: Parser Char-spaceOrTab = space <|> tab--whiteSpace :: Parser Char-whiteSpace = space <|> tab <|> newLine--newLine :: Parser Char-newLine = is '\n'--comma :: Parser Char-comma = is ','--dot :: Parser Char-dot = is '.'--colon :: Parser Char-colon = is ':'--quote :: Parser Char-quote = is '\''--doubleQuote :: Parser Char-doubleQuote = is '"'--dash :: Parser Char-dash = is '-'--plus :: Parser Char-plus = is '+'--equal :: Parser Char-equal = is '='--underscore :: Parser Char-underscore = is '_'--hashTag :: Parser Char-hashTag = is '#'--question :: Parser Char-question = is '?'----openParens :: Parser Char-openParens = is '('--closeParens :: Parser Char-closeParens = is ')'--openSquare :: Parser Char-openSquare = is '['--closeSquare :: Parser Char-closeSquare = is ']'--openCurly :: Parser Char-openCurly = is '{'--closeCurly :: Parser Char-closeCurly = is '}'--openAngle :: Parser Char-openAngle = is '<'--closeAngle :: Parser Char-closeAngle = is '>'

@@ -1,27 +0,0 @@-module Parsers.Collections (collOf, listOf, tupleOf, mapOf) where--import Parser            (Parser)-import ParserCombinators (anySepBy, maybeWithin, satisfies)-import Parsers.Char      (closeCurly, closeParens, closeSquare, comma,-                          openCurly, openParens, openSquare)-import Parsers.String    (spacing)--import           Data.Map (Map)-import qualified Data.Map as Map---collOf :: Parser a -> Parser b -> Parser c -> Parser d -> Parser [d]-collOf start end sep elemParser = start *> elemsParser <* end   where--  elemsParser = anySepBy sep $ maybeWithin spacing elemParser--listOf :: Parser a -> Parser [a]-listOf = collOf openSquare closeSquare comma--tupleOf :: Parser a -> Parser [a]-tupleOf = satisfies ((>= 2) . length) . collOf openParens closeParens comma--mapOf :: Ord b => Parser a -> Parser b -> Parser c -> Parser (Map b c)-mapOf sep p1 p2 = Map.fromList <$> collOf openCurly closeCurly comma mapEntry  where--  mapEntry = (,) <$> p1 <* maybeWithin spacing sep <*> p2

@@ -1,69 +0,0 @@-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 Parsers.Char      (colon, dash, digit, plus)--import Data.Maybe (fromMaybe)-import Data.Time  (Day, LocalTime (..), TimeOfDay (..), TimeZone,-                   ZonedTime (..), fromGregorian, minutesToTimeZone)---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--day :: Parser Int-day = check "day" (range 1 31) $ read <$> digit <#> 2--month :: Parser Int-month = check "month" (range 1 12) $ read <$> digit <#> 2--hour :: Parser Int-hour = check "hour" (range 0 23) $ read <$> digit <#> 2--minute :: Parser Int-minute = check "minute" (range 0 59) $ read <$> digit <#> 2--second :: Parser Int-second = check "second" (range 0 59) $ read <$> digit <#> 2--secondDecimals :: Parser Integer-secondDecimals = read <$> check "pico seconds" ((<= 12) . length) (digit |+)------range :: Ord a => a -> a -> a -> Bool-range mn mx x = x >= mn && x <= mx

@@ -1,53 +0,0 @@-module Parsers.Json (json, nil, number, bool, string, array, object) where--import Parser              (Parser)-import ParserCombinators   (IsMatch (..), maybeWithin, (<|>), (|*))-import Parsers.Char        (colon, doubleQuote)-import Parsers.Collections (listOf, mapOf)-import Parsers.Number      (double)-import Parsers.String      (spacing, withinDoubleQuotes)-import SyntaxTrees.Json    (JsExpression (..))---json :: Parser JsExpression-json = maybeWithin spacing jsValue where--  jsValue = element <|> container---nil :: Parser JsExpression-nil = JsNull <$ is "null"--number :: Parser JsExpression-number = JsNumber <$> double---bool :: Parser JsExpression-bool = JsBool <$> (True  <$ is "true" <|>-                   False <$ is "false")---string :: Parser JsExpression-string = JsString <$> text---array :: Parser JsExpression-array = JsArray <$> listOf json---object :: Parser JsExpression-object = JsObject <$> mapOf colon text json----element :: Parser JsExpression-element = number <|> bool <|> nil <|> string--container :: Parser JsExpression-container = array <|> object-----text :: Parser String-text = withinDoubleQuotes (inverse doubleQuote |*)

@@ -1,43 +0,0 @@-module Parsers.Number (int, double, posInt, negInt, unsignedInt, hexInt, octInt, intLike) where--import Parser            (ParseError (..), Parser, errorParser)-import ParserCombinators (IsMatch (..), (<|>), (>>>), (|+), (|?))-import Parsers.Char      (dash, digit, dot, plus)---hexInt :: Parser Integer-hexInt = read <$> (is "0x" >>> ((digit <|> oneOf ['A' .. 'F'] <|> oneOf ['a' .. 'f']) |+))--octInt :: Parser Integer-octInt = read <$> (is "0o" >>> (oneOf ['0' .. '7'] |+))--unsignedInt :: Parser Integer-unsignedInt = read <$> (digit |+)--posInt :: Parser Integer-posInt = read <$> (plus |?) >>> (digit |+)--negInt :: Parser Integer-negInt = read <$> dash >>> (digit |+)--int :: Parser Integer-int = negInt <|> posInt--intLike :: Parser Integer-intLike = parser <|> int  where--  parser = do n1      <- show <$> int-              n2      <- show <$> (dot *> unsignedInt)-              expNum  <- oneOf ['e', 'E'] *> int--              if length n1 + length n2 <= fromInteger expNum then-                pure . read $ n1 ++ "." ++ n2 ++ "E" ++ show expNum-              else-                errorParser $ NoMatch "intLike"---double :: Parser Double-double = read <$> int >>> (decimals |?) >>> (expn |?) where--  decimals = dot >>> unsignedInt-  expn      = oneOf ['e', 'E'] >>> int

@@ -1,98 +0,0 @@-module Parsers.String where--import Parser            (Parser)-import ParserCombinators (IsMatch (..), maybeWithin, maybeWithinBoth, within,-                          withinBoth, (>>>), (|*), (|+), (|?))-import Parsers.Char      (alpha, alphaNum, char, closeAngle, closeCurly,-                          closeParens, closeSquare, digit, doubleQuote, letter,-                          lower, newLine, openAngle, openCurly, openParens,-                          openSquare, quote, space, spaceOrTab, tab, upper,-                          whiteSpace)---string :: Parser String-string = (char |*)--word :: Parser String-word = (inverse whiteSpace |+)--digits :: Parser String-digits = (digit |+)--uppers :: Parser String-uppers = (upper |+)--lowers :: Parser String-lowers = (lower |+)--letters :: Parser String-letters = (letter |+)--alphas :: Parser String-alphas = (alpha |+)--alphaNums :: Parser String-alphaNums = (alphaNum |+)----spaces :: Parser String-spaces = (space |+)--tabs :: Parser String-tabs = (tab |+)--newLines :: Parser String-newLines = (newLine |+)--spacesOrTabs :: Parser String-spacesOrTabs = (spaceOrTab |+)--spacing :: Parser String-spacing = (whiteSpace |+)--blankLine :: Parser String-blankLine = (spacesOrTabs |?) >>> newLine--blankLines :: Parser String-blankLines = mconcat <$> (blankLine |+)----withinQuotes :: Parser b -> Parser b-withinQuotes = within quote--withinDoubleQuotes :: Parser b -> Parser b-withinDoubleQuotes = within doubleQuote--withinParens :: Parser b -> Parser b-withinParens = withinBoth openParens closeParens--withinSquareBrackets :: Parser b -> Parser b-withinSquareBrackets = withinBoth openSquare closeSquare--withinCurlyBrackets :: Parser b -> Parser b-withinCurlyBrackets = withinBoth openCurly closeCurly--withinAngleBrackets :: Parser b -> Parser b-withinAngleBrackets = withinBoth openAngle closeAngle----maybeWithinQuotes :: Parser b -> Parser b-maybeWithinQuotes = maybeWithin quote--maybeWithinDoubleQuotes :: Parser b -> Parser b-maybeWithinDoubleQuotes = maybeWithin doubleQuote--maybeWithinParens :: Parser b -> Parser b-maybeWithinParens = maybeWithinBoth openParens closeParens--maybeWithinSquareBrackets :: Parser b -> Parser b-maybeWithinSquareBrackets = maybeWithinBoth openSquare closeSquare--maybeWithinCurlyBrackets :: Parser b -> Parser b-maybeWithinCurlyBrackets = maybeWithinBoth openCurly closeCurly--maybeWithinAngleBrackets :: Parser b -> Parser b-maybeWithinAngleBrackets = maybeWithinBoth openAngle closeAngle

@@ -1,127 +0,0 @@-module Parsers.Toml (toml, nil, integer, float, bool, string,-                     array, inlineTable) where--import Parser              (Parser)-import ParserCombinators   (IsMatch (..), maybeWithin, within, (<#>), (<|>),-                            (>>>), (|*), (|+), (|?))-import Parsers.Char        (dash, digit, dot, doubleQuote, equal, hashTag,-                            letter, newLine, quote, spaceOrTab, underscore,-                            whiteSpace)-import Parsers.Collections (listOf, mapOf)-import Parsers.Number      (double, hexInt, int, octInt)-import Parsers.String      (blankLine, blankLines, spacesOrTabs, spacing,-                            withinDoubleQuotes, withinQuotes,-                            withinSquareBrackets)-import SyntaxTrees.Toml    (TableType (..), TomlExpression (..))--import qualified Parsers.DateTime as Dt--import qualified Data.Map   as Map-import           Data.Maybe (maybeToList)----toml :: Parser TomlExpression-toml = maybeWithin (((pure <$> whiteSpace) <|> comment) |+) topLevelTable------ TODO: Add support for table arrays--nil :: Parser TomlExpression-nil = TomlNull <$ is "null"--integer :: Parser TomlExpression-integer = TomlInteger <$> (hexInt <|> octInt <|> int)--float :: Parser TomlExpression-float = TomlFloat <$> double--bool :: Parser TomlExpression-bool = TomlBool <$> (True  <$ is "true"  <|>-                     False <$ is "false")---dateTime :: Parser TomlExpression-dateTime = TomlDateTime <$> Dt.dateTime--date :: Parser TomlExpression-date = TomlDate <$> Dt.date--time :: Parser TomlExpression-time = TomlTime <$> Dt.time---string :: Parser TomlExpression-string = TomlString <$> text where--  text = within (doubleQuote <#> 3) (multiline (inverse doubleQuote |*)) <|>-         within  (quote <#> 3)      (multiline (inverse quote |*))       <|>-         withinDoubleQuotes         (inverse doubleQuote |*)             <|>-         withinQuotes               (inverse quote       |*)--  multiline parser = mconcat <$> (((blankLine |?) *> line parser) |*)--  line parser = is "\\" *> (whiteSpace |*) *> parser---array :: Parser TomlExpression-array = TomlArray <$> listOf (maybeWithin spacing tomlExpr)---key :: Parser String-key = keyParser >>> ((dot >>> keyParser) |*) where--  keyParser = maybeWithin spacesOrTabs $ freeText      <|>-              withinDoubleQuotes (inverse doubleQuote |*) <|>-              withinQuotes (inverse quote |*)--  freeText = ((letter <|> digit <|> underscore <|> dash) |+)---inlineTable :: Parser TomlExpression-inlineTable = TomlTable Inline <$> mapOf equal key tomlExpr---topLevelTable :: Parser TomlExpression-topLevelTable = TomlTable TopLevel . Map.fromList <$> maybeWithin spacing tables where--  tables = do xs <- keyValueSeqParser-              ys <- (tableParser |*)-              pure (ys ++ [("", TomlTable Standard . Map.fromList $ xs)])--  tableParser = do k <- withinSquareBrackets key-                   v <- maybeWithin spacing standardTable-                   pure (k, v)--  standardTable = TomlTable Standard . Map.fromList <$> keyValueSeqParser---  keyValueSeqParser = do xs <- ((keyValueParser <* (blankLine *> (blankLines |?))) |*)-                         x  <- (keyValueParser |?)-                         pure  (xs ++ maybeToList x)--  keyValueParser = do k <- key-                      maybeWithin spacesOrTabs equal-                      v <- tomlExpr-                      pure (k, v)----element :: Parser TomlExpression-element = dateTime <|> date <|> time <|> float <|>-          integer  <|> bool <|> nil  <|> string---container :: Parser TomlExpression-container = array <|> inlineTable---comment :: Parser String-comment = hashTag *> (inverse newLine |+) <* newLine---tomlExpr :: Parser TomlExpression-tomlExpr = maybeWithin (((pure <$> spaceOrTab) <|> comment) |+) tomlValue where--  tomlValue = element <|> container

@@ -1,57 +0,0 @@-module Parsers.Xml (xml, branchExpr, leafExpr, literal) where--import Parser            (Parser)-import ParserCombinators (IsMatch (..), maybeWithin, (<|>), (|*), (|+))-import Parsers.Char      (doubleQuote)-import Parsers.String    (spacing, withinAngleBrackets, withinDoubleQuotes)-import SyntaxTrees.Xml   (XmlExpression (..), literalExpression)--import           Data.Map (Map)-import qualified Data.Map as Map---xml :: Parser XmlExpression-xml = maybeWithin  ((header <|> comment) |+) $-        maybeWithin spacing $ branchExpr <|> leafExpr----field :: Parser (String, String)-field = (,) <$> text <* is '=' <*> quotedText where--  quotedText = withinDoubleQuotes (inverse doubleQuote |*)---fullTag :: Parser (String, Map String String)-fullTag = do tag  <- text-             flds <- Map.fromList <$> ((spacing *> field) |*)-             pure (tag, flds)---branchExpr :: Parser XmlExpression-branchExpr = do (tag, flds) <- withinAngleBrackets fullTag-                exprs       <- (xml |+) <|> literal-                maybeWithin spacing (is ("</" ++ tag ++ ">"))-                pure $ XmlExpression { tagName = tag, fields = flds, expressions = exprs }---literal :: Parser [XmlExpression]-literal = pure . literalExpression <$> maybeWithin spacing (isNot '<' |*)---leafExpr :: Parser XmlExpression-leafExpr = do (tag, flds) <- withinAngleBrackets (fullTag <* is '/')-              pure $ XmlExpression { tagName = tag, fields = flds, expressions = [] }---header :: Parser String-header = maybeWithin spacing $ is "<?" *> (isNot '?' |*) <* is "?>"---comment :: Parser String-comment = maybeWithin spacing $ is "<!--" *> (isNot '-' |*) <* is "-->"----text :: Parser String-text = (noneOf ['/', '>', ' ', '='] |+)

@@ -1,196 +0,0 @@-module Parsers.Yaml (yaml, nil, integer, float, bool, string,-                     list, mapping) where---import Parser              (Parser, andThen, check, exactly)-import ParserCombinators   (IsMatch (..), maybeWithin, (<#>), (<|>), (>>>),-                            (|*), (|+), (|++), (|?))-import Parsers.Char        (char, colon, dash, dot, doubleQuote, hashTag,-                            newLine, question, quote, space, whiteSpace)-import Parsers.Collections (listOf, mapOf)-import Parsers.Number      (double, hexInt, int, octInt)-import Parsers.String      (blankLine, blankLines, spaces, spacesOrTabs, tabs,-                            withinDoubleQuotes, withinQuotes)-import SyntaxTrees.Yaml    (CollectionType (..), YamlExpression (..))--import qualified Parsers.DateTime as Dt--import           Data.List (nub)-import qualified Data.Map  as Map----yaml :: Parser YamlExpression-yaml =  normalize `andThen` yamlWithIndent (-1)------- TODO: Add support for anchors and aliases--nil :: Parser YamlExpression-nil = YamlNull <$ oneOf ["null", "Null", "NULL"]--integer :: Parser YamlExpression-integer = YamlInteger <$> (hexInt <|> octInt <|> int)--float :: Parser YamlExpression-float = YamlFloat <$> double--bool :: Parser YamlExpression-bool = YamlBool <$> (True  <$ oneOf ["true", "True", "TRUE"]    <|>-                     False <$ oneOf ["false", "False", "FALSE"])---dateTime :: Parser YamlExpression-dateTime = YamlDateTime <$> Dt.dateTime--date :: Parser YamlExpression-date = YamlDate <$> Dt.date--time :: Parser YamlExpression-time = YamlTime <$> Dt.time---string :: Int -> Parser YamlExpression-string indent = YamlString <$> text indent---sequential :: Parser a -> Int -> Parser [YamlExpression]-sequential sep indent = listParser where--  listParser = indentationCheck elemParser indent--  elemParser = do n <- length <$> (space |*)-                  sep *> whiteSpace-                  elm <- yamlWithIndent n-                  pure (n, elm)---list :: Int -> Parser YamlExpression-list indent = (YamlList Inline <$> jsonList) <|>-              (YamlList Standard <$> yamlList)  where--  yamlList = sequential dash indent-  jsonList = maybeWithin spacesOrTabs $ listOf $ yamlWithIndent (-1)---set :: Int -> Parser YamlExpression-set indent = YamlList Standard . nub <$> sequential question indent---mapping :: Int -> Parser YamlExpression-mapping indent = (YamlMap Inline <$> jsonMap) <|>-                 (YamlMap Standard <$> yamlMap)  where--  yamlMap = Map.fromList <$> mapParser-  jsonMap = maybeWithin spacesOrTabs $ mapOf colon (text 100) $ yamlWithIndent (-1)--  mapParser = indentationCheck keyValueParser indent--  keyValueParser = do n <- length <$> (space |*)-                      key <- show <$> element indent-                      (spacesOrTabs |?)-                      colon *> whiteSpace-                      value <- yamlWithIndent n-                      pure (n, (key, value))----element :: Int -> Parser YamlExpression-element indent = exactly (dateTime <|> date <|> time <|> float <|>-                          integer <|> bool <|> nil) <|>-                    string indent--container :: Int -> Parser YamlExpression-container indent = list indent <|> mapping indent <|> set indent----yamlWithIndent :: Int -> Parser YamlExpression-yamlWithIndent indent = maybeWithin ((blankLine <|> comment <|> directive <|>-                                      docStart <|> docEnd) |+)-                        yamlValue  where--  yamlValue = container indent <|> maybeWithin spacesOrTabs (element indent)-  comment = hashTag *> (inverse newLine |+) <* newLine-  directive = is "%" *> (inverse space *> (inverse newLine |+)) <* newLine-  docStart = dash <#> 3-  docEnd = dot <#> 3----text :: Int -> Parser String-text indent = withinDoubleQuotes (quotedParser (inverse doubleQuote |*))                      <|>-              withinQuotes       (quotedParser (inverse quote       |*))                      <|>-              (is "|" *> blankLine *> plainTextParser literalLineParser)                      <|>-              (is ">" *> blankLine *> (spacesOrTabs |?) *> plainTextParser foldingLineParser) <|>-              plainTextParser foldingLineParser-  where--  quotedParser parser = mconcat <$> ((snd <$> foldingLineParser parser) |*)--  plainTextParser styleParser = allowedStart >>> allowedString >>>-                                (indentationCheck (styleParser allowedString) indent |*)--  foldingLineParser parser = do sep <- ("\n" <$ newLine <* blankLines) <|> (" " <$ newLine)-                                n   <- maybeWithin tabs $ length <$> (space |*)-                                str <- parser-                                pure (n, sep ++ str)--  literalLineParser parser = do sep <- pure <$> newLine-                                n   <- length <$> (space |*)-                                str <- parser-                                pure (n, sep ++ replicate (n - indent) ' ' ++ str)--  allowedStart = noneOf $ forbiddenChar ++ ['>', '|', ':', '!']--  allowedString = (noneOf forbiddenChar |*)--  forbiddenChar = ['\n', '#', '&', '*', ',', '?', '-', ':', '[', ']', '{', '}']----indentationCheck :: Parser (Int, a) -> Int -> Parser [a]-indentationCheck parser indent = ((snd <$> check "indentation"-                                  (\(n, _) -> n > indent) parser) |+)---normalize :: Parser String-normalize = (parserActions >>> normalize) <|> (char |*) where--  parserActions = spreadDashes     <|>-                  spreadDashKey    <|>-                  spreadKeyDash    <|>-                  next--  next = pure <$> char--  spreadDashes = (++ "- ") . genDashes <$> dashesParser--  genDashes (offset, n) = concatMap (\x -> "- " ++ replicate (offset + 2 * x) ' ')-                                    [1 .. n - 1]--  dashesParser = do offset <- length <$> (spaces |?)-                    n <- length <$> ((dash <* spacesOrTabs) |++)-                    pure (offset, n)---  spreadDashKey = (\(offset, key) -> replicate offset ' ' ++ "- " ++-                                     replicate (offset + 2) ' ' ++ key ++ ": ")-                  <$> dashKeyParser--  dashKeyParser = do offset <- length <$> (spaces |?)-                     dash <* spacesOrTabs-                     key <- text 100 <* maybeWithin spacesOrTabs colon-                     pure (offset, key)---  spreadKeyDash = (\(offset, key) -> replicate offset ' ' ++ key ++ ": " ++-                                     replicate (offset + 2) ' ' ++ "- ")-                  <$> keyDashParser--  keyDashParser = do offset <- length <$> (spaces |?)-                     key <- text 100 <* maybeWithin spacesOrTabs colon-                     dash <* spacesOrTabs-                     pure (offset, key)

@@ -1,28 +0,0 @@-module SyntaxTrees.Json (JsExpression(..)) where--import Utils.Foldable (stringify)-import Utils.Map      (showMap)--import Data.Char (toLower)-import Data.Map  (Map)----data JsExpression-  = JsNumber Double-  | JsBool Bool-  | JsString String-  | JsArray [JsExpression]-  | JsObject (Map String JsExpression)-  | JsNull-  deriving (Eq, Ord)---instance Show JsExpression where-  show = \case-    JsNull       -> "null"-    JsNumber n   -> show n-    JsBool bool  -> toLower <$> show bool-    JsString str -> show str-    JsArray arr  -> stringify ",\n" "[\n" "\n]" 2 $ show   <$> arr-    JsObject obj -> stringify ",\n" "{\n" "\n}" 2 $ showMap ": " id show obj

@@ -1,57 +0,0 @@-module SyntaxTrees.Toml (TomlExpression(..), TableType(..)) where--import Utils.DateTime (showDateTime)-import Utils.Foldable (stringify)-import Utils.Map      (showMap)--import Data.Char (toLower)-import Data.Time (Day, TimeOfDay, ZonedTime (..))--import           Data.Map (Map)-import qualified Data.Map as Map----data TomlExpression-  = TomlInteger Integer-  | TomlFloat Double-  | TomlBool Bool-  | TomlString String-  | TomlDate Day-  | TomlTime TimeOfDay-  | TomlDateTime ZonedTime-  | TomlArray [TomlExpression]-  | TomlTable TableType (Map String TomlExpression)-  | TomlNull-  deriving (Eq, Ord)---data TableType-  = TopLevel-  | Standard-  | Inline-  deriving (Eq, Ord)---instance Show TomlExpression where-  show = \case-    TomlNull                   -> "null"-    TomlInteger n              -> show n-    TomlFloat n                -> show n-    TomlBool bool              -> toLower <$> show bool-    TomlDate date              -> show date-    TomlTime time              -> show time-    TomlDateTime dateTime      -> showDateTime dateTime-    TomlString str             -> show str--    TomlTable Standard table   -> stringify "\n" "" "" 0 $ showMap " = " id show table--    TomlTable TopLevel table   -> stringify "\n\n" "\n" "\n" 0 $ showMap "" showTableHeader show table where-      showTableHeader header = if header /= "" then "[" ++ header ++ "]" ++ "\n"  else ""--    TomlTable Inline table     -> stringify (", " ++ sep) ("{ " ++ sep) (" }" ++ sep) n $-                                    showMap " = " id show table where-      (sep, n) = if (length . mconcat) (show <$> Map.toList table) >= 80 then ("\n", 2) else ("", 0)--    TomlArray arr              -> stringify (", " ++ sep) ("[ " ++ sep) (" ]" ++ sep) n $ show <$> arr where-      (sep, n) = if (length . mconcat) (show <$> arr) >= 80 then ("\n", 2) else ("", 0)

@@ -1,58 +0,0 @@-module SyntaxTrees.Xml (XmlExpression(..), literalExpression, flatten, findAll, find) where--import Utils.Foldable (stringify)--import Data.Maybe (listToMaybe)--import           Data.Map (Map, elems, keys)-import qualified Data.Map as Map---data XmlExpression-  = XmlExpression-      { tagName     :: String-      , fields      :: Map String String-      , expressions :: [XmlExpression]-      }-  deriving (Eq, Ord)---instance Show XmlExpression where--  show XmlExpression { tagName = tag, .. }-    | tag == "literal" = head . elems $ fields-    | otherwise        = "<" ++ tag ++ flds ++ innerExprs   where--        innerExprs = if | null expressions -> "/>"-                        | otherwise        -> ">"  ++ ending--        (sep, n) = if | ((tagName) . head) expressions == "literal" -> ("", 0)-                      | otherwise                                   -> ("\n", 2)--        ending = stringify sep sep sep n (show <$> expressions) ++ "</" ++ tag ++ ">"--        flds | null fields = ""-             | otherwise = " " ++ fieldsString where--            fieldsString = stringify " " "" "" 0 $ showFn <$> tuples-            showFn (x, y) = x ++ "=" ++ show y-            tuples = zip (keys fields) (elems fields)----literalExpression :: String -> XmlExpression-literalExpression val = XmlExpression { tagName = "literal",-                                        fields = Map.fromList [("value", val)],-                                        expressions = [] }---flatten :: XmlExpression -> [XmlExpression]-flatten expr = expr : expressions expr >>= flatten---findAll :: (XmlExpression -> Bool) -> XmlExpression -> [XmlExpression]-findAll f = filter f . flatten---find :: (XmlExpression -> Bool) -> XmlExpression -> Maybe XmlExpression-find f = listToMaybe . findAll f

@@ -1,69 +0,0 @@-module SyntaxTrees.Yaml (YamlExpression(..), CollectionType(..)) where--import Utils.DateTime ()-import Utils.Foldable (stringify)-import Utils.Map      (showMap)--import           Data.Char (toLower)-import           Data.Map  (Map)-import qualified Data.Map  as Map-import           Data.Time (Day, TimeOfDay, ZonedTime (..))----data YamlExpression-  = YamlInteger Integer-  | YamlFloat Double-  | YamlBool Bool-  | YamlString String-  | YamlDate Day-  | YamlTime TimeOfDay-  | YamlDateTime ZonedTime-  | YamlList CollectionType [YamlExpression]-  | YamlMap CollectionType (Map String YamlExpression)-  | YamlNull-  deriving (Eq, Ord)--data CollectionType-  = Standard-  | Inline-  deriving (Eq, Ord)---instance Show YamlExpression where-  show = \case-    YamlNull                   -> "null"-    YamlInteger n              -> show n-    YamlFloat n                -> show n-    YamlBool bool              -> toLower <$> show bool-    YamlDate date              -> show date-    YamlTime time              -> show time-    YamlDateTime dateTime      -> show dateTime-    YamlString str             -> showStr str-    YamlList Standard list     -> stringify "\n" "\n" "" 2 $ ("- " ++) . show <$> list-    YamlMap  Standard mapping  -> stringify "\n" "\n" "" 2 $ showMap ": " id show mapping--    YamlList Inline   list     -> stringify (", " ++ sep) ("[ " ++ sep) (" ]" ++ sep) n $ show <$> list where-      (sep, n) = if (length . mconcat) (show <$> list) >= 80 then ("\n", 2) else ("", 0)--    YamlMap  Inline   mapping  -> stringify (", " ++ sep) ("{ " ++ sep) (" }" ++ sep) n $-                                    showMap ": " id show mapping where-      (sep, n) = if (length . mconcat) (show <$> Map.toList mapping) >= 80 then ("\n", 2) else ("", 0)----showStr :: String -> String-showStr str = (if (length (lines str) > 1) && not (any (`elem` str) forbiddenChar)-                    then "| \n"-                    else if length (lines str) > 1 then "\n"-                    else "") ++--                   (if not $ any (`elem` str) forbiddenChar  then str-                   else if '"' `elem` str  then "'"  ++ indented 3 ++ "'"-                   else                         "\"" ++ indented 3) ++ "\""  where--  indented n = head (lines str) ++-               mconcat ((("\n" ++ replicate n ' ') ++) <$> tail (lines str))--  forbiddenChar = ['#', '&', '*', ',', '?', '-', ':', '[', ']', '{', '}'] ++-                  ['>', '|', ':', '!']

@@ -1,5 +0,0 @@-module Utils.Applicative where---extract :: Applicative m => m a1 -> m a2 -> m b -> m b-extract start end inner = start *> inner <* end

@@ -1,18 +0,0 @@-{-# OPTIONS_GHC -fno-warn-orphans #-}--module Utils.DateTime where--import Data.Time (LocalTime (..), ZonedTime (..))---instance Eq ZonedTime where-  (==) x y = (zonedTimeToLocalTime x == zonedTimeToLocalTime y) &&-             (zonedTimeZone x == zonedTimeZone y)--instance Ord ZonedTime where-  compare x y = compare (zonedTimeToLocalTime x) (zonedTimeToLocalTime y)---showDateTime :: ZonedTime -> String-showDateTime (ZonedTime (LocalTime date time) offset) = show date ++ "T" ++ show time ++-                                    take 3 (show offset) ++ ":" ++ drop 3 (show offset)

@@ -1,22 +0,0 @@-module Utils.Foldable where--import Data.Foldable as Foldable (Foldable (toList))-import Data.List     (intercalate)-import Utils.String  (indent)---hasNone :: Foldable m => m a -> Bool-hasNone = null--hasSome :: Foldable m => m a -> Bool-hasSome = not . hasNone--hasMany :: Foldable m => m a -> Bool-hasMany xs = all hasSome $ [id, tail] <*> [Foldable.toList xs]---stringify :: (Foldable m) => String -> String -> String -> Int -> m String -> String-stringify sep start end n xs = start ++ indent n str ++ end where--  str = intercalate sep list-  list = toList xs

@@ -1,8 +0,0 @@-module Utils.Map where--import Data.Map (Map, elems, keys)---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)

@@ -1,30 +0,0 @@-module Utils.String where-import Data.List (intercalate)---class ToString a where-  toString :: a -> String--instance ToString Char where-  toString = pure--instance ToString Int where-  toString = show--instance ToString Integer where-  toString = show--instance ToString Float where-  toString = show--instance ToString Double where-  toString = show--instance (ToString a, Foldable m) => ToString (m a) where-  toString = concatMap toString----indent :: Int -> String -> String-indent n str = intercalate "\n" $ indentLine <$> lines str where-  indentLine = (concat (replicate n " ") ++)