module Bookhound.Format.Parsers.Yaml (yaml, nil, integer, float, bool, string,
                     list, mapping) where


import Bookhound.Parser              (Parser, andThen, check, exactly,
                                      withError)
import Bookhound.ParserCombinators   (IsMatch (..), maybeWithin, (<#>), (<|>),
                                      (>>>), (|*), (|+), (|++), (|?))
import Bookhound.Parsers.Char        (char, colon, dash, dot, doubleQuote,
                                      hashTag, newLine, question, quote, space,
                                      whiteSpace)
import Bookhound.Parsers.Collections (listOf, mapOf)
import Bookhound.Parsers.Number      (double, hexInt, int, octInt)
import Bookhound.Parsers.String      (blankLine, blankLines, spaces,
                                      spacesOrTabs, tabs, withinDoubleQuotes,
                                      withinQuotes)

import Bookhound.Format.SyntaxTrees.Yaml    (CollectionType (..), YamlExpression (..))

import qualified Bookhound.Parsers.DateTime as Dt

import           Data.List (nub)
import qualified Data.Map  as Map



yaml :: Parser YamlExpression
yaml :: Parser YamlExpression
yaml =  Parser String
normalize Parser String -> Parser YamlExpression -> Parser YamlExpression
forall a. Parser String -> Parser a -> Parser a
`andThen` Int -> Parser YamlExpression
yamlWithIndent (-Int
1)




-- TODO: Add support for anchors and aliases

nil :: Parser YamlExpression
nil :: Parser YamlExpression
nil = String -> Parser YamlExpression -> Parser YamlExpression
forall a. String -> Parser a -> Parser a
withError String
"Yaml Null"
  (Parser YamlExpression -> Parser YamlExpression)
-> Parser YamlExpression -> Parser YamlExpression
forall a b. (a -> b) -> a -> b
$ YamlExpression
YamlNull YamlExpression -> Parser String -> Parser YamlExpression
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [String] -> Parser String
forall a. IsMatch a => [a] -> Parser a
oneOf [String
"null", String
"Null", String
"NULL"]

integer :: Parser YamlExpression
integer :: Parser YamlExpression
integer = String -> Parser YamlExpression -> Parser YamlExpression
forall a. String -> Parser a -> Parser a
withError String
"Yaml Integer"
  (Parser YamlExpression -> Parser YamlExpression)
-> Parser YamlExpression -> Parser YamlExpression
forall a b. (a -> b) -> a -> b
$ 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 = String -> Parser YamlExpression -> Parser YamlExpression
forall a. String -> Parser a -> Parser a
withError String
"Yaml Float"
  (Parser YamlExpression -> Parser YamlExpression)
-> Parser YamlExpression -> Parser YamlExpression
forall a b. (a -> b) -> a -> b
$ 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 = String -> Parser YamlExpression -> Parser YamlExpression
forall a. String -> Parser a -> Parser a
withError String
"Yaml Bool"
  (Parser YamlExpression -> Parser YamlExpression)
-> Parser YamlExpression -> Parser YamlExpression
forall a b. (a -> b) -> a -> b
$ 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 String -> Parser Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [String] -> Parser String
forall a. IsMatch a => [a] -> Parser a
oneOf [String
"true", String
"True", String
"TRUE"]    Parser Bool -> Parser Bool -> Parser Bool
forall a. Parser a -> Parser a -> Parser a
<|>
                  Bool
False Bool -> Parser String -> Parser Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [String] -> Parser String
forall a. IsMatch a => [a] -> Parser a
oneOf [String
"false", String
"False", String
"FALSE"])


dateTime :: Parser YamlExpression
dateTime :: Parser YamlExpression
dateTime = String -> Parser YamlExpression -> Parser YamlExpression
forall a. String -> Parser a -> Parser a
withError String
"Yaml DateTime"
  (Parser YamlExpression -> Parser YamlExpression)
-> Parser YamlExpression -> Parser YamlExpression
forall a b. (a -> b) -> a -> b
$ 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 = String -> Parser YamlExpression -> Parser YamlExpression
forall a. String -> Parser a -> Parser a
withError String
"Yaml Date"
  (Parser YamlExpression -> Parser YamlExpression)
-> Parser YamlExpression -> Parser YamlExpression
forall a b. (a -> b) -> a -> b
$ 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 = String -> Parser YamlExpression -> Parser YamlExpression
forall a. String -> Parser a -> Parser a
withError String
"Yaml Time"
  (Parser YamlExpression -> Parser YamlExpression)
-> Parser YamlExpression -> Parser YamlExpression
forall a b. (a -> b) -> a -> b
$ 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 = String -> Parser YamlExpression -> Parser YamlExpression
forall a. String -> Parser a -> Parser a
withError String
"Yaml String"
  (Parser YamlExpression -> Parser YamlExpression)
-> Parser YamlExpression -> Parser YamlExpression
forall a b. (a -> b) -> a -> b
$ String -> YamlExpression
YamlString (String -> YamlExpression)
-> Parser String -> Parser YamlExpression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Parser String
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 <- String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> Int) -> Parser String -> Parser Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser Char
space Parser Char -> Parser String
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
elm <- Int -> Parser YamlExpression
yamlWithIndent Int
n
                  pure (Int
n, YamlExpression
elm)


list :: Int -> Parser YamlExpression
list :: Int -> Parser YamlExpression
list Int
indent = String -> Parser YamlExpression -> Parser YamlExpression
forall a. String -> Parser a -> Parser a
withError String
"Json List"
  (Parser YamlExpression -> Parser YamlExpression)
-> Parser YamlExpression -> Parser YamlExpression
forall a b. (a -> b) -> a -> b
$   (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 String -> Parser [YamlExpression] -> Parser [YamlExpression]
forall a b. Parser a -> Parser b -> Parser b
maybeWithin Parser String
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 = String -> Parser YamlExpression -> Parser YamlExpression
forall a. String -> Parser a -> Parser a
withError String
"Yaml Set"
  (Parser YamlExpression -> Parser YamlExpression)
-> Parser YamlExpression -> Parser YamlExpression
forall a b. (a -> b) -> a -> b
$ 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 = String -> Parser YamlExpression -> Parser YamlExpression
forall a. String -> Parser a -> Parser a
withError String
"Yaml Mapping"
  (Parser YamlExpression -> Parser YamlExpression)
-> Parser YamlExpression -> Parser YamlExpression
forall a b. (a -> b) -> a -> b
$   (CollectionType -> Map String YamlExpression -> YamlExpression
YamlMap CollectionType
Inline   (Map String YamlExpression -> YamlExpression)
-> Parser (Map String YamlExpression) -> Parser YamlExpression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Map String YamlExpression)
jsonMap)
  Parser YamlExpression
-> Parser YamlExpression -> Parser YamlExpression
forall a. Parser a -> Parser a -> Parser a
<|> (CollectionType -> Map String YamlExpression -> YamlExpression
YamlMap CollectionType
Standard (Map String YamlExpression -> YamlExpression)
-> Parser (Map String YamlExpression) -> Parser YamlExpression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Map String YamlExpression)
yamlMap)
  where
    yamlMap :: Parser (Map String YamlExpression)
yamlMap = [(String, YamlExpression)] -> Map String YamlExpression
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(String, YamlExpression)] -> Map String YamlExpression)
-> Parser [(String, YamlExpression)]
-> Parser (Map String YamlExpression)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser [(String, YamlExpression)]
mapParser
    jsonMap :: Parser (Map String YamlExpression)
jsonMap = Parser String
-> Parser (Map String YamlExpression)
-> Parser (Map String YamlExpression)
forall a b. Parser a -> Parser b -> Parser b
maybeWithin Parser String
spacesOrTabs (Parser (Map String YamlExpression)
 -> Parser (Map String YamlExpression))
-> Parser (Map String YamlExpression)
-> Parser (Map String YamlExpression)
forall a b. (a -> b) -> a -> b
$ Parser Char
-> Parser String
-> Parser YamlExpression
-> Parser (Map String YamlExpression)
forall b a c.
Ord b =>
Parser a -> Parser b -> Parser c -> Parser (Map b c)
mapOf Parser Char
colon (Int -> Parser String
text Int
100) (Parser YamlExpression -> Parser (Map String YamlExpression))
-> Parser YamlExpression -> Parser (Map String YamlExpression)
forall a b. (a -> b) -> a -> b
$ Int -> Parser YamlExpression
yamlWithIndent (-Int
1)

    mapParser :: Parser [(String, YamlExpression)]
mapParser = Parser (Int, (String, YamlExpression))
-> Int -> Parser [(String, YamlExpression)]
forall a. Parser (Int, a) -> Int -> Parser [a]
indentationCheck Parser (Int, (String, YamlExpression))
keyValueParser Int
indent

    keyValueParser :: Parser (Int, (String, YamlExpression))
keyValueParser = do Int
n <- String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> Int) -> Parser String -> Parser Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser Char
space Parser Char -> Parser String
forall a. Parser a -> Parser [a]
|*)
                        String
key <- YamlExpression -> String
forall a. Show a => a -> String
show (YamlExpression -> String)
-> Parser YamlExpression -> Parser String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Parser YamlExpression
element Int
indent
                        (Parser String
spacesOrTabs Parser String -> Parser (Maybe String)
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
                        pure (Int
n, (String
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 [String] -> Parser YamlExpression -> Parser YamlExpression
forall a b. Parser a -> Parser b -> Parser b
maybeWithin ((Parser String
blankLine Parser String -> Parser String -> Parser String
forall a. Parser a -> Parser a -> Parser a
<|> Parser String
comment Parser String -> Parser String -> Parser String
forall a. Parser a -> Parser a -> Parser a
<|> Parser String
directive Parser String -> Parser String -> Parser String
forall a. Parser a -> Parser a -> Parser a
<|>
                                      Parser String
docStart Parser String -> Parser String -> Parser String
forall a. Parser a -> Parser a -> Parser a
<|> Parser String
docEnd) Parser String -> Parser [String]
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 String -> Parser YamlExpression -> Parser YamlExpression
forall a b. Parser a -> Parser b -> Parser b
maybeWithin Parser String
spacesOrTabs (Int -> Parser YamlExpression
element Int
indent)
    comment :: Parser String
comment = Parser Char
hashTag Parser Char -> Parser String -> Parser String
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 String
forall a. Parser a -> Parser [a]
|+) Parser String -> Parser Char -> Parser String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Char
newLine
    directive :: Parser String
directive = String -> Parser String
forall a. IsMatch a => a -> Parser a
is String
"%" Parser String -> Parser String -> Parser String
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 String -> Parser String
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 String
forall a. Parser a -> Parser [a]
|+)) Parser String -> Parser Char -> Parser String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Char
newLine
    docStart :: Parser String
docStart = Parser Char
dash Parser Char -> Integer -> Parser String
forall a. Parser a -> Integer -> Parser [a]
<#> Integer
3
    docEnd :: Parser String
docEnd = Parser Char
dot Parser Char -> Integer -> Parser String
forall a. Parser a -> Integer -> Parser [a]
<#> Integer
3



text :: Int -> Parser String
text :: Int -> Parser String
text Int
indent = Parser String -> Parser String
forall a. Parser a -> Parser a
withinDoubleQuotes (Parser String -> Parser String
quotedParser (Parser Char -> Parser Char
forall a. IsMatch a => Parser a -> Parser a
inverse Parser Char
doubleQuote Parser Char -> Parser String
forall a. Parser a -> Parser [a]
|*))                      Parser String -> Parser String -> Parser String
forall a. Parser a -> Parser a -> Parser a
<|>
              Parser String -> Parser String
forall a. Parser a -> Parser a
withinQuotes       (Parser String -> Parser String
quotedParser (Parser Char -> Parser Char
forall a. IsMatch a => Parser a -> Parser a
inverse Parser Char
quote       Parser Char -> Parser String
forall a. Parser a -> Parser [a]
|*))                      Parser String -> Parser String -> Parser String
forall a. Parser a -> Parser a -> Parser a
<|>
              (String -> Parser String
forall a. IsMatch a => a -> Parser a
is String
"|" Parser String -> Parser String -> Parser String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser String
blankLine Parser String -> Parser String -> Parser String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Parser String -> Parser (Int, String)) -> Parser String
plainTextParser Parser String -> Parser (Int, String)
literalLineParser)                      Parser String -> Parser String -> Parser String
forall a. Parser a -> Parser a -> Parser a
<|>
              (String -> Parser String
forall a. IsMatch a => a -> Parser a
is String
">" Parser String -> Parser String -> Parser String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser String
blankLine Parser String -> Parser (Maybe String) -> Parser (Maybe String)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Parser String
spacesOrTabs Parser String -> Parser (Maybe String)
forall a. Parser a -> Parser (Maybe a)
|?) Parser (Maybe String) -> Parser String -> Parser String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Parser String -> Parser (Int, String)) -> Parser String
plainTextParser Parser String -> Parser (Int, String)
foldingLineParser) Parser String -> Parser String -> Parser String
forall a. Parser a -> Parser a -> Parser a
<|>
              (Parser String -> Parser (Int, String)) -> Parser String
plainTextParser Parser String -> Parser (Int, String)
foldingLineParser
  where

    quotedParser :: Parser String -> Parser String
quotedParser Parser String
parser = [String] -> String
forall a. Monoid a => [a] -> a
mconcat ([String] -> String) -> Parser [String] -> Parser String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (((Int, String) -> String
forall a b. (a, b) -> b
snd ((Int, String) -> String) -> Parser (Int, String) -> Parser String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser String -> Parser (Int, String)
foldingLineParser Parser String
parser) Parser String -> Parser [String]
forall a. Parser a -> Parser [a]
|*)

    plainTextParser :: (Parser String -> Parser (Int, String)) -> Parser String
plainTextParser Parser String -> Parser (Int, String)
styleParser = Parser Char
allowedStart Parser Char -> Parser String -> Parser String
forall a b.
(ToString a, ToString b) =>
Parser a -> Parser b -> Parser String
>>> Parser String
allowedString Parser String -> Parser [[String]] -> Parser String
forall a b.
(ToString a, ToString b) =>
Parser a -> Parser b -> Parser String
>>>
                                  (Parser (Int, String) -> Int -> Parser [String]
forall a. Parser (Int, a) -> Int -> Parser [a]
indentationCheck (Parser String -> Parser (Int, String)
styleParser Parser String
allowedString) Int
indent Parser [String] -> Parser [[String]]
forall a. Parser a -> Parser [a]
|*)

    foldingLineParser :: Parser String -> Parser (Int, String)
foldingLineParser Parser String
parser = do String
sep <- (String
"\n" String -> Parser Char -> Parser String
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser Char
newLine Parser String -> Parser String -> Parser String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser String
blankLines) Parser String -> Parser String -> Parser String
forall a. Parser a -> Parser a -> Parser a
<|> (String
" " String -> Parser Char -> Parser String
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser Char
newLine)
                                  Int
n   <- Parser String -> Parser Int -> Parser Int
forall a b. Parser a -> Parser b -> Parser b
maybeWithin Parser String
tabs (Parser Int -> Parser Int) -> Parser Int -> Parser Int
forall a b. (a -> b) -> a -> b
$ String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> Int) -> Parser String -> Parser Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser Char
space Parser Char -> Parser String
forall a. Parser a -> Parser [a]
|*)
                                  String
str <- Parser String
parser
                                  pure (Int
n, String
sep String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
str)

    literalLineParser :: Parser String -> Parser (Int, String)
literalLineParser Parser String
parser = do String
sep <- Char -> String
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Char -> String) -> Parser Char -> Parser String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Char
newLine
                                  Int
n   <- String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> Int) -> Parser String -> Parser Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser Char
space Parser Char -> Parser String
forall a. Parser a -> Parser [a]
|*)
                                  String
str <- Parser String
parser
                                  pure (Int
n, String
sep String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
indent) Char
' ' String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
str)

    allowedStart :: Parser Char
allowedStart = String -> Parser Char
forall a. IsMatch a => [a] -> Parser a
noneOf (String -> Parser Char) -> String -> Parser Char
forall a b. (a -> b) -> a -> b
$ String
forbiddenChar String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [Char
'>', Char
'|', Char
':', Char
'!']

    allowedString :: Parser String
allowedString = (String -> Parser Char
forall a. IsMatch a => [a] -> Parser a
noneOf String
forbiddenChar Parser Char -> Parser String
forall a. Parser a -> Parser [a]
|*)

    forbiddenChar :: String
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
<$> String -> ((Int, a) -> Bool) -> Parser (Int, a) -> Parser (Int, a)
forall a. String -> (a -> Bool) -> Parser a -> Parser a
check String
"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 String
normalize = String -> Parser String -> Parser String
forall a. String -> Parser a -> Parser a
withError String
"Normalize Yaml"
  (Parser String -> Parser String) -> Parser String -> Parser String
forall a b. (a -> b) -> a -> b
$ (Parser String
parserActions Parser String -> Parser String -> Parser String
forall a b.
(ToString a, ToString b) =>
Parser a -> Parser b -> Parser String
>>> Parser String
normalize) Parser String -> Parser String -> Parser String
forall a. Parser a -> Parser a -> Parser a
<|> (Parser Char
char Parser Char -> Parser String
forall a. Parser a -> Parser [a]
|*)
  where

    parserActions :: Parser String
parserActions = Parser String
spreadDashes     Parser String -> Parser String -> Parser String
forall a. Parser a -> Parser a -> Parser a
<|>
                    Parser String
spreadDashKey    Parser String -> Parser String -> Parser String
forall a. Parser a -> Parser a -> Parser a
<|>
                    Parser String
spreadKeyDash    Parser String -> Parser String -> Parser String
forall a. Parser a -> Parser a -> Parser a
<|>
                    Parser String
next

    next :: Parser String
next = Char -> String
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Char -> String) -> Parser Char -> Parser String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Char
char

    spreadDashes :: Parser String
spreadDashes = (String -> String -> String
forall a. Semigroup a => a -> a -> a
(<>) String
"- ") (String -> String)
-> ((Int, Int) -> String) -> (Int, Int) -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Int) -> String
genDashes ((Int, Int) -> String) -> Parser (Int, Int) -> Parser String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Int, Int)
dashesParser

    genDashes :: (Int, Int) -> String
genDashes (Int
offset, Int
n) = (Int -> String) -> [Int] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\Int
x -> String
"- " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> Char -> String
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 String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Maybe String -> Int) -> Parser (Maybe String) -> Parser Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser String
spaces Parser String -> Parser (Maybe String)
forall a. Parser a -> Parser (Maybe a)
|?)
                      Int
n <- String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> Int) -> Parser String -> Parser Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Parser Char
dash Parser Char -> Parser String -> Parser Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser String
spacesOrTabs) Parser Char -> Parser String
forall a. Parser a -> Parser [a]
|++)
                      pure (Int
offset, Int
n)


    spreadDashKey :: Parser String
spreadDashKey = (\(Int
offset, String
key) -> Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
offset Char
' ' String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"- " String -> String -> String
forall a. Semigroup a => a -> a -> a
<>
                                      Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) Char
' ' String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
key String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
": ")
                    ((Int, String) -> String) -> Parser (Int, String) -> Parser String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Int, String)
dashKeyParser

    dashKeyParser :: Parser (Int, String)
dashKeyParser = do Int
offset <- Maybe String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Maybe String -> Int) -> Parser (Maybe String) -> Parser Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser String
spaces Parser String -> Parser (Maybe String)
forall a. Parser a -> Parser (Maybe a)
|?)
                       Parser Char
dash Parser Char -> Parser String -> Parser Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser String
spacesOrTabs
                       String
key <- Int -> Parser String
text Int
100 Parser String -> Parser Char -> Parser String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser String -> Parser Char -> Parser Char
forall a b. Parser a -> Parser b -> Parser b
maybeWithin Parser String
spacesOrTabs Parser Char
colon
                       pure (Int
offset, String
key)


    spreadKeyDash :: Parser String
spreadKeyDash = (\(Int
offset, String
key) -> Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
offset Char
' ' String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
key String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
": " String -> String -> String
forall a. Semigroup a => a -> a -> a
<>
                                      Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) Char
' ' String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"- ")
                    ((Int, String) -> String) -> Parser (Int, String) -> Parser String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Int, String)
keyDashParser

    keyDashParser :: Parser (Int, String)
keyDashParser = do Int
offset <- Maybe String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Maybe String -> Int) -> Parser (Maybe String) -> Parser Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser String
spaces Parser String -> Parser (Maybe String)
forall a. Parser a -> Parser (Maybe a)
|?)
                       String
key <- Int -> Parser String
text Int
100 Parser String -> Parser Char -> Parser String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser String -> Parser Char -> Parser Char
forall a b. Parser a -> Parser b -> Parser b
maybeWithin Parser String
spacesOrTabs Parser Char
colon
                       Parser Char
dash Parser Char -> Parser String -> Parser Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser String
spacesOrTabs
                       pure (Int
offset, String
key)