{-# LANGUAGE DeriveAnyClass #-}

{- |
Module                  : Toml.Type.TOML
Copyright               : (c) 2018-2022 Kowainik
SPDX-License-Identifier : MPL-2.0
Maintainer              : Kowainik <xrom.xkov@gmail.com>
Stability               : Stable
Portability             : Portable

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

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

       , tomlDiff
       ) 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 Data.List.NonEmpty as NE
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
$cshowsPrec :: Int -> TOML -> ShowS
showsPrec :: Int -> TOML -> ShowS
$cshow :: TOML -> String
show :: TOML -> String
$cshowList :: [TOML] -> ShowS
showList :: [TOML] -> ShowS
Show, TOML -> TOML -> Bool
(TOML -> TOML -> Bool) -> (TOML -> TOML -> Bool) -> Eq TOML
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TOML -> TOML -> Bool
== :: TOML -> TOML -> Bool
$c/= :: TOML -> TOML -> Bool
/= :: 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
$cfrom :: forall x. TOML -> Rep TOML x
from :: forall x. TOML -> Rep TOML x
$cto :: forall x. Rep TOML x -> TOML
to :: forall x. Rep TOML x -> TOML
Generic)
      deriving anyclass (TOML -> ()
(TOML -> ()) -> NFData TOML
forall a. (a -> ()) -> NFData a
$crnf :: TOML -> ()
rnf :: TOML -> ()
NFData)

-- | @since 0.3
instance Semigroup TOML where
    (<>) :: TOML -> TOML -> TOML
    TOML HashMap Key AnyValue
pairsA PrefixMap TOML
tablesA HashMap Key (NonEmpty TOML)
arraysA <> :: TOML -> TOML -> TOML
<> TOML HashMap Key AnyValue
pairsB PrefixMap TOML
tablesB 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 =>
(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 :: forall (a :: TValue). Key -> Value a -> TOML -> TOML
insertKeyVal Key
k 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 Key
k AnyValue
av TOML
toml = TOML
toml { tomlPairs = HashMap.insert k av (tomlPairs toml) }
{-# INLINE insertKeyAnyVal #-}

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

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

{- | Difference of two 'TOML's. Returns elements of the first 'TOML' that are
not existing in the second one.

@since 1.3.2.0
-}
tomlDiff :: TOML -> TOML -> TOML
tomlDiff :: TOML -> TOML -> TOML
tomlDiff TOML
t1 TOML
t2 = TOML
    { tomlPairs :: HashMap Key AnyValue
tomlPairs = HashMap Key AnyValue
-> HashMap Key AnyValue -> HashMap Key AnyValue
forall k v w.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k w -> HashMap k v
HashMap.difference (TOML -> HashMap Key AnyValue
tomlPairs TOML
t1) (TOML -> HashMap Key AnyValue
tomlPairs TOML
t2)
    , tomlTables :: PrefixMap TOML
tomlTables = PrefixMap TOML -> PrefixMap TOML -> PrefixMap TOML
prefixMapDiff (TOML -> PrefixMap TOML
tomlTables TOML
t1) (TOML -> PrefixMap TOML
tomlTables TOML
t2)
    , tomlTableArrays :: HashMap Key (NonEmpty TOML)
tomlTableArrays = (NonEmpty TOML -> NonEmpty TOML -> Maybe (NonEmpty TOML))
-> HashMap Key (NonEmpty TOML)
-> HashMap Key (NonEmpty TOML)
-> HashMap Key (NonEmpty TOML)
forall k v w.
(Eq k, Hashable k) =>
(v -> w -> Maybe v) -> HashMap k v -> HashMap k w -> HashMap k v
HashMap.differenceWith NonEmpty TOML -> NonEmpty TOML -> Maybe (NonEmpty TOML)
interTomlsDiff
        (TOML -> HashMap Key (NonEmpty TOML)
tomlTableArrays TOML
t1)
        (TOML -> HashMap Key (NonEmpty TOML)
tomlTableArrays TOML
t2)
    }
  where
    interTomlsDiff :: NonEmpty TOML -> NonEmpty TOML -> Maybe (NonEmpty TOML)
    interTomlsDiff :: NonEmpty TOML -> NonEmpty TOML -> Maybe (NonEmpty TOML)
interTomlsDiff NonEmpty TOML
tl1 NonEmpty TOML
tl2 = [TOML] -> Maybe (NonEmpty TOML)
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty ([TOML] -> Maybe (NonEmpty TOML))
-> [TOML] -> Maybe (NonEmpty TOML)
forall a b. (a -> b) -> a -> b
$ [TOML] -> [TOML] -> [TOML]
tomlListDiff (NonEmpty TOML -> [TOML]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty TOML
tl1) (NonEmpty TOML -> [TOML]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty TOML
tl2)
{-# INLINE tomlDiff #-}

{- | Difference of two 'PrefixMap's. Returns elements of the first 'PrefixMap'
that are not existing in the second one.

@since 1.3.2.0
-}
prefixMapDiff :: PrefixMap TOML -> PrefixMap TOML -> PrefixMap TOML
prefixMapDiff :: PrefixMap TOML -> PrefixMap TOML -> PrefixMap TOML
prefixMapDiff = (TOML -> TOML -> Maybe TOML)
-> PrefixMap TOML -> PrefixMap TOML -> PrefixMap TOML
forall a b.
(a -> b -> Maybe a) -> PrefixMap a -> PrefixMap b -> PrefixMap a
Prefix.differenceWith ((TOML -> TOML -> Maybe TOML)
 -> PrefixMap TOML -> PrefixMap TOML -> PrefixMap TOML)
-> (TOML -> TOML -> Maybe TOML)
-> PrefixMap TOML
-> PrefixMap TOML
-> PrefixMap TOML
forall a b. (a -> b) -> a -> b
$ \TOML
toml1 TOML
toml2 -> let diff :: TOML
diff = TOML -> TOML -> TOML
tomlDiff TOML
toml1 TOML
toml2 in
    if TOML
diff TOML -> TOML -> Bool
forall a. Eq a => a -> a -> Bool
== TOML
forall a. Monoid a => a
mempty
    then Maybe TOML
forall a. Maybe a
Nothing
    else TOML -> Maybe TOML
forall a. a -> Maybe a
Just TOML
diff


tomlListDiff :: [TOML] -> [TOML] -> [TOML]
tomlListDiff :: [TOML] -> [TOML] -> [TOML]
tomlListDiff [] [TOML]
_ = []
tomlListDiff [TOML]
ts [] = [TOML]
ts
tomlListDiff (TOML
t1:[TOML]
t1s) (TOML
t2:[TOML]
t2s) = let diff :: TOML
diff = TOML -> TOML -> TOML
tomlDiff TOML
t1 TOML
t2 in
    if TOML
diff TOML -> TOML -> Bool
forall a. Eq a => a -> a -> Bool
== TOML
forall a. Monoid a => a
mempty
    then [TOML] -> [TOML] -> [TOML]
tomlListDiff [TOML]
t1s [TOML]
t2s
    else TOML
diff TOML -> [TOML] -> [TOML]
forall a. a -> [a] -> [a]
: [TOML] -> [TOML] -> [TOML]
tomlListDiff [TOML]
t1s [TOML]
t2s