packages feed

bookhound (empty) → 0.1.0.0

raw patch · 26 files changed

+1614/−0 lines, 26 filesdep +basedep +containersdep +split

Dependencies added: base, containers, split, time

Files

+ README.md view
@@ -0,0 +1,1 @@+# bookhound
+ bookhound.cabal view
@@ -0,0 +1,61 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.34.4.+--+-- see: https://github.com/sol/hpack++name:           bookhound+version:        0.1.0.0+synopsis:       Simple Parser Combinators & Parsers for usual data formats+description:    Please see the README on GitHub at <https://github.com/albertprz/bookhound#readme>+category:       Parsers+homepage:       https://github.com/albertprz/bookhound#readme+bug-reports:    https://github.com/albertprz/bookhound/issues+author:         Alberto Perez Lopez+maintainer:     albertoperez1994@gmail.com+copyright:      2021 Alberto Perez Lopez+license:        LGPL+build-type:     Simple+extra-source-files:+    README.md++source-repository head+  type: git+  location: https://github.com/albertprz/bookhound++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+  other-modules:+      Paths_bookhound+  hs-source-dirs:+      src+  build-depends:+      base >=4.7 && <5+    , containers >=0.6 && <1+    , split >=0.1.2 && <0.2+    , time >=1.9 && <2+  default-language: Haskell2010
+ src/Operations/Finder.hs view
@@ -0,0 +1,85 @@+{-# LANGUAGE PostfixOperators #-}++module Operations.Finder where+++import Parser (runParser)+import ParserCombinators (IsMatch(..), (|*), (<|>))+import Parsers.String (withinSquareBrackets)+import Parsers.Number (unsignedInt)+import Parsers.Char (dot)+import SyntaxTrees.Json(JsExpression(..))+import SyntaxTrees.Yaml (YamlExpression(..))+import SyntaxTrees.Toml (TomlExpression(..))+++import qualified Data.Map as Map+import Data.Maybe (listToMaybe)+import Data.Either (fromRight)++++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 expr = case expr of+    null @ JsNull      -> [("", null)]+    n @ (JsNumber _)   -> [("", n)]+    bool @ (JsBool _)  -> [("", bool)]+    str @ (JsString _) -> [("", str)]+    JsArray arr        -> zip (show <$> [0 .. length arr - 1]) arr+    JsObject obj       -> Map.toList obj+++instance Finder YamlExpression where+  toList expr = case expr of+    null @ YamlNull             -> [("", null)]+    n @ (YamlInteger _)         -> [("", n)]+    n @ (YamlFloat _)           -> [("", n)]+    bool @ (YamlBool _)         -> [("", bool)]+    str @ (YamlString _)        -> [("", str)]+    date @ (YamlDate _)         -> [("", date)]+    time @ (YamlTime _)         -> [("", time)]+    dateTime @ (YamlDateTime _) -> [("", dateTime)]+    YamlList _ arr              -> zip (show <$> [0 .. length arr - 1]) arr+    YamlMap _ obj               -> Map.toList obj+++instance Finder TomlExpression where+  toList expr = case expr of+    null @ TomlNull             -> [("", null)]+    n @ (TomlInteger _)         -> [("", n)]+    n @ (TomlFloat _)           -> [("", n)]+    bool @ (TomlBool _)         -> [("", bool)]+    str @ (TomlString _)        -> [("", str)]+    date @ (TomlDate _)         -> [("", date)]+    time @ (TomlTime _)         -> [("", time)]+    dateTime @ (TomlDateTime _) -> [("", dateTime)]+    TomlArray arr               -> zip (show <$> [0 .. length arr - 1]) arr+    TomlTable _ obj             -> Map.toList obj
+ src/Operations/ToJson.hs view
@@ -0,0 +1,97 @@+{-# LANGUAGE PostfixOperators, FlexibleInstances, IncoherentInstances #-}++module Operations.ToJson where++import SyntaxTrees.Json (JsExpression(..))+import SyntaxTrees.Xml  (XmlExpression(..))+import SyntaxTrees.Yaml (YamlExpression(..))+import SyntaxTrees.Toml  (TomlExpression(..))+import Parsers.Json (json)+import Parsers.String (spacing)+import Parser (Parser(parse), toEither)+import ParserCombinators (IsMatch(..), (<|>), (|*), maybeWithin)++import qualified Data.Map as Map+import Data.Map (Map, elems, mapKeys)+import Data.Either (fromRight)+++class ToJson a where+  toJson :: a -> JsExpression+++instance ToJson XmlExpression where++  toJson XmlExpression { tagName = tag, fields = flds, expressions = exprs }+    | tag == "literal"   = fromRight JsNull . toEither . parse literalParser .+                             head . elems $ flds+    | 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 expr = case expr of+    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 expr = case expr of+    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 JsExpression where+  toJson = id+++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
+ src/Operations/ToXml.hs view
@@ -0,0 +1,43 @@+{-# LANGUAGE PostfixOperators, FlexibleInstances, UndecidableInstances, IncoherentInstances #-}++module Operations.ToXml where++import SyntaxTrees.Xml  (XmlExpression(..), literalExpression)+import SyntaxTrees.Json (JsExpression(..))+import Operations.ToJson (ToJson(..))++import qualified Data.Map as Map+import Data.Char (toLower)+++class ToXml a where+  toXml :: a -> XmlExpression+++instance ToXml XmlExpression where+  toXml = id+++instance ToXml JsExpression where++  toXml x = case x of+    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 elem = XmlExpression { tagName = "elem",+                                       fields = Map.empty,+                                       expressions = [toXml elem] }++    JsObject obj -> XmlExpression "object" Map.empty (keyValueExpr <$> Map.toList obj)  where++      keyValueExpr (key, value) = XmlExpression { tagName = key,+                                                  fields = Map.empty,+                                                  expressions = [toXml value] }+++instance ToJson a => ToXml a where+  toXml = toXml . toJson
+ src/Operations/ToYaml.hs view
@@ -0,0 +1,36 @@+{-# LANGUAGE FlexibleInstances, UndecidableInstances, IncoherentInstances #-}++module Operations.ToYaml where++import SyntaxTrees.Yaml  (YamlExpression(..), CollectionType(..))+import SyntaxTrees.Json (JsExpression(..))+import Operations.ToJson (ToJson(..))+import Parsers.String (spacing)+import Parsers.Number (intLike)+import ParserCombinators ((<|>))+import Parser (Parser(), runParser)++import Data.Char (toLower)+++class ToYaml a where+  toYaml :: a -> YamlExpression+++instance ToYaml YamlExpression where+  toYaml = id+++instance ToYaml JsExpression where++  toYaml x = case x of+    JsNull       -> YamlNull+    JsNumber n   -> either (const (YamlFloat n)) YamlInteger $ runParser intLike $ show n+    JsBool bool  -> YamlBool bool+    JsString str -> YamlString str+    JsArray arr  -> YamlList Standard $ toYaml <$> arr+    JsObject obj -> YamlMap  Standard $ toYaml <$> obj+++instance ToJson a => ToYaml a where+  toYaml = toYaml . toJson
+ src/Parser.hs view
@@ -0,0 +1,121 @@+module Parser where++import Data.Maybe (maybeToList)+import Data.Either (fromRight)++type Input = String++newtype Parser a = P { parse :: Input -> ParseResult a}++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 >" ++ show i ++ "<"+  show (Error (UnexpectedChar c))   = "Unexpected character: " ++ 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 f (Error pe) = Error pe+++instance Functor Parser where+  fmap f (P p) = P (fmap f . p)++instance Applicative Parser where+  pure a = P (`Result` a)+  (<*>) mf ma = mf >>= (\f -> ma >>= (pure . f))++instance Monad Parser where+  (>>=) (P p) f = P (+    \i -> case p i of+      Result i a -> parse (f a) i+      Error pe -> Error pe)+++runParser :: Parser a -> Input -> Either ParseError a+runParser p i = toEither $ parse p i+++toEither :: ParseResult a -> Either ParseError a+toEither result = case result of+  Error pe -> Left pe+  Result input a -> if null input then Right a+                    else               Left $ ExpectedEof input+++char :: Parser Char+char = P parseIt where+  parseIt [] = Error UnexpectedEof+  parseIt (char : rest) = Result rest char+++errorParser :: ParseError -> Parser a+errorParser = P . const . Error+++andThen :: Parser Input -> Parser a -> Parser a+andThen p1 p2 = P (\i -> parse p2 $ fromRight i $ runParser p1 i)+++exactly :: Parser a -> Parser a+exactly (P p) = P (+  \i -> case p i of+    result @ (Result "" _) -> result+    result @ (Result i _)  -> Error $ ExpectedEof i+    error  @ (Error _)     -> error)+++anyOf :: [Parser a] -> Parser a+anyOf [] = errorParser UnexpectedEof+anyOf [x] = x+anyOf ((P p) : rest) = P (+  \i -> case p i of+    result @ (Result _ _) -> result+    error  @ (Error _)    -> parse (anyOf rest) i)+++allOf :: [Parser a] -> Parser a+allOf [] = errorParser UnexpectedEof+allOf [x] = x+allOf ((P p) : rest) = P (+  \i -> case p i of+    result @ (Result _ _) -> parse (allOf rest) i+    error  @ (Error _)    -> error)+++isMatch :: (Char -> Char -> Bool) -> Parser Char -> Char -> Parser Char+isMatch cond parser c1 = do+  c2 <- parser+  let next = if cond c1 c2+             then pure+             else const . errorParser $ UnexpectedChar c2+  next c2+++check :: String -> (a -> Bool) -> Parser a -> Parser a+check condName cond parser = do+  c2 <- parser+  let next = if cond c2+             then pure+             else const . errorParser $ NoMatch condName+  next c2+++except :: Show a => Parser a -> Parser a -> Parser a+except alt (P p) = P (+  \i -> case p i of+    result @ (Result _ a) -> Error $ UnexpectedString (show a)+    error  @ (Error _)    -> parse alt i)
+ src/ParserCombinators.hs view
@@ -0,0 +1,119 @@+{-# LANGUAGE FlexibleInstances, IncoherentInstances, PostfixOperators #-}++module ParserCombinators  where++import Parser (Parser, char, isMatch, check, anyOf, allOf, except)+import Utils.Foldable (hasSome, hasMany)+import Utils.String (ToString(..))+import Utils.Applicative (extract)++import Data.Maybe (listToMaybe, maybeToList)+import Data.List (isInfixOf)+++class IsMatch a where+  is :: a -> Parser a+  isNot :: a -> Parser a+  oneOf :: [a] -> Parser a+  noneOf :: [a] -> Parser a+  inverse :: Parser a -> Parser a++  oneOf xs = anyOf $ is <$> xs+  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 IsMatch Integer where+  is n = read <$> (is . show) n+  isNot n = read <$> (isNot . show) n+  inverse p = read <$> inverse (show <$> p)++instance IsMatch Int where+  is n = read <$> (is . show) n+  isNot n = read <$> (isNot . show) n+  inverse p = read <$> inverse (show <$> p)++instance IsMatch Double where+  is n = read <$> (is . show) n+  isNot n = read <$> (isNot . show) n+  inverse p = read <$> inverse (show <$> p)++++-- Condition combinators+satisfies :: Parser a -> (a -> Bool) -> Parser a+satisfies parser cond = check "satisfies" cond parser++contains :: Eq a => Parser [a] -> [a] -> Parser [a]+contains p str = check "contains" (isInfixOf str) p++notContains :: Eq a => Parser [a] -> [a] -> Parser [a]+notContains p str = check "notContains" (isInfixOf str) p+++-- Frequency combinators+times :: Parser a -> Integer -> Parser [a]+times parser n = sequence $ parser <$ [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 |?)+++-- Parser Binary Operators+(<|>) :: Parser a -> Parser a -> Parser a+(<|>) p1 p2 = anyOf [p1, p2]++(<&>) :: Parser a -> Parser a -> Parser a+(<&>) p1 p2 = allOf [p1, p2]++(<#>) :: Parser a -> Integer -> Parser [a]+(<#>) = times++(>>>) :: (ToString a, ToString b) => Parser a -> Parser b -> Parser String+(>>>) p1 p2 = p1 >>= (\x -> (x ++) <$> (toString <$> p2)) . toString+++-- Parser Unary Operators+(|?) :: Parser a -> Parser (Maybe a)+(|?) = maybeTimes++(|*) :: Parser a -> Parser [a]+(|*) = anyTimes++(|+) :: Parser a -> Parser [a]+(|+) = someTimes++(|++) :: Parser a -> Parser [a]+(|++) = manyTimes
+ src/Parsers/Char.hs view
@@ -0,0 +1,104 @@+module Parsers.Char where++import qualified Parser+import Parser (Parser)+import ParserCombinators (IsMatch(..), (<|>))+import Data.Data (ConstrRep(CharConstr))+++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 '>'
+ src/Parsers/Collections.hs view
@@ -0,0 +1,37 @@+{-# LANGUAGE PostfixOperators #-}++module Parsers.Collections where++import Parser (Parser)+import ParserCombinators (IsMatch(..), (<|>), (|*), (|?), maybeWithin)+import Parsers.Char (colon, comma, openSquare, closeSquare,+                     openParens, closeParens, openCurly, closeCurly)+import Parsers.String(spacing)++import qualified Data.Foldable as Foldable+import qualified Data.Map as Map+import Data.Map(Map)+++collOf :: Parser a -> Parser b -> Parser c -> Parser d -> Parser [d]+collOf sep start end elemParser = do start+                                     elems <- ((maybeWithin spacing $ elemParser <* sep) |*)+                                     elem  <- maybeWithin spacing (elemParser |?)+                                     end+                                     pure (elems ++ Foldable.toList elem)+++listOf :: Parser a -> Parser [a]+listOf = collOf comma openSquare closeSquare++tupleOf :: Parser a -> Parser [a]+tupleOf = collOf comma openParens closeParens++mapOf :: Ord b => Parser a -> Parser b -> Parser c -> Parser (Map b c)+mapOf sep p1 p2 = Map.fromList <$> collOf comma openCurly closeCurly+                               (mapEntryOf p1 p2)  where++  mapEntryOf p1 p2 = do key <- p1+                        maybeWithin spacing sep+                        value <- p2+                        pure (key, value)
+ src/Parsers/DateTime.hs view
@@ -0,0 +1,75 @@+{-# LANGUAGE PostfixOperators #-}++module Parsers.DateTime where++import Parser(Parser(..), check)+import ParserCombinators (IsMatch(..), (<|>), (<#>), (|?), (|*), (|+), within)+import Parsers.Char (digit, dash, colon, plus)++import Data.Time (Day, LocalTime(..), TimeOfDay(..), TimeZone, ZonedTime(..),+                  fromGregorian, minutesToTimeZone)+import Data.Maybe (fromMaybe)+++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 |+)++++date :: Parser Day+date = do y <- year+          m <- within dash month+          d <- day+          pure $ fromGregorian y m d+++time :: Parser TimeOfDay+time = do h <- hour+          min <- colon *> minute+          s <- colon *> second+          decimals <- fromMaybe (toInteger 0) <$> ((colon *> secondDecimals) |?)+          pure $ TimeOfDay h min $ read (show s ++ "." ++ show decimals)+++timeZoneOffset :: Parser TimeZone+timeZoneOffset = do pos <- (True <$ plus) <|> (False <$ dash)+                    h <- hour+                    min <- fromMaybe 0 <$> ((colon *> minute) |?)+                    pure $ minutesToTimeZone $ (if pos then 1 else (-1)) * (h * 60 + min)++localDateTime :: Parser LocalTime+localDateTime = do d <- date+                   oneOf ['T', 't']+                   t <- time+                   pure $ LocalTime d t++offsetDateTime :: Parser ZonedTime+offsetDateTime = do localTime <- localDateTime+                    offset    <- timeZoneOffset+                    pure $ ZonedTime localTime offset++dateTime :: Parser ZonedTime+dateTime = ((`ZonedTime` minutesToTimeZone 0) <$> localDateTime <* is 'Z') <|>+            offsetDateTime+++range :: Ord a => a -> a -> a -> Bool+range min max x = x >= min && x <= max
+ src/Parsers/Json.hs view
@@ -0,0 +1,53 @@+{-# LANGUAGE PostfixOperators #-}++module Parsers.Json (json, nil, number, bool, string, array, object) where++import Parser(Parser(parse), exactly)+import ParserCombinators (IsMatch(..), (<|>), (>>>), (|*), (|?), maybeWithin)+import Parsers.Number (double)+import Parsers.Collections (listOf, mapOf)+import Parsers.Char (char, doubleQuote, colon)+import Parsers.String (withinDoubleQuotes, spacing)+import SyntaxTrees.Json (JsExpression(..))++++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 = exactly number <|> exactly bool <|> exactly nil <|> exactly string++container :: Parser JsExpression+container = array <|> object+++json :: Parser JsExpression+json = maybeWithin spacing jsValue where++  jsValue = element <|> container+++text :: Parser String+text = withinDoubleQuotes (inverse doubleQuote |*)
+ src/Parsers/Number.hs view
@@ -0,0 +1,45 @@+{-# LANGUAGE PostfixOperators #-}++module Parsers.Number where++import Parser (Parser, errorParser, ParseError(..))+import ParserCombinators (IsMatch(..), (>>>), (<|>), (|*), (|+), (|?))+import Parsers.Char (digit, dot, dash, 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 |?) >>> (exp |?) where++  decimals = dot >>> unsignedInt+  exp      = oneOf ['e', 'E'] >>> int
+ src/Parsers/String.hs view
@@ -0,0 +1,75 @@+{-# LANGUAGE PostfixOperators #-}++module Parsers.String where++import Parser (Parser)+import ParserCombinators (IsMatch(..), (|*), (|+), (|?), (<|>), (>>>), within, withinBoth)+import Parsers.Char+++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
+ src/Parsers/Toml.hs view
@@ -0,0 +1,124 @@+{-# LANGUAGE PostfixOperators #-}++module Parsers.Toml (toml, nil, integer, float, bool, string, array, inlineTable) where++import Parser(Parser(..), ParseError(..), errorParser, check, andThen, exactly)+import ParserCombinators (IsMatch(..), (<|>), (>>>), (<#>), (|?), (|*), (|+),+                          maybeWithin, within)+import Parsers.Number (double, hexInt, int, octInt)+import Parsers.String (blankLine, withinQuotes, withinDoubleQuotes,+                       spacesOrTabs, spaces, withinSquareBrackets, spacing, blankLines)+import Parsers.Char (quote, doubleQuote, whiteSpace, hashTag, space, newLine,+                     dot, digit, letter, underscore, dash, equal, spaceOrTab)+import SyntaxTrees.Toml (TomlExpression(..), TableType(..))+import Parsers.Collections (mapOf, listOf)+import qualified Parsers.DateTime as Dt++import qualified Data.Map as Map+import Data.Map (Map)+import Data.Maybe (maybeToList)+++-- TODO: Add support for anchors and aliases++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+++toml :: Parser TomlExpression+toml = maybeWithin (((pure <$> whiteSpace) <|> comment) |+) topLevelTable
+ src/Parsers/Xml.hs view
@@ -0,0 +1,63 @@+{-# LANGUAGE PostfixOperators #-}++module Parsers.Xml (xml, branchExpr, leafExpr, literal) where++import Parser (Parser)+import ParserCombinators (IsMatch(..), (<|>), (>>>), (|*), (|+), maybeWithin)+import Parsers.Number (double)+import Parsers.Char (space, doubleQuote)+import Parsers.String (withinDoubleQuotes, withinAngleBrackets, spacing)+import SyntaxTrees.Xml ( XmlExpression(..), literalExpression )++import qualified Data.Map as Map+import Data.Map(Map)++++field :: Parser (String, String)+field = do x <- text+           is '='+           y <- quotedText+           pure (x, y) 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 "-->"++++xml :: Parser XmlExpression+xml = maybeWithin  ((header <|> comment) |+) $+        maybeWithin spacing $ branchExpr <|> leafExpr+++text :: Parser String+text = (noneOf ['/', '>', ' ', '='] |+)
+ src/Parsers/Yaml.hs view
@@ -0,0 +1,197 @@+{-# LANGUAGE PostfixOperators #-}++module Parsers.Yaml (yaml, nil, integer, float, bool, string, list, mapping) where+++import SyntaxTrees.Yaml (YamlExpression(..), CollectionType(..))+import Parser(Parser(..), ParseError(..), errorParser, check, andThen, exactly)+import ParserCombinators (IsMatch(..), (<|>), (<#>), (>>>), (|?), (|*), (|+), (|++), maybeWithin)+import Parsers.Number (double, hexInt, int, octInt)+import Parsers.String (spaces, spacesOrTabs, withinDoubleQuotes, withinQuotes,+                        blankLine, blankLines, tabs)+import Parsers.Char (colon, dash, space, whiteSpace, newLine, question, dot, hashTag,+                     quote, doubleQuote, char)+import Parsers.Collections (mapOf, listOf)+import qualified Parsers.DateTime as Dt++import qualified Data.Map as Map+import Data.Map (Map)+import Data.List (nub)+++-- TODO: Add support for table arrays++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+                  elem <- yamlWithIndent n+                  pure (n, elem)+++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++++yaml :: Parser YamlExpression+yaml =  normalize `andThen` yamlWithIndent (-1)++++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)
+ src/SyntaxTrees/Json.hs view
@@ -0,0 +1,27 @@+{-# LANGUAGE PostfixOperators, TupleSections #-}++module SyntaxTrees.Json where++import Utils.Foldable (stringify)+import Utils.Map (showMap)++import Data.Map (Map)+import Data.Char (toLower)++++data JsExpression = JsNumber Double | JsBool Bool |+                    JsString String |+                    JsArray [JsExpression] |+                    JsObject (Map String JsExpression) |+                    JsNull deriving (Eq, Ord)+++instance Show JsExpression where+  show expr = case expr of+    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
+ src/SyntaxTrees/Toml.hs view
@@ -0,0 +1,47 @@+module SyntaxTrees.Toml where++import Utils.DateTime (showDateTime)+import Utils.Foldable (stringify)+import Utils.Map (showMap)++import Data.Map (Map, keys, elems)+import qualified Data.Map as Map+import Data.Time (Day, TimeOfDay, ZonedTime(..), LocalTime(..))+import Data.Char (toLower)++++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 expr = case expr of+    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)
+ src/SyntaxTrees/Xml.hs view
@@ -0,0 +1,57 @@+{-# LANGUAGE NamedFieldPuns #-}++module SyntaxTrees.Xml where++import Utils.Foldable (stringify)++import Data.Map (Map, keys, elems)+import qualified Data.Map as Map+import Data.Maybe (listToMaybe)+++data XmlExpression = XmlExpression {+    tagName     :: String+  , fields      :: Map String String+  , expressions :: [XmlExpression]+  } deriving (Eq, Ord)+++instance Show XmlExpression where++  show XmlExpression { tagName = tag, fields, expressions }+    | tag == "literal"  = head . elems $ fields+    | otherwise         = "<" ++ tag ++ flds ++ innerExprs   where++        innerExprs = if null expressions then "/>"+                     else                     ">"  ++ ending++        (sep, n) = if (tagName . head) expressions == "literal" then ("", 0)+                   else                                              ("\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
+ src/SyntaxTrees/Yaml.hs view
@@ -0,0 +1,61 @@+module SyntaxTrees.Yaml (YamlExpression(..), CollectionType(..)) where++import Utils.DateTime (showDateTime)+import Utils.Foldable (stringify)+import Utils.Map (showMap)++import Data.Map (Map)+import qualified Data.Map as Map+import Data.Char (toLower)+import Data.Time (Day, TimeOfDay, ZonedTime(..), LocalTime(..))++++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 expr = case expr of+    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 str 3 ++ "'"+                   else                         "\"" ++ indented str 3) ++ "\""  where++  indented str n = head (lines str) +++                    mconcat ((("\n" ++ replicate n ' ') ++) <$> tail (lines str))++  forbiddenChar = ['#', '&', '*', ',', '?', '-', ':', '[', ']', '{', '}'] +++                  ['>', '|', ':', '!']
+ src/Utils/Applicative.hs view
@@ -0,0 +1,5 @@+module Utils.Applicative where+++extract :: Applicative m => m a1 -> m a2 -> m b -> m b+extract start end inner = start *> inner <* end
+ src/Utils/DateTime.hs view
@@ -0,0 +1,16 @@+module Utils.DateTime where++import Data.Time (ZonedTime(..), LocalTime(..))+++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)
+ src/Utils/Foldable.hs view
@@ -0,0 +1,22 @@+module Utils.Foldable where++import Utils.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
+ src/Utils/Map.hs view
@@ -0,0 +1,8 @@+module Utils.Map where++import Data.Map (Map, keys, elems)+++showMap :: Show a => String -> (String -> String) -> (a -> String) -> Map String a -> [String]+showMap sep showKey showValue mapping = (\(k, v) -> showKey k ++ sep ++ showValue v) <$> tuples where+  tuples = zip (keys mapping) (elems mapping)
+ src/Utils/String.hs view
@@ -0,0 +1,35 @@+{-# LANGUAGE  FlexibleInstances, UndecidableInstances, IncoherentInstances  #-}++module Utils.String where+import Data.List (intercalate)+++class ToString a where+  toString :: a -> String++instance ToString String where+  toString = id++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 n <$> lines str where+  indentLine n = (concat (replicate n " ") ++)