git.iko.soy/typeable/ether
on eaa9635 help sign in
typeable/ether/test/Regression.hs
60 lines 1.8 kB history raw
1{-# LANGUAGE TypeFamilies #-}
2{-# LANGUAGE FlexibleContexts #-}
3{-# LANGUAGE EmptyDataDecls #-}
4{-# LANGUAGE TemplateHaskell #-}
5{-# LANGUAGE ConstraintKinds #-}
6module Main where
8import Control.Ether.TH
9import Control.Monad.Ether.Reader
11import Data.Proxy
12import Data.Functor.Identity
14import Test.Tasty
15import Test.Tasty.QuickCheck
16import Test.QuickCheck.Function
18etherealReader "AmountTag" "runAmountT" "askAmount" ''Int
19type MonadAmount = MonadEtherReader AmountTag
21etherealReader "CountTag" "runCountT" "askCount" ''Integer
22type MonadCount = MonadEtherReader CountTag
24main :: IO ()
25main = defaultMain suite
27suite :: TestTree
28suite = testGroup "Ether"
29 [ testGroup "EtherReaderT"
30 [ testProperty "layered sum (local left)" layeredLocalLeft
31 , testProperty "layered sum (local right)" layeredLocalRight
32 ]
33 ]
35layeredLocalLeft, layeredLocalRight
36 :: Fun (Int, Integer) Integer -> Fun Integer Integer -> Int -> Integer -> Property
38layeredLocalLeft k f a1 a2 = property (direct == indirect)
39 where
40 run = runIdentity . flip runAmountT a1 . flip runCountT a2
41 direct = apply k (fromIntegral a1, apply f a2)
42 indirect = run $ layeredLocalCore (apply f) (\n m -> apply k (fromIntegral n, m))
44layeredLocalRight k f a1 a2 = property (direct == indirect)
45 where
46 run = runIdentity . flip runCountT a2 . flip runAmountT a1
47 direct = apply k (fromIntegral a1, apply f a2)
48 indirect = run $ layeredLocalCore (apply f) (\n m -> apply k (fromIntegral n, m))
50layeredLocalCore
51 :: (MonadAmount m, MonadCount m)
52 => (Integer -> Integer) -> (Int -> Integer -> a) -> m a
53layeredLocalCore f g = do
54 n <- askAmount
55 m <- etherLocal (Proxy :: Proxy CountTag) f askCount
56 return (g n m)
58-- this should not compile
59z :: IO Int
60z = runAmountT (runAmountT (runAmountT askAmount 20) 10) 5