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

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

import           Data.Char (toLower)
import           Data.Map  (Map)
import qualified Data.Map  as Map
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
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
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
Ord)

data CollectionType
  = Standard
  | Inline
  deriving (CollectionType -> CollectionType -> Bool
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
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
Ord)


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

    YamlList CollectionType
Inline   [YamlExpression]
list     -> forall (m :: * -> *).
Foldable m =>
String -> String -> String -> Int -> m String -> String
stringify (String
", " forall a. Semigroup a => a -> a -> a
<> String
sep) (String
"[ " forall a. Semigroup a => a -> a -> a
<> String
sep) (String
" ]" forall a. Semigroup a => a -> a -> a
<> String
sep) Int
n forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [YamlExpression]
list where
      (String
sep, Int
n) = if (forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat) (forall a. Show a => a -> String
show forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [YamlExpression]
list) 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  -> forall (m :: * -> *).
Foldable m =>
String -> String -> String -> Int -> m String -> String
stringify (String
", " forall a. Semigroup a => a -> a -> a
<> String
sep) (String
"{ " forall a. Semigroup a => a -> a -> a
<> String
sep) (String
" }" forall a. Semigroup a => a -> a -> a
<> String
sep) Int
n forall a b. (a -> b) -> a -> b
$
                                    forall a.
String -> ShowS -> (a -> String) -> Map String a -> [String]
showMap String
": " forall a. a -> a
id forall a. Show a => a -> String
show Map String YamlExpression
mapping where
      (String
sep, Int
n) = if (forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat) (forall a. Show a => a -> String
show forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k a. Map k a -> [(k, a)]
Map.toList Map String YamlExpression
mapping) 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 (forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> [String]
lines String
str) forall a. Ord a => a -> a -> Bool
> Int
1) Bool -> Bool -> Bool
&& Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
str) String
forbiddenChar)
                    then String
"| \n"
                    else if forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> [String]
lines String
str) forall a. Ord a => a -> a -> Bool
> Int
1 then String
"\n"
                    else String
"") forall a. Semigroup a => a -> a -> a
<>

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

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

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