{-# 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)
nil :: Parser YamlExpression
nil :: Parser YamlExpression
nil = YamlExpression
YamlNull YamlExpression -> Parser [Char] -> Parser YamlExpression
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [[Char]] -> Parser [Char]
forall a. IsMatch a => [a] -> Parser a
oneOf [[Char]
"null", [Char]
"Null", [Char]
"NULL"]
integer :: Parser YamlExpression
integer :: Parser YamlExpression
integer = Integer -> YamlExpression
YamlInteger (Integer -> YamlExpression)
-> Parser Integer -> Parser YamlExpression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser Integer
hexInt Parser Integer -> Parser Integer -> Parser Integer
forall a. Parser a -> Parser a -> Parser a
<|> Parser Integer
octInt Parser Integer -> Parser Integer -> Parser Integer
forall a. Parser a -> Parser a -> Parser a
<|> Parser Integer
int)
float :: Parser YamlExpression
float :: Parser YamlExpression
float = Double -> YamlExpression
YamlFloat (Double -> YamlExpression)
-> Parser Double -> Parser YamlExpression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Double
double
bool :: Parser YamlExpression
bool :: Parser YamlExpression
bool = Bool -> YamlExpression
YamlBool (Bool -> YamlExpression) -> Parser Bool -> Parser YamlExpression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Bool
True Bool -> Parser [Char] -> Parser Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [[Char]] -> Parser [Char]
forall a. IsMatch a => [a] -> Parser a
oneOf [[Char]
"true", [Char]
"True", [Char]
"TRUE"]) Parser Bool -> Parser Bool -> Parser Bool
forall a. Parser a -> Parser a -> Parser a
<|>
(Bool
False Bool -> Parser [Char] -> Parser Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [[Char]] -> Parser [Char]
forall a. IsMatch a => [a] -> Parser a
oneOf [[Char]
"false", [Char]
"False", [Char]
"FALSE"])
dateTime :: Parser YamlExpression
dateTime :: Parser YamlExpression
dateTime = ZonedTime -> YamlExpression
YamlDateTime (ZonedTime -> YamlExpression)
-> Parser ZonedTime -> Parser YamlExpression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ZonedTime
Dt.dateTime
date :: Parser YamlExpression
date :: Parser YamlExpression
date = Day -> YamlExpression
YamlDate (Day -> YamlExpression) -> Parser Day -> Parser YamlExpression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Day
Dt.date
time :: Parser YamlExpression
time :: Parser YamlExpression
time = TimeOfDay -> YamlExpression
YamlTime (TimeOfDay -> YamlExpression)
-> Parser TimeOfDay -> Parser YamlExpression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser TimeOfDay
Dt.time
string :: Int -> Parser YamlExpression
string :: Int -> Parser YamlExpression
string Int
indent = [Char] -> YamlExpression
YamlString ([Char] -> YamlExpression)
-> Parser [Char] -> Parser YamlExpression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Parser [Char]
text Int
indent
sequential :: Parser a -> Int -> Parser [YamlExpression]
sequential :: Parser a -> Int -> Parser [YamlExpression]
sequential Parser a
sep Int
indent = Parser [YamlExpression]
listParser where
listParser :: Parser [YamlExpression]
listParser = Parser (Int, YamlExpression) -> Int -> Parser [YamlExpression]
forall a. Parser (Int, a) -> Int -> Parser [a]
indentationCheck Parser (Int, YamlExpression)
elemParser Int
indent
elemParser :: Parser (Int, YamlExpression)
elemParser = do Int
n <- [Char] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Char] -> Int) -> Parser [Char] -> Parser Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser Char
space Parser Char -> Parser [Char]
forall a. Parser a -> Parser [a]
|*)
Parser a
sep Parser a -> Parser Char -> Parser Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Char
whiteSpace
YamlExpression
elem <- Int -> Parser YamlExpression
yamlWithIndent Int
n
(Int, YamlExpression) -> Parser (Int, YamlExpression)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
n, YamlExpression
elem)
list :: Int -> Parser YamlExpression
list :: Int -> Parser YamlExpression
list Int
indent = (CollectionType -> [YamlExpression] -> YamlExpression
YamlList CollectionType
Inline ([YamlExpression] -> YamlExpression)
-> Parser [YamlExpression] -> Parser YamlExpression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser [YamlExpression]
jsonList) Parser YamlExpression
-> Parser YamlExpression -> Parser YamlExpression
forall a. Parser a -> Parser a -> Parser a
<|>
(CollectionType -> [YamlExpression] -> YamlExpression
YamlList CollectionType
Standard ([YamlExpression] -> YamlExpression)
-> Parser [YamlExpression] -> Parser YamlExpression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser [YamlExpression]
yamlList) where
yamlList :: Parser [YamlExpression]
yamlList = Parser Char -> Int -> Parser [YamlExpression]
forall a. Parser a -> Int -> Parser [YamlExpression]
sequential Parser Char
dash Int
indent
jsonList :: Parser [YamlExpression]
jsonList = Parser [Char] -> Parser [YamlExpression] -> Parser [YamlExpression]
forall a b. Parser a -> Parser b -> Parser b
maybeWithin Parser [Char]
spacesOrTabs (Parser [YamlExpression] -> Parser [YamlExpression])
-> Parser [YamlExpression] -> Parser [YamlExpression]
forall a b. (a -> b) -> a -> b
$ Parser YamlExpression -> Parser [YamlExpression]
forall a. Parser a -> Parser [a]
listOf (Parser YamlExpression -> Parser [YamlExpression])
-> Parser YamlExpression -> Parser [YamlExpression]
forall a b. (a -> b) -> a -> b
$ Int -> Parser YamlExpression
yamlWithIndent (-Int
1)
set :: Int -> Parser YamlExpression
set :: Int -> Parser YamlExpression
set Int
indent = CollectionType -> [YamlExpression] -> YamlExpression
YamlList CollectionType
Standard ([YamlExpression] -> YamlExpression)
-> ([YamlExpression] -> [YamlExpression])
-> [YamlExpression]
-> YamlExpression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [YamlExpression] -> [YamlExpression]
forall a. Eq a => [a] -> [a]
nub ([YamlExpression] -> YamlExpression)
-> Parser [YamlExpression] -> Parser YamlExpression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Char -> Int -> Parser [YamlExpression]
forall a. Parser a -> Int -> Parser [YamlExpression]
sequential Parser Char
question Int
indent
mapping :: Int -> Parser YamlExpression
mapping :: Int -> Parser YamlExpression
mapping Int
indent = (CollectionType -> Map [Char] YamlExpression -> YamlExpression
YamlMap CollectionType
Inline (Map [Char] YamlExpression -> YamlExpression)
-> Parser (Map [Char] YamlExpression) -> Parser YamlExpression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Map [Char] YamlExpression)
jsonMap) Parser YamlExpression
-> Parser YamlExpression -> Parser YamlExpression
forall a. Parser a -> Parser a -> Parser a
<|>
(CollectionType -> Map [Char] YamlExpression -> YamlExpression
YamlMap CollectionType
Standard (Map [Char] YamlExpression -> YamlExpression)
-> Parser (Map [Char] YamlExpression) -> Parser YamlExpression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Map [Char] YamlExpression)
yamlMap) where
yamlMap :: Parser (Map [Char] YamlExpression)
yamlMap = [([Char], YamlExpression)] -> Map [Char] YamlExpression
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([([Char], YamlExpression)] -> Map [Char] YamlExpression)
-> Parser [([Char], YamlExpression)]
-> Parser (Map [Char] YamlExpression)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser [([Char], YamlExpression)]
mapParser
jsonMap :: Parser (Map [Char] YamlExpression)
jsonMap = Parser [Char]
-> Parser (Map [Char] YamlExpression)
-> Parser (Map [Char] YamlExpression)
forall a b. Parser a -> Parser b -> Parser b
maybeWithin Parser [Char]
spacesOrTabs (Parser (Map [Char] YamlExpression)
-> Parser (Map [Char] YamlExpression))
-> Parser (Map [Char] YamlExpression)
-> Parser (Map [Char] YamlExpression)
forall a b. (a -> b) -> a -> b
$ Parser Char
-> Parser [Char]
-> Parser YamlExpression
-> Parser (Map [Char] YamlExpression)
forall b a c.
Ord b =>
Parser a -> Parser b -> Parser c -> Parser (Map b c)
mapOf Parser Char
colon (Int -> Parser [Char]
text Int
100) (Parser YamlExpression -> Parser (Map [Char] YamlExpression))
-> Parser YamlExpression -> Parser (Map [Char] YamlExpression)
forall a b. (a -> b) -> a -> b
$ Int -> Parser YamlExpression
yamlWithIndent (-Int
1)
mapParser :: Parser [([Char], YamlExpression)]
mapParser = Parser (Int, ([Char], YamlExpression))
-> Int -> Parser [([Char], YamlExpression)]
forall a. Parser (Int, a) -> Int -> Parser [a]
indentationCheck Parser (Int, ([Char], YamlExpression))
keyValueParser Int
indent
keyValueParser :: Parser (Int, ([Char], YamlExpression))
keyValueParser = do Int
n <- [Char] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Char] -> Int) -> Parser [Char] -> Parser Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser Char
space Parser Char -> Parser [Char]
forall a. Parser a -> Parser [a]
|*)
[Char]
key <- YamlExpression -> [Char]
forall a. Show a => a -> [Char]
show (YamlExpression -> [Char])
-> Parser YamlExpression -> Parser [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Parser YamlExpression
element Int
indent
(Parser [Char]
spacesOrTabs Parser [Char] -> Parser (Maybe [Char])
forall a. Parser a -> Parser (Maybe a)
|?)
Parser Char
colon Parser Char -> Parser Char -> Parser Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Char
whiteSpace
YamlExpression
value <- Int -> Parser YamlExpression
yamlWithIndent Int
n
(Int, ([Char], YamlExpression))
-> Parser (Int, ([Char], YamlExpression))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
n, ([Char]
key, YamlExpression
value))
element :: Int -> Parser YamlExpression
element :: Int -> Parser YamlExpression
element Int
indent = Parser YamlExpression -> Parser YamlExpression
forall a. Parser a -> Parser a
exactly (Parser YamlExpression
dateTime Parser YamlExpression
-> Parser YamlExpression -> Parser YamlExpression
forall a. Parser a -> Parser a -> Parser a
<|> Parser YamlExpression
date Parser YamlExpression
-> Parser YamlExpression -> Parser YamlExpression
forall a. Parser a -> Parser a -> Parser a
<|> Parser YamlExpression
time Parser YamlExpression
-> Parser YamlExpression -> Parser YamlExpression
forall a. Parser a -> Parser a -> Parser a
<|> Parser YamlExpression
float Parser YamlExpression
-> Parser YamlExpression -> Parser YamlExpression
forall a. Parser a -> Parser a -> Parser a
<|>
Parser YamlExpression
integer Parser YamlExpression
-> Parser YamlExpression -> Parser YamlExpression
forall a. Parser a -> Parser a -> Parser a
<|> Parser YamlExpression
bool Parser YamlExpression
-> Parser YamlExpression -> Parser YamlExpression
forall a. Parser a -> Parser a -> Parser a
<|> Parser YamlExpression
nil) Parser YamlExpression
-> Parser YamlExpression -> Parser YamlExpression
forall a. Parser a -> Parser a -> Parser a
<|>
Int -> Parser YamlExpression
string Int
indent
container :: Int -> Parser YamlExpression
container :: Int -> Parser YamlExpression
container Int
indent = Int -> Parser YamlExpression
list Int
indent Parser YamlExpression
-> Parser YamlExpression -> Parser YamlExpression
forall a. Parser a -> Parser a -> Parser a
<|> Int -> Parser YamlExpression
mapping Int
indent Parser YamlExpression
-> Parser YamlExpression -> Parser YamlExpression
forall a. Parser a -> Parser a -> Parser a
<|> Int -> Parser YamlExpression
set Int
indent
yamlWithIndent :: Int -> Parser YamlExpression
yamlWithIndent :: Int -> Parser YamlExpression
yamlWithIndent Int
indent = Parser [[Char]] -> Parser YamlExpression -> Parser YamlExpression
forall a b. Parser a -> Parser b -> Parser b
maybeWithin ((Parser [Char]
blankLine Parser [Char] -> Parser [Char] -> Parser [Char]
forall a. Parser a -> Parser a -> Parser a
<|> Parser [Char]
comment Parser [Char] -> Parser [Char] -> Parser [Char]
forall a. Parser a -> Parser a -> Parser a
<|> Parser [Char]
directive Parser [Char] -> Parser [Char] -> Parser [Char]
forall a. Parser a -> Parser a -> Parser a
<|>
Parser [Char]
docStart Parser [Char] -> Parser [Char] -> Parser [Char]
forall a. Parser a -> Parser a -> Parser a
<|> Parser [Char]
docEnd) Parser [Char] -> Parser [[Char]]
forall a. Parser a -> Parser [a]
|+)
Parser YamlExpression
yamlValue where
yamlValue :: Parser YamlExpression
yamlValue = Int -> Parser YamlExpression
container Int
indent Parser YamlExpression
-> Parser YamlExpression -> Parser YamlExpression
forall a. Parser a -> Parser a -> Parser a
<|> Parser [Char] -> Parser YamlExpression -> Parser YamlExpression
forall a b. Parser a -> Parser b -> Parser b
maybeWithin Parser [Char]
spacesOrTabs (Int -> Parser YamlExpression
element Int
indent)
comment :: Parser [Char]
comment = Parser Char
hashTag Parser Char -> Parser [Char] -> Parser [Char]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Parser Char -> Parser Char
forall a. IsMatch a => Parser a -> Parser a
inverse Parser Char
newLine Parser Char -> Parser [Char]
forall a. Parser a -> Parser [a]
|+) Parser [Char] -> Parser Char -> Parser [Char]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Char
newLine
directive :: Parser [Char]
directive = [Char] -> Parser [Char]
forall a. IsMatch a => a -> Parser a
is [Char]
"%" Parser [Char] -> Parser [Char] -> Parser [Char]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Parser Char -> Parser Char
forall a. IsMatch a => Parser a -> Parser a
inverse Parser Char
space Parser Char -> Parser [Char] -> Parser [Char]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Parser Char -> Parser Char
forall a. IsMatch a => Parser a -> Parser a
inverse Parser Char
newLine Parser Char -> Parser [Char]
forall a. Parser a -> Parser [a]
|+)) Parser [Char] -> Parser Char -> Parser [Char]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Char
newLine
docStart :: Parser [Char]
docStart = Parser Char
dash Parser Char -> Integer -> Parser [Char]
forall a. Parser a -> Integer -> Parser [a]
<#> Integer
3
docEnd :: Parser [Char]
docEnd = Parser Char
dot Parser Char -> Integer -> Parser [Char]
forall a. Parser a -> Integer -> Parser [a]
<#> Integer
3
yaml :: Parser YamlExpression
yaml :: Parser YamlExpression
yaml = Parser [Char]
normalize Parser [Char] -> Parser YamlExpression -> Parser YamlExpression
forall a. Parser [Char] -> Parser a -> Parser a
`andThen` Int -> Parser YamlExpression
yamlWithIndent (-Int
1)
text :: Int -> Parser String
text :: Int -> Parser [Char]
text Int
indent = Parser [Char] -> Parser [Char]
forall a. Parser a -> Parser a
withinDoubleQuotes (Parser [Char] -> Parser [Char]
quotedParser (Parser Char -> Parser Char
forall a. IsMatch a => Parser a -> Parser a
inverse Parser Char
doubleQuote Parser Char -> Parser [Char]
forall a. Parser a -> Parser [a]
|*)) Parser [Char] -> Parser [Char] -> Parser [Char]
forall a. Parser a -> Parser a -> Parser a
<|>
Parser [Char] -> Parser [Char]
forall a. Parser a -> Parser a
withinQuotes (Parser [Char] -> Parser [Char]
quotedParser (Parser Char -> Parser Char
forall a. IsMatch a => Parser a -> Parser a
inverse Parser Char
quote Parser Char -> Parser [Char]
forall a. Parser a -> Parser [a]
|*)) Parser [Char] -> Parser [Char] -> Parser [Char]
forall a. Parser a -> Parser a -> Parser a
<|>
([Char] -> Parser [Char]
forall a. IsMatch a => a -> Parser a
is [Char]
"|" Parser [Char] -> Parser [Char] -> Parser [Char]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser [Char]
blankLine Parser [Char] -> Parser [Char] -> Parser [Char]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Parser [Char] -> Parser (Int, [Char])) -> Parser [Char]
forall a.
ToString a =>
(Parser [Char] -> Parser (Int, a)) -> Parser [Char]
plainTextParser Parser [Char] -> Parser (Int, [Char])
literalLineParser) Parser [Char] -> Parser [Char] -> Parser [Char]
forall a. Parser a -> Parser a -> Parser a
<|>
([Char] -> Parser [Char]
forall a. IsMatch a => a -> Parser a
is [Char]
">" Parser [Char] -> Parser [Char] -> Parser [Char]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser [Char]
blankLine Parser [Char] -> Parser (Maybe [Char]) -> Parser (Maybe [Char])
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Parser [Char]
spacesOrTabs Parser [Char] -> Parser (Maybe [Char])
forall a. Parser a -> Parser (Maybe a)
|?) Parser (Maybe [Char]) -> Parser [Char] -> Parser [Char]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Parser [Char] -> Parser (Int, [Char])) -> Parser [Char]
forall a.
ToString a =>
(Parser [Char] -> Parser (Int, a)) -> Parser [Char]
plainTextParser Parser [Char] -> Parser (Int, [Char])
foldingLineParser) Parser [Char] -> Parser [Char] -> Parser [Char]
forall a. Parser a -> Parser a -> Parser a
<|>
(Parser [Char] -> Parser (Int, [Char])) -> Parser [Char]
forall a.
ToString a =>
(Parser [Char] -> Parser (Int, a)) -> Parser [Char]
plainTextParser Parser [Char] -> Parser (Int, [Char])
foldingLineParser
where
quotedParser :: Parser [Char] -> Parser [Char]
quotedParser Parser [Char]
parser = [[Char]] -> [Char]
forall a. Monoid a => [a] -> a
mconcat ([[Char]] -> [Char]) -> Parser [[Char]] -> Parser [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (((Int, [Char]) -> [Char]
forall a b. (a, b) -> b
snd ((Int, [Char]) -> [Char]) -> Parser (Int, [Char]) -> Parser [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser [Char] -> Parser (Int, [Char])
foldingLineParser Parser [Char]
parser) Parser [Char] -> Parser [[Char]]
forall a. Parser a -> Parser [a]
|*)
plainTextParser :: (Parser [Char] -> Parser (Int, a)) -> Parser [Char]
plainTextParser Parser [Char] -> Parser (Int, a)
styleParser = Parser Char
allowedStart Parser Char -> Parser [Char] -> Parser [Char]
forall a b.
(ToString a, ToString b) =>
Parser a -> Parser b -> Parser [Char]
>>> Parser [Char]
allowedString Parser [Char] -> Parser [[a]] -> Parser [Char]
forall a b.
(ToString a, ToString b) =>
Parser a -> Parser b -> Parser [Char]
>>>
(Parser (Int, a) -> Int -> Parser [a]
forall a. Parser (Int, a) -> Int -> Parser [a]
indentationCheck (Parser [Char] -> Parser (Int, a)
styleParser Parser [Char]
allowedString) Int
indent Parser [a] -> Parser [[a]]
forall a. Parser a -> Parser [a]
|*)
foldingLineParser :: Parser [Char] -> Parser (Int, [Char])
foldingLineParser Parser [Char]
parser = do [Char]
sep <- ([Char]
"\n" [Char] -> Parser Char -> Parser [Char]
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser Char
newLine Parser [Char] -> Parser [Char] -> Parser [Char]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser [Char]
blankLines) Parser [Char] -> Parser [Char] -> Parser [Char]
forall a. Parser a -> Parser a -> Parser a
<|> ([Char]
" " [Char] -> Parser Char -> Parser [Char]
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser Char
newLine)
Int
n <- Parser [Char] -> Parser Int -> Parser Int
forall a b. Parser a -> Parser b -> Parser b
maybeWithin Parser [Char]
tabs (Parser Int -> Parser Int) -> Parser Int -> Parser Int
forall a b. (a -> b) -> a -> b
$ [Char] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Char] -> Int) -> Parser [Char] -> Parser Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser Char
space Parser Char -> Parser [Char]
forall a. Parser a -> Parser [a]
|*)
[Char]
str <- Parser [Char]
parser
(Int, [Char]) -> Parser (Int, [Char])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
n, [Char]
sep [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
str)
literalLineParser :: Parser [Char] -> Parser (Int, [Char])
literalLineParser Parser [Char]
parser = do [Char]
sep <- Char -> [Char]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Char -> [Char]) -> Parser Char -> Parser [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Char
newLine
Int
n <- [Char] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Char] -> Int) -> Parser [Char] -> Parser Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser Char
space Parser Char -> Parser [Char]
forall a. Parser a -> Parser [a]
|*)
[Char]
str <- Parser [Char]
parser
(Int, [Char]) -> Parser (Int, [Char])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
n, [Char]
sep [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
indent) Char
' ' [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
str)
allowedStart :: Parser Char
allowedStart = [Char] -> Parser Char
forall a. IsMatch a => [a] -> Parser a
noneOf ([Char] -> Parser Char) -> [Char] -> Parser Char
forall a b. (a -> b) -> a -> b
$ [Char]
forbiddenChar [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char
'>', Char
'|', Char
':', Char
'!']
allowedString :: Parser [Char]
allowedString = ([Char] -> Parser Char
forall a. IsMatch a => [a] -> Parser a
noneOf [Char]
forbiddenChar Parser Char -> Parser [Char]
forall a. Parser a -> Parser [a]
|*)
forbiddenChar :: [Char]
forbiddenChar = [Char
'\n', Char
'#', Char
'&', Char
'*', Char
',', Char
'?', Char
'-', Char
':', Char
'[', Char
']', Char
'{', Char
'}']
indentationCheck :: Parser (Int, a) -> Int -> Parser [a]
indentationCheck :: Parser (Int, a) -> Int -> Parser [a]
indentationCheck Parser (Int, a)
parser Int
indent = (((Int, a) -> a
forall a b. (a, b) -> b
snd ((Int, a) -> a) -> Parser (Int, a) -> Parser a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> ((Int, a) -> Bool) -> Parser (Int, a) -> Parser (Int, a)
forall a. [Char] -> (a -> Bool) -> Parser a -> Parser a
check [Char]
"indentation"
(\(Int
n, a
_) -> Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
indent) Parser (Int, a)
parser) Parser a -> Parser [a]
forall a. Parser a -> Parser [a]
|+)
normalize :: Parser String
normalize :: Parser [Char]
normalize = (Parser [Char]
parserActions Parser [Char] -> Parser [Char] -> Parser [Char]
forall a b.
(ToString a, ToString b) =>
Parser a -> Parser b -> Parser [Char]
>>> Parser [Char]
normalize) Parser [Char] -> Parser [Char] -> Parser [Char]
forall a. Parser a -> Parser a -> Parser a
<|> (Parser Char
char Parser Char -> Parser [Char]
forall a. Parser a -> Parser [a]
|*) where
parserActions :: Parser [Char]
parserActions = Parser [Char]
spreadDashes Parser [Char] -> Parser [Char] -> Parser [Char]
forall a. Parser a -> Parser a -> Parser a
<|>
Parser [Char]
spreadDashKey Parser [Char] -> Parser [Char] -> Parser [Char]
forall a. Parser a -> Parser a -> Parser a
<|>
Parser [Char]
spreadKeyDash Parser [Char] -> Parser [Char] -> Parser [Char]
forall a. Parser a -> Parser a -> Parser a
<|>
Parser [Char]
next
next :: Parser [Char]
next = Char -> [Char]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Char -> [Char]) -> Parser Char -> Parser [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Char
char
spreadDashes :: Parser [Char]
spreadDashes = ([Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"- ") ([Char] -> [Char])
-> ((Int, Int) -> [Char]) -> (Int, Int) -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Int) -> [Char]
genDashes ((Int, Int) -> [Char]) -> Parser (Int, Int) -> Parser [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Int, Int)
dashesParser
genDashes :: (Int, Int) -> [Char]
genDashes (Int
offset, Int
n) = (Int -> [Char]) -> [Int] -> [Char]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\Int
x -> [Char]
"- " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate (Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
x) Char
' ')
[Int
1 .. Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
dashesParser :: Parser (Int, Int)
dashesParser = do Int
offset <- Maybe [Char] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Maybe [Char] -> Int) -> Parser (Maybe [Char]) -> Parser Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser [Char]
spaces Parser [Char] -> Parser (Maybe [Char])
forall a. Parser a -> Parser (Maybe a)
|?)
Int
n <- [Char] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Char] -> Int) -> Parser [Char] -> Parser Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Parser Char
dash Parser Char -> Parser [Char] -> Parser Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser [Char]
spacesOrTabs) Parser Char -> Parser [Char]
forall a. Parser a -> Parser [a]
|++)
(Int, Int) -> Parser (Int, Int)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
offset, Int
n)
spreadDashKey :: Parser [Char]
spreadDashKey = (\(Int
offset, [Char]
key) -> Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate Int
offset Char
' ' [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"- " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate (Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) Char
' ' [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
key [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
": ")
((Int, [Char]) -> [Char]) -> Parser (Int, [Char]) -> Parser [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Int, [Char])
dashKeyParser
dashKeyParser :: Parser (Int, [Char])
dashKeyParser = do Int
offset <- Maybe [Char] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Maybe [Char] -> Int) -> Parser (Maybe [Char]) -> Parser Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser [Char]
spaces Parser [Char] -> Parser (Maybe [Char])
forall a. Parser a -> Parser (Maybe a)
|?)
Parser Char
dash Parser Char -> Parser [Char] -> Parser Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser [Char]
spacesOrTabs
[Char]
key <- Int -> Parser [Char]
text Int
100 Parser [Char] -> Parser Char -> Parser [Char]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser [Char] -> Parser Char -> Parser Char
forall a b. Parser a -> Parser b -> Parser b
maybeWithin Parser [Char]
spacesOrTabs Parser Char
colon
(Int, [Char]) -> Parser (Int, [Char])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
offset, [Char]
key)
spreadKeyDash :: Parser [Char]
spreadKeyDash = (\(Int
offset, [Char]
key) -> Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate Int
offset Char
' ' [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
key [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
": " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate (Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) Char
' ' [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"- ")
((Int, [Char]) -> [Char]) -> Parser (Int, [Char]) -> Parser [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Int, [Char])
keyDashParser
keyDashParser :: Parser (Int, [Char])
keyDashParser = do Int
offset <- Maybe [Char] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Maybe [Char] -> Int) -> Parser (Maybe [Char]) -> Parser Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser [Char]
spaces Parser [Char] -> Parser (Maybe [Char])
forall a. Parser a -> Parser (Maybe a)
|?)
[Char]
key <- Int -> Parser [Char]
text Int
100 Parser [Char] -> Parser Char -> Parser [Char]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser [Char] -> Parser Char -> Parser Char
forall a b. Parser a -> Parser b -> Parser b
maybeWithin Parser [Char]
spacesOrTabs Parser Char
colon
Parser Char
dash Parser Char -> Parser [Char] -> Parser Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser [Char]
spacesOrTabs
(Int, [Char]) -> Parser (Int, [Char])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
offset, [Char]
key)