module SyntaxTrees.Yaml (YamlExpression(..), CollectionType(..)) where

import Utils.DateTime ()
import Utils.Foldable (stringify)
import Utils.Map (showMap)

import Data.Map (Map)
import qualified Data.Map as Map
import Data.Char (toLower)
import Data.Time (Day, TimeOfDay, ZonedTime(..))



data YamlExpression = YamlInteger Integer | YamlFloat Double | YamlBool Bool |
                      YamlString String | YamlDate Day |
                      YamlTime TimeOfDay | YamlDateTime ZonedTime |
                      YamlList CollectionType [YamlExpression] |
                      YamlMap CollectionType (Map String YamlExpression) |
                      YamlNull
                    deriving (YamlExpression -> YamlExpression -> Bool
(YamlExpression -> YamlExpression -> Bool)
-> (YamlExpression -> YamlExpression -> Bool) -> Eq YamlExpression
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: YamlExpression -> YamlExpression -> Bool
$c/= :: YamlExpression -> YamlExpression -> Bool
== :: YamlExpression -> YamlExpression -> Bool
$c== :: YamlExpression -> YamlExpression -> Bool
Eq, Eq YamlExpression
Eq YamlExpression
-> (YamlExpression -> YamlExpression -> Ordering)
-> (YamlExpression -> YamlExpression -> Bool)
-> (YamlExpression -> YamlExpression -> Bool)
-> (YamlExpression -> YamlExpression -> Bool)
-> (YamlExpression -> YamlExpression -> Bool)
-> (YamlExpression -> YamlExpression -> YamlExpression)
-> (YamlExpression -> YamlExpression -> YamlExpression)
-> Ord YamlExpression
YamlExpression -> YamlExpression -> Bool
YamlExpression -> YamlExpression -> Ordering
YamlExpression -> YamlExpression -> YamlExpression
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: YamlExpression -> YamlExpression -> YamlExpression
$cmin :: YamlExpression -> YamlExpression -> YamlExpression
max :: YamlExpression -> YamlExpression -> YamlExpression
$cmax :: YamlExpression -> YamlExpression -> YamlExpression
>= :: YamlExpression -> YamlExpression -> Bool
$c>= :: YamlExpression -> YamlExpression -> Bool
> :: YamlExpression -> YamlExpression -> Bool
$c> :: YamlExpression -> YamlExpression -> Bool
<= :: YamlExpression -> YamlExpression -> Bool
$c<= :: YamlExpression -> YamlExpression -> Bool
< :: YamlExpression -> YamlExpression -> Bool
$c< :: YamlExpression -> YamlExpression -> Bool
compare :: YamlExpression -> YamlExpression -> Ordering
$ccompare :: YamlExpression -> YamlExpression -> Ordering
$cp1Ord :: Eq YamlExpression
Ord)

data CollectionType = Standard | Inline deriving (CollectionType -> CollectionType -> Bool
(CollectionType -> CollectionType -> Bool)
-> (CollectionType -> CollectionType -> Bool) -> Eq CollectionType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CollectionType -> CollectionType -> Bool
$c/= :: CollectionType -> CollectionType -> Bool
== :: CollectionType -> CollectionType -> Bool
$c== :: CollectionType -> CollectionType -> Bool
Eq, Eq CollectionType
Eq CollectionType
-> (CollectionType -> CollectionType -> Ordering)
-> (CollectionType -> CollectionType -> Bool)
-> (CollectionType -> CollectionType -> Bool)
-> (CollectionType -> CollectionType -> Bool)
-> (CollectionType -> CollectionType -> Bool)
-> (CollectionType -> CollectionType -> CollectionType)
-> (CollectionType -> CollectionType -> CollectionType)
-> Ord CollectionType
CollectionType -> CollectionType -> Bool
CollectionType -> CollectionType -> Ordering
CollectionType -> CollectionType -> CollectionType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CollectionType -> CollectionType -> CollectionType
$cmin :: CollectionType -> CollectionType -> CollectionType
max :: CollectionType -> CollectionType -> CollectionType
$cmax :: CollectionType -> CollectionType -> CollectionType
>= :: CollectionType -> CollectionType -> Bool
$c>= :: CollectionType -> CollectionType -> Bool
> :: CollectionType -> CollectionType -> Bool
$c> :: CollectionType -> CollectionType -> Bool
<= :: CollectionType -> CollectionType -> Bool
$c<= :: CollectionType -> CollectionType -> Bool
< :: CollectionType -> CollectionType -> Bool
$c< :: CollectionType -> CollectionType -> Bool
compare :: CollectionType -> CollectionType -> Ordering
$ccompare :: CollectionType -> CollectionType -> Ordering
$cp1Ord :: Eq CollectionType
Ord)


instance Show YamlExpression where
  show :: YamlExpression -> String
show = \case
    YamlExpression
YamlNull                   -> String
"null"
    YamlInteger Integer
n              -> Integer -> String
forall a. Show a => a -> String
show Integer
n
    YamlFloat Double
n                -> Double -> String
forall a. Show a => a -> String
show Double
n
    YamlBool Bool
bool              -> Char -> Char
toLower (Char -> Char) -> ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> String
forall a. Show a => a -> String
show Bool
bool
    YamlDate Day
date              -> Day -> String
forall a. Show a => a -> String
show Day
date
    YamlTime TimeOfDay
time              -> TimeOfDay -> String
forall a. Show a => a -> String
show TimeOfDay
time
    YamlDateTime ZonedTime
dateTime      -> ZonedTime -> String
forall a. Show a => a -> String
show ZonedTime
dateTime
    YamlString String
str             -> ShowS
showStr String
str
    YamlList CollectionType
Standard [YamlExpression]
list     -> String -> String -> String -> Int -> [String] -> String
forall (m :: * -> *).
Foldable m =>
String -> String -> String -> Int -> m String -> String
stringify String
"\n" String
"\n" String
"" Int
2 ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (String
"- " String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> (YamlExpression -> String) -> YamlExpression -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. YamlExpression -> String
forall a. Show a => a -> String
show (YamlExpression -> String) -> [YamlExpression] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [YamlExpression]
list
    YamlMap  CollectionType
Standard Map String YamlExpression
mapping  -> String -> String -> String -> Int -> [String] -> String
forall (m :: * -> *).
Foldable m =>
String -> String -> String -> Int -> m String -> String
stringify String
"\n" String
"\n" String
"" Int
2 ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ String
-> ShowS
-> (YamlExpression -> String)
-> Map String YamlExpression
-> [String]
forall a.
String -> ShowS -> (a -> String) -> Map String a -> [String]
showMap String
": " ShowS
forall a. a -> a
id YamlExpression -> String
forall a. Show a => a -> String
show Map String YamlExpression
mapping

    YamlList CollectionType
Inline   [YamlExpression]
list     -> String -> String -> String -> Int -> [String] -> String
forall (m :: * -> *).
Foldable m =>
String -> String -> String -> Int -> m String -> String
stringify (String
", " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
sep) (String
"[ " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
sep) (String
" ]" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
sep) Int
n ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ YamlExpression -> String
forall a. Show a => a -> String
show (YamlExpression -> String) -> [YamlExpression] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [YamlExpression]
list where
      (String
sep, Int
n) = if (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> Int) -> ([String] -> String) -> [String] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
forall a. Monoid a => [a] -> a
mconcat) (YamlExpression -> String
forall a. Show a => a -> String
show (YamlExpression -> String) -> [YamlExpression] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [YamlExpression]
list) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
80 then (String
"\n", Int
2) else (String
"", Int
0)

    YamlMap  CollectionType
Inline   Map String YamlExpression
mapping  -> String -> String -> String -> Int -> [String] -> String
forall (m :: * -> *).
Foldable m =>
String -> String -> String -> Int -> m String -> String
stringify (String
", " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
sep) (String
"{ " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
sep) (String
" }" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
sep) Int
n ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
                                    String
-> ShowS
-> (YamlExpression -> String)
-> Map String YamlExpression
-> [String]
forall a.
String -> ShowS -> (a -> String) -> Map String a -> [String]
showMap String
": " ShowS
forall a. a -> a
id YamlExpression -> String
forall a. Show a => a -> String
show Map String YamlExpression
mapping where
      (String
sep, Int
n) = if (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> Int) -> ([String] -> String) -> [String] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
forall a. Monoid a => [a] -> a
mconcat) ((String, YamlExpression) -> String
forall a. Show a => a -> String
show ((String, YamlExpression) -> String)
-> [(String, YamlExpression)] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map String YamlExpression -> [(String, YamlExpression)]
forall k a. Map k a -> [(k, a)]
Map.toList Map String YamlExpression
mapping) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
80 then (String
"\n", Int
2) else (String
"", Int
0)



showStr :: String -> String
showStr :: ShowS
showStr String
str = (if ([String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> [String]
lines String
str) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1) Bool -> Bool -> Bool
&& Bool -> Bool
not ((Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
str) String
forbiddenChar)
                    then String
"| \n"
                    else if [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> [String]
lines String
str) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 then String
"\n"
                    else String
"") String -> ShowS
forall a. [a] -> [a] -> [a]
++

                   (if Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
str) String
forbiddenChar  then String
str
                   else if Char
'"' Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
str  then String
"'"  String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
indented Int
3 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"'"
                   else                         String
"\"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
indented Int
3) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\""  where

  indented :: Int -> String
indented Int
n = [String] -> String
forall a. [a] -> a
head (String -> [String]
lines String
str) String -> ShowS
forall a. [a] -> [a] -> [a]
++
               [String] -> String
forall a. Monoid a => [a] -> a
mconcat (((String
"\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
n Char
' ') String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> [String] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String] -> [String]
forall a. [a] -> [a]
tail (String -> [String]
lines String
str))

  forbiddenChar :: String
forbiddenChar = [Char
'#', Char
'&', Char
'*', Char
',', Char
'?', Char
'-', Char
':', Char
'[', Char
']', Char
'{', Char
'}'] String -> ShowS
forall a. [a] -> [a] -> [a]
++
                  [Char
'>', Char
'|', Char
':', Char
'!']