TH.hs

{-# LANGUAGE TemplateHaskell #-}
module Tests.TH where

import Test.Tasty (TestTree, testGroup)
import Test.Tasty.QuickCheck (testProperty)

import Control.Monad.Freer (Eff, run, interpret, type(~>))
import Control.Monad.Freer.TH (makeEffect)

-- Create a test GADT for our effects.
data Prepender next where
  PrependSomething :: String -> Prepender String

-- Make TH generate our effect functions.
makeEffect ''Prepender

tests :: TestTree
tests = testGroup
  "TH tests"
  [ testProperty "Prepender uses generated effects"
      $ \s -> testGeneratedFunction s == ("prepended: " ++ s)
  ]

--------------------------------------------------------------------------------
                            -- Examples --
--------------------------------------------------------------------------------
runPrepender :: Eff (Prepender ': effs) ~> Eff effs
runPrepender = interpret
  (\case
  PrependSomething s -> pure $ "prepended: " ++ s
  )

testGeneratedFunction :: String -> String
testGeneratedFunction s = run . runPrepender $ prependSomething s

-- Create a more complicated test GADT
data Complicated a where
  Mono :: Int -> Complicated Bool
  Poly :: a -> Complicated a
  PolyIn :: a -> Complicated Bool
  PolyOut :: Int -> Complicated a
  Lots :: a -> b -> c -> d -> e -> f -> Complicated ()
  Nested :: Maybe b -> Complicated (Maybe a)
  MultiNested :: (Maybe a, [b]) -> Complicated (Maybe a, [b])
  Existential :: (forall e. e -> Maybe e) -> Complicated a
  LotsNested :: Maybe a -> [b] -> (c, c) -> Complicated (a, b, c)
  Dict :: (Ord a) => a -> Complicated a
  MultiDict :: (Eq a, Ord b, Enum a, Num c) => a -> b -> c -> Complicated ()

-- Make TH generate our effect functions.
makeEffect ''Complicated