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 '!']