SourceSpec.hs

module Cfg.SourceSpec where

import Cfg.Deriving.Config
import Cfg.Deriving.KeyModifier
import Cfg.Deriving.Value
import Cfg.Options
import Cfg.Parser
import Cfg.Source
import Cfg.Source.Default
import Data.Map.Strict (empty, fromList, singleton)
import Data.Text (Text)
import GHC.Generics (Generic (..))
import KeyTree
import Test.Hspec

spec :: Spec
spec = do
  describe "configSource" $ do
    it "should create a tree from the sample config" $ do
      let
        expected =
          Free $
            fromList
              [ ("key1", Free empty)
              ,
                ( "key2"
                , Free $
                    fromList
                      [ ("subKey1", Free empty)
                      , ("subKey2", Free empty)
                      , ("subKey3", Free empty)
                      ]
                )
              , ("key3", Free empty)
              , ("key4", Free empty)
              ]
      configSource @(RootTyCon Text) `shouldBe` expected
    it "should create a tree with modified options from sample config" $ do
      let
        expected =
          Free $
            singleton "ROOTTYCONOPTS" $
              Free $
                fromList
                  [ ("keyopts1", Free empty)
                  ,
                    ( "keyopts2"
                    , Free $
                        fromList
                          [ ("SUBKEYOPTS1", Free empty)
                          , ("SUBKEYOPTS2", Free empty)
                          , ("SUBKEYOPTS3", Free empty)
                          ]
                    )
                  , ("keyopts3", Free empty)
                  , ("keyopts4", Free empty)
                  ]
      configSource @(RootTyConOpts Text) `shouldBe` expected
    it "should create a tree with modified options from sample config AND respect defaults" $ do
      let
        expected =
          Free $
            singleton "ROOTTYCONOPTSDEF" $
              Free $
                fromList
                  [ ("keyoptsdef1", Pure "Case1")
                  ,
                    ( "keyoptsdef2"
                    , Free $
                        fromList
                          [ ("SUBKEYOPTS1", Free empty)
                          , ("SUBKEYOPTS2", Free empty)
                          , ("SUBKEYOPTS3", Free empty)
                          ]
                    )
                  , ("keyoptsdef3", Free empty)
                  , ("keyoptsdef4", Free empty)
                  ]
      configSource @(RootTyConOptsDef Text) `shouldBe` expected

data SumTypeConfig = Case1 | Case2
  deriving (Generic, Show, DefaultSource)
  deriving (ConfigSource) via Value SumTypeConfig

data SubTyCon = SubDataCon
  { subKey1 :: Text
  , subKey2 :: Int
  , subKey3 :: Maybe Bool
  }
  deriving (Generic, Show, DefaultSource)
  deriving (ConfigSource) via (Config SubTyCon)

data RootTyCon a = RootDataCon
  { key1 :: SumTypeConfig
  , key2 :: SubTyCon
  , key3 :: Int
  , key4 :: a
  }
  deriving (Generic, Show, DefaultSource)
  deriving (ConfigSource) via (Config (RootTyCon a))

data SubTyConOpts = SubDataConOpts
  { subKeyOpts1 :: Text
  , subKeyOpts2 :: Int
  , subKeyOpts3 :: Maybe Bool
  }
  deriving (Generic, Show, DefaultSource)
  deriving (ConfigSource) via (ConfigOpts ToUpper SubTyConOpts)

data RootTyConOpts a = RootDataConOpts
  { keyOpts1 :: SumTypeConfig
  , keyOpts2 :: SubTyConOpts
  , keyOpts3 :: Int
  , keyOpts4 :: a
  }
  deriving (Generic, Show, DefaultSource)
  deriving (ConfigSource) via (ConfigRoot ('TypeName ToUpper) ToLower (RootTyConOpts a))

data RootTyConOptsDef a = RootTyConOptsDef
  { keyOptsDef1 :: SumTypeConfig
  , keyOptsDef2 :: SubTyConOpts
  , keyOptsDef3 :: Int
  , keyOptsDef4 :: a
  }
  deriving (Generic, Show)
  deriving (ConfigSource) via (ConfigRoot ('TypeName ToUpper) ToLower (RootTyConOptsDef a))

instance DefaultSource (RootTyConOptsDef a) where
  defaults "keyOptsDef1" = Just "Case1"
  defaults _ = Nothing