RegistrySpec.hs

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -fno-warn-deprecations #-}
{-# OPTIONS_GHC -fno-warn-missing-signatures #-}

module Test.Data.Registry.RegistrySpec where

import Data.IORef
import Data.Registry
import Protolude as P
import Test.Tasty.Extensions

test_create_value_with_no_args_constructor = prop "no args constructors are considered as functions" $ do
  ref <- liftIO $ newIORef ("" :: Text)
  let registry' = funTo @IO refLogger +: funTo @IO ref +: registry

  Logger {..} <- liftIO $ make @(IO Logger) registry'
  liftIO $ info "hey"

  result <- liftIO $ readIORef ref
  result === "hey"

-- *

newtype Logger = Logger {info :: Text -> IO ()}

newLogger :: IO Logger
newLogger = pure (Logger print)

refLogger :: IORef Text -> Logger
refLogger ref = Logger (writeIORef ref)

registry =
  fun newLogger
    +: end

-- * COMPILATION CHECK WITH THE <: operator

registry1 :: Registry '[] '[Int, Text]
registry1 =
  normalize $
    val (1 :: Int)
      <: (val ("t" :: Text) +: end)
      <: (val ("t" :: Text) +: end)
      <: val ("t" :: Text)

-- * COMPILATION CHECK LIFTING (see #7)

a :: Int -> Int -> IO Int
a _ _ = pure 0

b :: Int -> Int -> RIO Int
b = outTo @RIO liftIO a

c :: RIO Int -> RIO Int -> RIO Int
c = allTo @RIO b

-- here the result of outTo needs to be explicit
-- otherwise the type of d is RIO (Int -> Int -> RIO Int)
d :: RIO Int -> RIO Int -> RIO Int
d = allTo @RIO (outTo @RIO liftIO a :: Int -> Int -> RIO Int)

-- to avoid the issue with type inference above, we can use argsTo
e :: RIO Int -> RIO Int -> RIO Int
e = argsTo @RIO (outTo @RIO liftIO a)