{-# 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 :: 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)