MakeSpec.hs

{-# LANGUAGE DataKinds #-}
{-# OPTIONS_GHC -fno-warn-missing-signatures #-}

module Test.Data.Registry.Make.MakeSpec where

import           Data.Registry
import           Data.Text             as T (length)
import           Protolude
import           Test.Tasty.Extensions

-- | Effectful creation with lifting
test_lifted = test "functions can be lifted in order to participate in building instances" $ do
  f1 <- liftIO $
    do let r =    funTo @IO newF1
               <: valTo @IO (1::Int)
               <: valTo @IO ("hey"::Text)

       make @(IO F1) r

  f1 === F1 1 "hey"

data F1 = F1 Int Text deriving (Eq, Show)

newF1 :: Int -> Text -> IO F1
newF1 i t = pure (F1 i t)

----

test_cycle = test "cycle can be detected" $ do
  -- a registry with 2 functions inverse of each other
  let explosive = make @Text (registerUnchecked (fun add1) $ registerUnchecked (fun dda1) end)
  r <- liftIO $ try (print explosive)
  case r of
    Left (_ :: SomeException) -> assert True
    Right _                   -> assert False

add1 :: Int -> Text
add1 i = show (i + 1)

-- inverse of add1 (in terms of type signature)
dda1 :: Text -> Int
dda1 = T.length

-- test coerce
r1 = end
  <: fun dda1
  <: val ("" :: Text)

r2 :: Registry '[Text] '[Int, Text]
r2 = normalize $ end
  <: fun dda1
  <: val (1 :: Int)
  <: val ("" :: Text)

r3 :: Registry '[Text, Text, Text] '[Int, Int, Int, Text]
r3 = fun dda1 <: fun dda1 <: r2

r4 :: Registry '[Text, Text, Text] '[Int, Int, Int, Text]
r4 =
   if True then
     r3
   else
     safeCoerce r2