dep-t-value-0.1.0.0: test/tests.hs

{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Main where

import Test.Tasty
import Test.Tasty.HUnit

import Dep.Env
import Dep.Value
import Dep.Value.Cached
import Dep.Value.JSON
import Dep.Value.Text
import Dep.Loader
import Data.Functor.Identity
import Data.Text
import Data.ByteString
import GHC.Generics qualified as G
import Data.IORef
import Control.Exception
import Control.Monad.Trans.Cont

-- Orphan instance, just for tests.
deriving anyclass instance FromResource (Identity Text)

tests :: TestTree
tests =
  testGroup
    "All"
    [    
        testCase "loadUtf8" textResourceLoads,
        testCase "loadUtf8Precedence" textResourcePrecedence,
        testCase "valueIsCached" valueIsCached
    ]

textResourceLoads :: Assertion
textResourceLoads = do
    let loader :: Loader ByteString IO 
        loader = dataDirLoader ["zzz","txt"] $ dataDir "test" `extendDataDir` "conf"
        v = Dep.Value.Text.fromUtf8 Identity (load @(Identity Text) loader)
    Identity txt <- value v
    assertEqual "text loaded correctly" (Data.Text.pack "Lorem Ipsum") txt

textResourcePrecedence :: Assertion
textResourcePrecedence = do
    let loader :: Loader ByteString IO 
        loader = dataDirLoader ["zzz","txt"] (dataDir "test" `extendDataDir` "conf2")
                 <> dataDirLoader ["zzz","txt"] (dataDir "test" `extendDataDir` "conf")
        v = Dep.Value.Text.fromUtf8 Identity (load @(Identity Text) loader)
    Identity txt <- value v
    assertEqual "text loaded correctly" (Data.Text.pack "alternative text") txt

valueIsCached :: Assertion
valueIsCached = do
  let bombs = pure () : repeat (throwIO $ userError "boom!")
  bombsRef <- newIORef @[IO ()] bombs
  let attempt = do
        action <- atomicModifyIORef bombsRef \(b : bs) -> (bs, b)
        action
  runContT allocateRef \valueRef -> do
    let v :: Value () IO = Dep.Value.Cached.cache valueRef $ Value attempt
    () <- value v
    () <- value v
    pure ()

main :: IO ()
main = defaultMain tests