module Bookhound.Format.SyntaxTrees.Toml (TomlExpression(..), TableType(..)) where

import Bookhound.Internal.DateTime (showDateTime)
import Bookhound.Internal.Foldable (stringify)
import Bookhound.Internal.Map      (showMap)

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

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



data TomlExpression
  = TomlInteger Integer
  | TomlFloat Double
  | TomlBool Bool
  | TomlString String
  | TomlDate Day
  | TomlTime TimeOfDay
  | TomlDateTime ZonedTime
  | TomlArray [TomlExpression]
  | TomlTable TableType (Map String TomlExpression)
  | TomlNull
  deriving (TomlExpression -> TomlExpression -> Bool
(TomlExpression -> TomlExpression -> Bool)
-> (TomlExpression -> TomlExpression -> Bool) -> Eq TomlExpression
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TomlExpression -> TomlExpression -> Bool
$c/= :: TomlExpression -> TomlExpression -> Bool
== :: TomlExpression -> TomlExpression -> Bool
$c== :: TomlExpression -> TomlExpression -> Bool
Eq, Eq TomlExpression
Eq TomlExpression
-> (TomlExpression -> TomlExpression -> Ordering)
-> (TomlExpression -> TomlExpression -> Bool)
-> (TomlExpression -> TomlExpression -> Bool)
-> (TomlExpression -> TomlExpression -> Bool)
-> (TomlExpression -> TomlExpression -> Bool)
-> (TomlExpression -> TomlExpression -> TomlExpression)
-> (TomlExpression -> TomlExpression -> TomlExpression)
-> Ord TomlExpression
TomlExpression -> TomlExpression -> Bool
TomlExpression -> TomlExpression -> Ordering
TomlExpression -> TomlExpression -> TomlExpression
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 :: TomlExpression -> TomlExpression -> TomlExpression
$cmin :: TomlExpression -> TomlExpression -> TomlExpression
max :: TomlExpression -> TomlExpression -> TomlExpression
$cmax :: TomlExpression -> TomlExpression -> TomlExpression
>= :: TomlExpression -> TomlExpression -> Bool
$c>= :: TomlExpression -> TomlExpression -> Bool
> :: TomlExpression -> TomlExpression -> Bool
$c> :: TomlExpression -> TomlExpression -> Bool
<= :: TomlExpression -> TomlExpression -> Bool
$c<= :: TomlExpression -> TomlExpression -> Bool
< :: TomlExpression -> TomlExpression -> Bool
$c< :: TomlExpression -> TomlExpression -> Bool
compare :: TomlExpression -> TomlExpression -> Ordering
$ccompare :: TomlExpression -> TomlExpression -> Ordering
$cp1Ord :: Eq TomlExpression
Ord)


data TableType
  = TopLevel
  | Standard
  | Inline
  deriving (TableType -> TableType -> Bool
(TableType -> TableType -> Bool)
-> (TableType -> TableType -> Bool) -> Eq TableType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TableType -> TableType -> Bool
$c/= :: TableType -> TableType -> Bool
== :: TableType -> TableType -> Bool
$c== :: TableType -> TableType -> Bool
Eq, Eq TableType
Eq TableType
-> (TableType -> TableType -> Ordering)
-> (TableType -> TableType -> Bool)
-> (TableType -> TableType -> Bool)
-> (TableType -> TableType -> Bool)
-> (TableType -> TableType -> Bool)
-> (TableType -> TableType -> TableType)
-> (TableType -> TableType -> TableType)
-> Ord TableType
TableType -> TableType -> Bool
TableType -> TableType -> Ordering
TableType -> TableType -> TableType
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 :: TableType -> TableType -> TableType
$cmin :: TableType -> TableType -> TableType
max :: TableType -> TableType -> TableType
$cmax :: TableType -> TableType -> TableType
>= :: TableType -> TableType -> Bool
$c>= :: TableType -> TableType -> Bool
> :: TableType -> TableType -> Bool
$c> :: TableType -> TableType -> Bool
<= :: TableType -> TableType -> Bool
$c<= :: TableType -> TableType -> Bool
< :: TableType -> TableType -> Bool
$c< :: TableType -> TableType -> Bool
compare :: TableType -> TableType -> Ordering
$ccompare :: TableType -> TableType -> Ordering
$cp1Ord :: Eq TableType
Ord)


instance Show TomlExpression where
  show :: TomlExpression -> String
show = \case
    TomlExpression
TomlNull                   -> String
"null"
    TomlInteger Integer
n              -> Integer -> String
forall a. Show a => a -> String
show Integer
n
    TomlFloat Double
n                -> Double -> String
forall a. Show a => a -> String
show Double
n
    TomlBool 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
    TomlDate Day
date              -> Day -> String
forall a. Show a => a -> String
show Day
date
    TomlTime TimeOfDay
time              -> TimeOfDay -> String
forall a. Show a => a -> String
show TimeOfDay
time
    TomlDateTime ZonedTime
dateTime      -> ZonedTime -> String
showDateTime ZonedTime
dateTime
    TomlString String
str             -> ShowS
forall a. Show a => a -> String
show String
str

    TomlTable TableType
Standard Map String TomlExpression
table   -> String -> String -> String -> Int -> [String] -> String
forall (m :: * -> *).
Foldable m =>
String -> String -> String -> Int -> m String -> String
stringify String
"\n" String
"" String
"" Int
0 ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ String
-> ShowS
-> (TomlExpression -> String)
-> Map String TomlExpression
-> [String]
forall a.
String -> ShowS -> (a -> String) -> Map String a -> [String]
showMap String
" = " ShowS
forall a. a -> a
id TomlExpression -> String
forall a. Show a => a -> String
show Map String TomlExpression
table

    TomlTable TableType
TopLevel Map String TomlExpression
table   -> String -> String -> String -> Int -> [String] -> String
forall (m :: * -> *).
Foldable m =>
String -> String -> String -> Int -> m String -> String
stringify String
"\n\n" String
"\n" String
"\n" Int
0 ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ String
-> ShowS
-> (TomlExpression -> String)
-> Map String TomlExpression
-> [String]
forall a.
String -> ShowS -> (a -> String) -> Map String a -> [String]
showMap String
"" ShowS
showTableHeader TomlExpression -> String
forall a. Show a => a -> String
show Map String TomlExpression
table where
      showTableHeader :: ShowS
showTableHeader String
header = if String
header String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"" then String
"[" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
header String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"]" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"\n"  else String
""

    TomlTable TableType
Inline Map String TomlExpression
table     -> String -> String -> String -> Int -> [String] -> String
forall (m :: * -> *).
Foldable m =>
String -> String -> String -> Int -> m String -> String
stringify (String
", " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
sep) (String
"{ " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
sep) (String
" }" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
sep) Int
n ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
                                    String
-> ShowS
-> (TomlExpression -> String)
-> Map String TomlExpression
-> [String]
forall a.
String -> ShowS -> (a -> String) -> Map String a -> [String]
showMap String
" = " ShowS
forall a. a -> a
id TomlExpression -> String
forall a. Show a => a -> String
show Map String TomlExpression
table 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, TomlExpression) -> String
forall a. Show a => a -> String
show ((String, TomlExpression) -> String)
-> [(String, TomlExpression)] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map String TomlExpression -> [(String, TomlExpression)]
forall k a. Map k a -> [(k, a)]
Map.toList Map String TomlExpression
table) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
80 then (String
"\n", Int
2) else (String
"", Int
0)

    TomlArray [TomlExpression]
arr              -> String -> String -> String -> Int -> [String] -> String
forall (m :: * -> *).
Foldable m =>
String -> String -> String -> Int -> m String -> String
stringify (String
", " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
sep) (String
"[ " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
sep) (String
" ]" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
sep) Int
n ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ TomlExpression -> String
forall a. Show a => a -> String
show (TomlExpression -> String) -> [TomlExpression] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TomlExpression]
arr 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) (TomlExpression -> String
forall a. Show a => a -> String
show (TomlExpression -> String) -> [TomlExpression] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TomlExpression]
arr) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
80 then (String
"\n", Int
2) else (String
"", Int
0)