{-# LANGUAGE TypeFamilies #-}
module Toml.Printer
( prettyToml
, prettyTomlInd
) where
import Data.HashMap.Strict (HashMap)
import Data.Monoid ((<>))
import Data.Text (Text)
import Toml.PrefixTree (Key (..), Piece (..), PrefixMap, PrefixTree (..))
import Toml.Type (AnyValue (..), DateTime (..), TOML (..), Value (..))
import qualified Data.HashMap.Strict as HashMap
import qualified Data.List.NonEmpty as NonEmpty
import qualified Data.Text as Text
tab :: Int -> Text
tab n = Text.cons '\n' (Text.replicate (2*n) " ")
prettyToml :: TOML -> Text
prettyToml = Text.drop 1 . prettyTomlInd 0 ""
prettyTomlInd :: Int
-> Text
-> TOML
-> Text
prettyTomlInd i prefix TOML{..} = prettyKeyValue i tomlPairs <> "\n"
<> prettyTables i prefix tomlTables
prettyKeyValue :: Int -> HashMap Key AnyValue -> Text
prettyKeyValue i = Text.concat . map kvText . HashMap.toList
where
kvText :: (Key, AnyValue) -> Text
kvText (k, AnyValue v) = tab i <> prettyKey k <> " = " <> valText v
valText :: Value t -> Text
valText (Bool b) = Text.toLower $ showText b
valText (Integer n) = showText n
valText (Double d) = showText d
valText (Text s) = showText s
valText (Date d) = timeText d
valText (Array a) = "[" <> Text.intercalate ", " (map valText a) <> "]"
timeText :: DateTime -> Text
timeText (Zoned z) = showText z
timeText (Local l) = showText l
timeText (Day d) = showText d
timeText (Hours h) = showText h
showText :: Show a => a -> Text
showText = Text.pack . show
prettyTables :: Int -> Text -> PrefixMap TOML -> Text
prettyTables i pref = Text.concat . map prettyTable . HashMap.elems
where
prettyTable :: PrefixTree TOML -> Text
prettyTable (Leaf k toml) =
let name = getPref k in
tab i <> prettyTableName name
<> prettyTomlInd (succ i) name toml
prettyTable (Branch k mToml prefMap) =
let name = getPref k
nextI = succ i
toml = case mToml of
Nothing -> ""
Just t -> prettyTomlInd nextI name t
in tab i <> prettyTableName name <> toml <> prettyTables nextI name prefMap
getPref :: Key -> Text
getPref k = case pref of
"" -> prettyKey k
_ -> pref <> "." <> prettyKey k
prettyTableName :: Text -> Text
prettyTableName n = "[" <> n <> "]"
prettyKey :: Key -> Text
prettyKey (Key k) = Text.intercalate "." $ map unPiece (NonEmpty.toList k)