fcf-containers-0.8.2: test/Test/Data/Reflect.hs
{-# LANGUAGE CPP #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -Wall #-}
{-# OPTIONS_GHC -Werror=incomplete-patterns #-}
module Test.Data.Reflect where
import qualified Data.IntMap as IM
import qualified Data.Map as DM
import qualified Data.Set as DS
import qualified Data.Tree as DT
import qualified Data.Text as DTxt
import qualified GHC.TypeLits as TL
import Data.Proxy
import Test.Hspec (describe, it, shouldBe, Spec)
import Fcf (Eval, type (=<<))
import qualified Fcf.Data.Set as FS
import qualified Fcf.Data.NatMap as FNM
import qualified Fcf.Data.MapC as FNMC
#if __GLASGOW_HASKELL__ >= 902
import qualified Fcf.Data.NewText as FTxt
#endif
import qualified Fcf.Data.Tree as FT
import Fcf.Data.Reflect
--------------------------------------------------------------------------------
spec :: Spec
spec = describe "Reflect" $ do
specTrees
specMaybe
specEither
specMaybeEither
specStructures
specShowTypeable
specErrorMessage
specBool :: Spec
specBool = describe "Bool" $ do
it "Bool, True" $ do
let test :: forall r. (r ~ 'True) => Bool
test = fromType (Proxy @r)
test `shouldBe` True
it "Bool, False" $ do
let test :: forall r. (r ~ 'False) => Bool
test = fromType (Proxy @r)
test `shouldBe` False
specMaybe :: Spec
specMaybe = describe "Maybe" $ do
it "Maybe Int, Just" $ do
let test :: forall r. (r ~ 'Just 5)
=> Maybe Int
test = fromType (Proxy @r)
test `shouldBe` Just 5
it "Maybe Int, Nothing" $ do
let test :: forall r. (r ~ 'Nothing)
=> Maybe Int
test = fromType (Proxy @r)
test `shouldBe` Nothing
it "Maybe String, Just" $ do
let test :: forall r. (r ~ 'Just "just")
=> Maybe String
test = fromType (Proxy @r)
test `shouldBe` Just "just"
it "Maybe String, Nothing" $ do
let test :: forall r. (r ~ 'Nothing)
=> Maybe String
test = fromType (Proxy @r)
test `shouldBe` Nothing
specEither :: Spec
specEither = describe "Either" $ do
it "Either Int String, Left" $ do
let test :: forall r. (r ~ 'Left 5)
=> Either Int String
test = fromType (Proxy @r)
test `shouldBe` Left 5
it "Either Int String, Right" $ do
let test :: forall r. (r ~ 'Right "right")
=> Either Int String
test = fromType (Proxy @r)
test `shouldBe` Right "right"
it "Either Int (Either Int String), Right Right" $ do
let test :: forall r. (r ~ 'Right ('Right "right"))
=> Either Int (Either Int String)
test = fromType (Proxy @r)
test `shouldBe` Right (Right "right")
it "Either (Either Int String) String, Left Left" $ do
let test :: forall r. (r ~ 'Left ('Left 5))
=> Either (Either Int String) String
test = fromType (Proxy @r)
test `shouldBe` Left (Left 5)
specMaybeEither :: Spec
specMaybeEither = describe "Maybe Either and Either Maybe" $ do
it "Either Int (Maybe String), Right Just" $ do
let test :: forall r. (r ~ 'Right ('Just "right just"))
=> Either Int (Maybe String)
test = fromType (Proxy @r)
test `shouldBe` Right (Just "right just")
it "Either Int (Maybe String), Right Nothing" $ do
let test :: forall r. (r ~ 'Right 'Nothing)
=> Either Int (Maybe String)
test = fromType (Proxy @r)
test `shouldBe` Right Nothing
it "Maybe (Either Int String), Just Right" $ do
let test :: forall r. (r ~ 'Just ('Right "just right"))
=> Maybe (Either Int String)
test = fromType (Proxy @r)
test `shouldBe` Just (Right "just right")
it "Maybe (Either Int String), Nothing" $ do
let test :: forall r. (r ~ 'Nothing)
=> Maybe (Either Int String)
test = fromType (Proxy @r)
test `shouldBe` Nothing
specStructures :: Spec
specStructures = describe "Maps and other structures" $ do
describe "[]" $ do
it "[]" $ do
let test :: forall r. (r ~ '[]) => [()]
test = fromType (Proxy @r)
test `shouldBe` []
it "[(Bool,Int)]" $ do
let test :: forall r. (r ~ '[ '( 'True,5), '( 'False,6)]) => [(Bool,Int)]
test = fromType (Proxy @r)
test `shouldBe` [(True,5),(False,6)]
describe "IntMap" $ do
#if __GLASGOW_HASKELL__ >= 920
it "IntMap char, from '[ '(Nat,Char) ]" $ do
let test :: forall r. (r ~ '[ '(1,'H'), '(2,'e'), '(5,'o'), '(3,'b'), '(4,'l'), '(3,'l')]) => IM.IntMap Char
test = fromType (Proxy @r)
test `shouldBe` IM.fromList [(1,'H'),(2,'e'),(5,'o'),(4,'l'),(3,'l')]
#endif
it "IntMap String, from NatMap" $ do
let test :: forall r. (r ~ Eval (FNM.FromList '[ '(1,"H"), '(4,"b"), '(2,"e"), '(5,"o"), '(4,"l"), '(3,"l")])) => IM.IntMap String
test = fromType (Proxy @r)
test `shouldBe` IM.fromList [(2,"e"),(1,"H"),(4,"l"),(3,"l"),(5,"o")]
it "IntMap String, with insert" $ do
let test :: forall r. (r ~ Eval (
FNM.Insert 3 "hih" =<< FNM.FromList '[ '(1,"haa"), '(2,"hoo")]
))
=> IM.IntMap String
test = fromType (Proxy @r)
test
`shouldBe`
IM.fromList [ (3, "hih"), (1, "haa"), (2, "hoo")]
describe "Map" $ do
#if __GLASGOW_HASKELL__ >= 920
it "Map Int char, from '[ '(Nat,Char) ]" $ do
let test :: forall r. (r ~ '[ '(1,'H'), '(2,'e'), '(5,'o'), '(4,'l'), '(3,'b'), '(3,'l')]) => DM.Map Int Char
test = fromType (Proxy @r)
test `shouldBe` DM.fromList [(1,'H'),(2,'e'),(5,'o'),(4,'l'),(3,'l')]
#endif
it "Map Int String, from MapC" $ do
let test :: forall r. (r ~ Eval (FNMC.FromList '[ '(1,"H"), '(2,"e"), '(3,"c"), '(5,"o"), '(4,"l"), '(3,"l")])) => DM.Map Int String
test = fromType (Proxy @r)
test `shouldBe` DM.fromList [(2,"e"),(1,"H"),(4,"l"),(3,"l"),(5,"o")]
it "Map Int String, with insert" $ do
let test :: forall r. (r ~ Eval (
FNMC.Insert 3 "hih" =<< FNMC.FromList '[ '(1,"haa"), '(2,"hoo")]
))
=> DM.Map Int String
test = fromType (Proxy @r)
test
`shouldBe`
DM.fromList [ (3, "hih"), (1, "haa"), (2, "hoo")]
describe "Set" $ do
#if __GLASGOW_HASKELL__ >= 920
it "Set char, from '[Char]" $ do
let test :: forall r. (r ~ '[ 'H','e','o','l','l' ]) => DS.Set Char
test = fromType (Proxy @r)
test `shouldBe` DS.fromList ['H','e','o','l','l']
#endif
it "Set String, from Set" $ do
let test :: forall r. (r ~ Eval (FS.FromList '["H","e","o","l","l"])) => DS.Set String
test = fromType (Proxy @r)
test `shouldBe` DS.fromList ["e","H","l","l","o"]
it "Set Int" $ do
let test :: forall r. (r ~ Eval (FS.FromList '[5, 9, 1, 8, 3, 5]))
=> DS.Set Int
test = fromType (Proxy @r)
test
`shouldBe`
DS.fromList [1, 3, 5, 8, 9]
#if __GLASGOW_HASKELL__ >= 902
it "text" $ do
let test :: forall r. (r ~ 'FTxt.Text "trial") => DTxt.Text
test = fromType (Proxy @r)
test
`shouldBe`
DTxt.pack "trial"
#endif
type ExTr1 =
'FT.Node 1
'[ 'FT.Node 2
'[ 'FT.Node 3 '[ 'FT.Node 4 '[]]]
, 'FT.Node 5 '[ 'FT.Node 6 '[]]
]
type ExTr2 =
'FT.Node ('Just 1)
'[ 'FT.Node ('Just 2)
'[ 'FT.Node ('Just 3)
'[ 'FT.Node ('Just 4) '[]]
]
, 'FT.Node ('Just 5)
'[ 'FT.Node ('Just 6) '[]
]
]
type ExTr3 =
'FT.Node ('Just 1)
'[ 'FT.Node ('Just 2)
'[ 'FT.Node ('Just 3)
'[ 'FT.Node ('Just 4) '[]]
]
, 'FT.Node ('Just 5)
'[ 'FT.Node 'Nothing '[]
]
]
type ExTr4 =
'FT.Node ('Left 1)
'[ 'FT.Node ('Right "two")
'[ 'FT.Node ('Left 3)
'[ 'FT.Node ('Right "four") '[]]
]
, 'FT.Node ('Left 5)
'[ 'FT.Node ('Right "six") '[]
]
]
specTrees :: Spec
specTrees = describe "Tree structures" $ do
it "tree 1" $ do
let test :: forall r. (r ~ ExTr1)
=> DT.Tree Int
test = fromType (Proxy @r)
test
`shouldBe`
DT.Node 1 [DT.Node 2 [DT.Node 3 [DT.Node 4 []]], DT.Node 5 [DT.Node 6 []]]
it "tree 2" $ do
let test :: forall r. (r ~ ExTr2)
=> DT.Tree (Maybe Int)
test = fromType (Proxy @r)
test
`shouldBe`
DT.Node (Just 1)
[ DT.Node (Just 2)
[ DT.Node (Just 3)
[ DT.Node (Just 4) []
]
]
, DT.Node (Just 5)
[DT.Node (Just 6) []
]
]
it "tree 3" $ do
let test :: forall r. (r ~ ExTr3)
=> DT.Tree (Maybe Int)
test = fromType (Proxy @r)
test
`shouldBe`
DT.Node (Just 1)
[ DT.Node (Just 2)
[ DT.Node (Just 3)
[ DT.Node (Just 4) []
]
]
, DT.Node (Just 5)
[DT.Node Nothing []
]
]
it "tree 4" $ do
let test :: forall r. (r ~ ExTr4)
=> DT.Tree (Either Int String)
test = fromType (Proxy @r)
test
`shouldBe`
DT.Node (Left 1)
[ DT.Node (Right "two")
[ DT.Node (Left 3)
[ DT.Node (Right "four") []
]
]
, DT.Node (Left 5)
[DT.Node (Right "six") []
]
]
specShowTypeable :: Spec
specShowTypeable = describe "Show Type represented at the Kind level" $ do
it "Show Int" $ do
fromType @String (Proxy @Int)
`shouldBe`
"Int"
it "Show Set of Types" $ do
let test :: forall r. (r ~ Eval (FS.FromList '[Int, Maybe String, (), [Integer], IO ()]))
=> DS.Set String
test = fromType (Proxy @r)
test
`shouldBe`
DS.fromList ["Int", "Maybe [Char]", "()", "[Integer]", "IO ()"]
specErrorMessage :: Spec
specErrorMessage = describe "show GHC.TypeLits.ErrorMessage" $ do
it "text error" $ do
(fromType @DTxt.Text $ Proxy @('TL.Text "I am error"))
`shouldBe`
DTxt.pack "I am error"
it "ShowType 'True" $ do
(fromType @DTxt.Text $ Proxy @('TL.ShowType '()))
`shouldBe`
DTxt.pack "'()"
it "with Kinds" $ do
(fromType @DTxt.Text $ Proxy @('TL.Text "Kind: " 'TL.:<>: 'TL.ShowType 'True 'TL.:$$: 'TL.Text "Type: " 'TL.:<>: 'TL.ShowType Bool))
`shouldBe`
DTxt.pack "Kind: 'True\nType: Bool"