configifier-0.1.0: tests/Data/ConfigifierSpec.hs
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverlappingInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-}
module Data.ConfigifierSpec
where
import Control.Exception
import Data.Either
import Data.Monoid
import Data.Proxy
import Data.String.Conversions
import Test.Hspec
import qualified Data.Aeson as Aeson
import Data.Configifier as Configifier
import Test.Arbitrary ()
tests :: IO ()
tests = hspec spec
spec :: Spec
spec = describe "Configifier" $ do
miscSpec
selectSpec
mergeSpec
sourcesSpec
readUserConfigFilesSpec
stringAsCharList
miscSpec :: Spec
miscSpec = do
describe "misc" $ do
it "simple" $
let text :: SBS
want :: (c ~ ToConfigCode ("bla" :> Int)) => Tagged c
text = "bla: 3"
want = Tagged $ Id 3
in run text want
it "descriptions" $
let text :: SBS
want :: ( c ~ ToConfigCode ("bla" :> Int :>: "describe stuff!")
) => Tagged c
text = "bla: 3"
want = Tagged $ Id 3
in run text want
it "option" $
let text :: SBS
want :: (c ~ ToConfigCode (Maybe ("bla" :> Int))) => Tagged c
text = "bla: 3"
want = Tagged $ JustO (Id 3)
in run text want
it "option, no sources" $
let have :: (c ~ ToConfigCode (Maybe ("bla" :> Int))) => IO (Tagged c)
want :: (c ~ ToConfigCode (Maybe ("bla" :> Int))) => Tagged c
have = configify []
want = Tagged NothingO
in have >>= (`shouldBe` want)
it "yaml cannot parse empty cfg files (even if all config data is optional!)" $
let text1, text2, text3 :: SBS
text1 = ""
text2 = " \n\t \n\t"
text3 = " \n\t# comments are also nothing\n\t\n...\n"
want :: (c ~ ToConfigCode (Maybe ("bla" :> Int))) => Either Error (TaggedM c) -> Bool
want = isLeft
f sbs = parseConfigFile sbs `shouldSatisfy` want
in mapM_ f [text1, text2, text3]
it "option, missing in non-empty cfg file" $
let text :: SBS
want :: (c ~ ToConfigCode ("org" :> Int :*> Maybe ("bla" :> Int))) => Tagged c
text = "org: 3"
want = Tagged (Id 3 :*> NothingO)
in run text want
it "something more nested" $
let text1, text2 :: SBS
want1, want2 ::
( c ~ ToConfigCode c'
, c' ~ ("frontend" :> sc :*> Maybe ("backend" :> sc))
, sc ~ ("bind_port" :> Int :*> Maybe ("expose_host" :> ST))
) => Tagged c
text1 = cs . unlines $
"frontend:" :
" bind_port: 3" :
" expose_host: host" :
"backend:" :
" bind_port: 4" :
" expose_host: hist" :
[]
text2 = cs . unlines $
"frontend:" :
" bind_port: 3" :
[]
want1 = Tagged $ Id (Id 3 :*> JustO (Id "host"))
:*> JustO (Id (Id 4 :*> JustO (Id "hist")))
want2 = Tagged $ Id (Id 3 :*> NothingO)
:*> NothingO
in run text1 want1 >> run text2 want2
it "lists" $
let text :: SBS
want :: ( c ~ ToConfigCode ("bla" :> [Bool])
) => Tagged c
text = "bla: [yes, no]"
want = Tagged $ Id [True, False]
in run text want
run :: forall cfg tm ti .
( tm ~ TaggedM cfg
, ti ~ Tagged cfg
, Show tm, Eq tm, Show ti, Eq ti
, Monoid tm
, Freeze cfg
, Aeson.FromJSON tm
, Aeson.ToJSON tm
, HasParseShellEnv cfg
, HasParseCommandLine cfg
, CanonicalizePartial cfg
) => SBS -> ti -> IO ()
run text parsedWant = do
let f :: SBS -> IO ti
f sbs = configify [YamlString sbs]
f text >>= (`shouldBe` parsedWant)
f (renderConfigFile parsedWant) >>= (`shouldBe` parsedWant)
selectSpec :: Spec
selectSpec = do
describe "select" $ do
it "(\"l\" :> Int)" $
let t :: forall c . (c ~ ToConfigCode ("l" :> Int)) => IO ()
t = cfg >>. (Proxy :: Proxy '["l"]) `shouldBe` 3
where
cfg :: Tagged c = Tagged $ Id 3
in t
it "(\"l\" :> (\"l'\" :> Bool))" $
let t :: forall c . (c ~ ToConfigCode ("l" :> ("l'" :> Bool))) => IO ()
t = do
cfg >>. (Proxy :: Proxy '["l"]) `shouldBe` Id False
cfg >>. (Proxy :: Proxy '["l", "l'"]) `shouldBe` False
where
cfg :: Tagged c = Tagged . Id . Id $ False
in t
it "(\"l\" :> Int :*> \"l'\" :> Bool)" $
let t :: forall c . (c ~ ToConfigCode ("l" :> Int :*> "l'" :> Bool)) => IO ()
t = do
cfg >>. (Proxy :: Proxy '["l"]) `shouldBe` 0
cfg >>. (Proxy :: Proxy '["l'"]) `shouldBe` False
where
cfg :: Tagged c = Tagged $ Id 0 :*> Id False
in t
it "(Maybe (\"l\" :> Int))" $
let t :: forall c . (c ~ ToConfigCode (Maybe ("l" :> Int))) => IO ()
t = do
cfg >>. (Proxy :: Proxy '["l"]) `shouldBe` Just 0
where
cfg :: Tagged c = Tagged $ JustO (Id 0)
in t
it "(Maybe (\"l\" :> Maybe (\"l'\" :> Int)))" $
let t :: forall c . (c ~ ToConfigCode (Maybe ("l" :> Maybe ("l'" :> Int)))) => IO ()
t = do
cfg1 >>. (Proxy :: Proxy '["l", "l'"]) `shouldBe` Just (Just 0)
cfg2 >>. (Proxy :: Proxy '["l", "l'"]) `shouldBe` Just Nothing
cfg3 >>. (Proxy :: Proxy '["l", "l'"]) `shouldBe` Nothing
where
cfg1 :: Tagged c = Tagged $ JustO (Id (JustO (Id 0)))
cfg2 :: Tagged c = Tagged $ JustO (Id NothingO)
cfg3 :: Tagged c = Tagged $ NothingO
in t
it "(\"l\" :> Int :*> \"l'\" :> Int)" $
let t :: forall c . ( c ~ ToConfigCode ("l" :> Int :*> "l'" :> Int)
, ToVal c '["l"] ~ 'Just Int -- (redundant)
, ToConfig c Id ~ (Id Int :*> Id Int) -- (redundant)
) => IO ()
t = do
cfg1 >>. (Proxy :: Proxy '["l"]) `shouldBe` 3
cfg1 >>. (Proxy :: Proxy '["l'"]) `shouldBe` 0
cfg2 >>. (Proxy :: Proxy '["l'"]) `shouldBe` 0
where
cfg1 :: Tagged c = Tagged $ Id 3 :*> Id (0 :: Int)
cfg2 :: Tagged c = Tagged $ Id 4 :*> Id (0 :: Int)
in t
it "(\"l\" :> Int :*> Maybe (\"l'\" :> Int))" $
let t :: forall c . ( c ~ ToConfigCode ("l" :> Int :*> Maybe ("l'" :> Int))
, ToVal c '["l"] ~ 'Just Int -- (redundant)
, ToConfig c Id ~ (Id Int :*> MaybeO (Id Int)) -- (redundant)
) => IO ()
t = do
cfg1 >>. (Proxy :: Proxy '["l"]) `shouldBe` 3
cfg1 >>. (Proxy :: Proxy '["l'"]) `shouldBe` (Just 0)
cfg2 >>. (Proxy :: Proxy '["l'"]) `shouldBe` Nothing
where
cfg1 :: Tagged c = Tagged $ Id 3 :*> JustO (Id (0 :: Int))
cfg2 :: Tagged c = Tagged $ Id 4 :*> NothingO
in t
it "partial select paths and non-leaf sub-configs" $
let t :: forall config config' ponfig ponfig' .
( config ~ Tagged (ToConfigCode config')
, config' ~ (Maybe ("a" :> ST) :*> ("b" :> ST))
, ponfig ~ Tagged (ToConfigCode ponfig')
, ponfig' ~ ("c" :> config')
) => IO ()
t = do
cfg1 :: ponfig <- configify [YamlString . cs . unlines $
"c:" :
" a: goih" :
" b: c38" :
"..." :
[]]
Tagged cfg2 :: config <- configify [YamlString . cs . unlines $
"a: goih" :
"b: c38" :
"..." :
[]]
(cfg1 >>. (Proxy :: Proxy '["c"])) `shouldBe` cfg2
in t
mergeSpec :: Spec
mergeSpec = describe "instance Monoid (ToConfigCode *)" $
let cfg1, cfg2, cfg3, cfg4, cfg5 ::
( c ~ ToConfigCode c'
, c' ~ Maybe ("frontend" :> sc' :*> Maybe ("backend" :> sc'))
, sc' ~ ("bind_port" :> Int :*> Maybe ("expose_host" :> ST))
) => TaggedM c
cfg1 = TaggedM . JustO $
Just (Just 3 :*> JustO (Just "host"))
:*> JustO (Just (Just 4 :*> JustO (Just "hist")))
cfg2 = TaggedM . JustO $
Just (Just 3 :*> NothingO)
:*> JustO (Just (Just 4 :*> NothingO))
cfg3 = TaggedM . JustO $
Just (Just 3 :*> NothingO)
:*> NothingO
cfg4 = TaggedM NothingO
cfg5 = TaggedM . JustO $
Just (Just 1 :*> JustO (Just "ast"))
:*> JustO (Just (Just 5 :*> JustO (Just "hust")))
in do
-- JustO wins over NothingO
it "1" $ (cfg1 <> cfg1) `shouldBe` cfg1
it "2" $ (cfg1 <> cfg2) `shouldBe` cfg1
it "3" $ (cfg1 <> cfg3) `shouldBe` cfg1
it "4" $ (cfg1 <> cfg4) `shouldBe` cfg1
it "5" $ (cfg2 <> cfg1) `shouldBe` cfg1
it "6" $ (cfg3 <> cfg1) `shouldBe` cfg1
it "7" $ (cfg4 <> cfg1) `shouldBe` cfg1
-- right JustO wins over left JustO
it "8" $ (cfg1 <> cfg5) `shouldBe` cfg5
sourcesSpec :: Spec
sourcesSpec = describe "sources" $
let f :: ( c ~ ToConfigCode c'
, c' ~ ("frontend" :> sc :*> Maybe ("backend" :> sc))
, sc ~ ("bind_port" :> Int :*> Maybe ("expose_host" :> ST))
) => [Source] -> IO (Tagged c)
f = configify
configFile1 :: Source = YamlString . cs . unlines $
"frontend:" :
" bind_port: 3" :
" expose_host: host" :
"backend:" :
" bind_port: 4" :
" expose_host: hist" :
[]
configFile2 :: Source = YamlString . cs . unlines $
"frontend:" :
" bind_port: 3" :
[]
shellEnv1 :: Source = ShellEnv [("FRONTEND_BIND_PORT", "18")]
shellEnv2 :: Source = ShellEnv [("BACKEND_EXPOSE_HOST", "bom")]
commandLine1 :: Source = CommandLine ["--frontend-bind-port", "31"]
commandLine2 :: Source = CommandLine ["--backend-expose-host=mab", "--backend-bind-port=8710"]
in do
it "parseArgs" $
parseArgs (["--arg=31", "--flob", "gluh"] :: Args) `shouldBe` Right ([("ARG", "31"), ("FLOB", "gluh")] :: Env)
it "1" $
f [configFile1] >>= (`shouldBe`
(Tagged $ Id (Id 3 :*> JustO (Id "host"))
:*> JustO (Id (Id 4 :*> JustO (Id "hist")))))
it "2" $
f [configFile1, shellEnv1, shellEnv2] >>= (`shouldBe`
(Tagged $ Id (Id 18 :*> JustO (Id "host"))
:*> JustO (Id (Id 4 :*> JustO (Id "bom")))))
it "3" $
f [configFile1, shellEnv1, shellEnv2, commandLine1] >>= (`shouldBe`
(Tagged $ Id (Id 31 :*> JustO (Id "host"))
:*> JustO (Id (Id 4 :*> JustO (Id "bom")))))
it "4" $
f [configFile2, commandLine2] >>= (`shouldBe`
(Tagged $ Id (Id 3 :*> NothingO)
:*> JustO (Id (Id 8710 :*> JustO (Id "mab")))))
readUserConfigFilesSpec :: Spec
readUserConfigFilesSpec = describe "readUserConfigFiles" $ do
it "finds --config args" $
readUserConfigFiles [CommandLine ["--config=FILE"]] `shouldBe` [YamlFile True "FILE"]
it "keeps surrounding args intact" $ do
readUserConfigFiles [CommandLine ["1", "2", "--config=FILE", "3", "4"]] `shouldBe`
[CommandLine ["1", "2"], YamlFile True "FILE", CommandLine ["3", "4"]]
readUserConfigFiles [CommandLine ["--config=FILE", "2"]] `shouldBe`
[YamlFile True "FILE", CommandLine ["2"]]
readUserConfigFiles [CommandLine ["1", "--config=FILE"]] `shouldBe`
[CommandLine ["1"], YamlFile True "FILE"]
stringAsCharList :: Spec
stringAsCharList = describe "a field of type String" $ do
it "somewhat unexpectedly fails when being presented a String" $
(configify [YamlString "x: wef\ny: ofs"]
:: IO (Tagged (ToConfigCode ("x" :> ST :*> "y" :> String))))
`shouldThrow` (\case (SomeException _) -> True)
it "wants a list of chars!" $ do
config :: Tagged (ToConfigCode ("x" :> ST :*> "y" :> String))
<- configify [YamlString "x: wef\ny:\n- o\n- f\n- s"]
config `shouldBe` (Tagged $ Id "wef" :*> Id "ofs")