{-# LANGUAGE DeriveAnyClass #-}

{- |
Copyright: (c) 2018-2020 Kowainik
SPDX-License-Identifier: MPL-2.0
Maintainer: Kowainik <xrom.xkov@gmail.com>

Type of TOML AST. This is intermediate representation of TOML parsed from text.
-}

module Toml.Type.TOML
       ( TOML (..)
       , insertKeyVal
       , insertKeyAnyVal
       , insertTable
       , insertTableArrays
       ) where

import Control.DeepSeq (NFData)
import Data.HashMap.Strict (HashMap)
import Data.List.NonEmpty (NonEmpty)
import GHC.Generics (Generic)

import Toml.Type.AnyValue (AnyValue (..))
import Toml.Type.Key (Key (..))
import Toml.Type.PrefixTree (PrefixMap)
import Toml.Type.Value (Value)

import qualified Data.HashMap.Strict as HashMap
import qualified Toml.Type.PrefixTree as Prefix


{- | Represents TOML configuration value.

For example, if we have the following @TOML@ file:

@
server.port        = 8080
server.codes       = [ 5, 10, 42 ]
server.description = "This is production server."

[mail]
    host = "smtp.gmail.com"
    send-if-inactive = false

[[user]]
    id = 42

[[user]]
    name = "Foo Bar"
@

corresponding 'TOML' looks like:

@
TOML
    { tomlPairs = fromList
        [ ( "server" :| [ "port" ] , Integer 8080)
        , ( "server" :| [ "codes" ] , Array [ Integer 5 , Integer 10 , Integer 42])
        , ( "server" :| [ "description" ] , Text "This is production server.")
        ]
    , tomlTables = fromList
        [ ( "mail"
          , Leaf ( "mail" :| [] )
              ( TOML
                  { tomlPairs = fromList
                      [ ( "host" :| [] , Text "smtp.gmail.com")
                      , ( "send-if-inactive" :| [] , Bool False)
                      ]
                  , tomlTables = fromList []
                  , tomlTableArrays = fromList []
                  }
              )
          )
        ]
    , tomlTableArrays = fromList
        [ ( "user" :| []
          , TOML
              { tomlPairs = fromList [( "id" :| [] , Integer 42)]
              , tomlTables = fromList []
              , tomlTableArrays = fromList []
              } :|
              [ TOML
                  { tomlPairs = fromList [( "name" :| [] , Text "Foo Bar")]
                  , tomlTables = fromList []
                  , tomlTableArrays = fromList []
                  }
              ]
          )
        ]
    }
@

@since 0.0.0
-}
data TOML = TOML
    { TOML -> HashMap Key AnyValue
tomlPairs       :: !(HashMap Key AnyValue)
    , TOML -> PrefixMap TOML
tomlTables      :: !(PrefixMap TOML)
    , TOML -> HashMap Key (NonEmpty TOML)
tomlTableArrays :: !(HashMap Key (NonEmpty TOML))
    } deriving stock (Int -> TOML -> ShowS
[TOML] -> ShowS
TOML -> String
(Int -> TOML -> ShowS)
-> (TOML -> String) -> ([TOML] -> ShowS) -> Show TOML
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TOML] -> ShowS
$cshowList :: [TOML] -> ShowS
show :: TOML -> String
$cshow :: TOML -> String
showsPrec :: Int -> TOML -> ShowS
$cshowsPrec :: Int -> TOML -> ShowS
Show, TOML -> TOML -> Bool
(TOML -> TOML -> Bool) -> (TOML -> TOML -> Bool) -> Eq TOML
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TOML -> TOML -> Bool
$c/= :: TOML -> TOML -> Bool
== :: TOML -> TOML -> Bool
$c== :: TOML -> TOML -> Bool
Eq, (forall x. TOML -> Rep TOML x)
-> (forall x. Rep TOML x -> TOML) -> Generic TOML
forall x. Rep TOML x -> TOML
forall x. TOML -> Rep TOML x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TOML x -> TOML
$cfrom :: forall x. TOML -> Rep TOML x
Generic)
      deriving anyclass (TOML -> ()
(TOML -> ()) -> NFData TOML
forall a. (a -> ()) -> NFData a
rnf :: TOML -> ()
$crnf :: TOML -> ()
NFData)

-- | @since 0.3
instance Semigroup TOML where
    (<>) :: TOML -> TOML -> TOML
    TOML pairsA :: HashMap Key AnyValue
pairsA tablesA :: PrefixMap TOML
tablesA arraysA :: HashMap Key (NonEmpty TOML)
arraysA <> :: TOML -> TOML -> TOML
<> TOML pairsB :: HashMap Key AnyValue
pairsB tablesB :: PrefixMap TOML
tablesB arraysB :: HashMap Key (NonEmpty TOML)
arraysB = HashMap Key AnyValue
-> PrefixMap TOML -> HashMap Key (NonEmpty TOML) -> TOML
TOML
        (HashMap Key AnyValue
pairsA HashMap Key AnyValue
-> HashMap Key AnyValue -> HashMap Key AnyValue
forall a. Semigroup a => a -> a -> a
<> HashMap Key AnyValue
pairsB)
        ((PrefixTree TOML -> PrefixTree TOML -> PrefixTree TOML)
-> PrefixMap TOML -> PrefixMap TOML -> PrefixMap TOML
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> HashMap k v -> HashMap k v -> HashMap k v
HashMap.unionWith PrefixTree TOML -> PrefixTree TOML -> PrefixTree TOML
forall a. Semigroup a => a -> a -> a
(<>) PrefixMap TOML
tablesA PrefixMap TOML
tablesB)
        (HashMap Key (NonEmpty TOML)
arraysA HashMap Key (NonEmpty TOML)
-> HashMap Key (NonEmpty TOML) -> HashMap Key (NonEmpty TOML)
forall a. Semigroup a => a -> a -> a
<> HashMap Key (NonEmpty TOML)
arraysB)
    {-# INLINE (<>) #-}

-- | @since 0.3
instance Monoid TOML where
    mempty :: TOML
    mempty :: TOML
mempty = HashMap Key AnyValue
-> PrefixMap TOML -> HashMap Key (NonEmpty TOML) -> TOML
TOML HashMap Key AnyValue
forall a. Monoid a => a
mempty PrefixMap TOML
forall a. Monoid a => a
mempty HashMap Key (NonEmpty TOML)
forall a. Monoid a => a
mempty
    {-# INLINE mempty #-}

    mappend :: TOML -> TOML -> TOML
    mappend :: TOML -> TOML -> TOML
mappend = TOML -> TOML -> TOML
forall a. Semigroup a => a -> a -> a
(<>)
    {-# INLINE mappend #-}

-- | Inserts given key-value into the 'TOML'.
insertKeyVal :: Key -> Value a -> TOML -> TOML
insertKeyVal :: Key -> Value a -> TOML -> TOML
insertKeyVal k :: Key
k v :: Value a
v = Key -> AnyValue -> TOML -> TOML
insertKeyAnyVal Key
k (Value a -> AnyValue
forall (t :: TValue). Value t -> AnyValue
AnyValue Value a
v)
{-# INLINE insertKeyVal #-}

-- | Inserts given key-value into the 'TOML'.
insertKeyAnyVal :: Key -> AnyValue -> TOML -> TOML
insertKeyAnyVal :: Key -> AnyValue -> TOML -> TOML
insertKeyAnyVal k :: Key
k av :: AnyValue
av toml :: TOML
toml = TOML
toml { tomlPairs :: HashMap Key AnyValue
tomlPairs = Key -> AnyValue -> HashMap Key AnyValue -> HashMap Key AnyValue
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert Key
k AnyValue
av (TOML -> HashMap Key AnyValue
tomlPairs TOML
toml) }
{-# INLINE insertKeyAnyVal #-}

-- | Inserts given table into the 'TOML'.
insertTable :: Key -> TOML -> TOML -> TOML
insertTable :: Key -> TOML -> TOML -> TOML
insertTable k :: Key
k inToml :: TOML
inToml toml :: TOML
toml = TOML
toml
    { tomlTables :: PrefixMap TOML
tomlTables = Key -> TOML -> PrefixMap TOML -> PrefixMap TOML
forall a. Key -> a -> PrefixMap a -> PrefixMap a
Prefix.insert Key
k TOML
inToml (TOML -> PrefixMap TOML
tomlTables TOML
toml)
    }
{-# INLINE insertTable #-}

-- | Inserts given array of tables into the 'TOML'.
insertTableArrays :: Key -> NonEmpty TOML -> TOML -> TOML
insertTableArrays :: Key -> NonEmpty TOML -> TOML -> TOML
insertTableArrays k :: Key
k arr :: NonEmpty TOML
arr toml :: TOML
toml = TOML
toml
    { tomlTableArrays :: HashMap Key (NonEmpty TOML)
tomlTableArrays = Key
-> NonEmpty TOML
-> HashMap Key (NonEmpty TOML)
-> HashMap Key (NonEmpty TOML)
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert Key
k NonEmpty TOML
arr (TOML -> HashMap Key (NonEmpty TOML)
tomlTableArrays TOML
toml)
    }
{-# INLINE insertTableArrays #-}