feat(module): add some type level module

lib/Data/Proxy.hm

@@ -0,0 +1,18 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  System.File
+-- Copyright   :  (c) 2020-2021 EMQ Technologies Co., Ltd.
+-- License     :  BSD-style (see the LICENSE file)
+--
+-- Maintainer  :  Feng Lee, [email protected]
+--                Yang M, [email protected]
+--                firest, [email protected]
+-- Stability   :  experimental
+-- Portability :  portable
+--
+-- The Proxy module.
+--
+-----------------------------------------------------------------------------
+module Data.Proxy where
+
+data Proxy a = Proxy

lib/Unsafe/Union.hm

@@ -0,0 +1,25 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  System.File
+-- Copyright   :  (c) 2020-2021 EMQ Technologies Co., Ltd.
+-- License     :  BSD-style (see the LICENSE file)
+--
+-- Maintainer  :  Feng Lee, [email protected]
+--                Yang M, [email protected]
+--                firest, [email protected]
+-- Stability   :  experimental
+-- Portability :  portable
+--
+-- A union type class module.
+--
+-----------------------------------------------------------------------------
+module Unsafe.Union where
+
+import Data.Proxy (Proxy)
+
+-- | a is Union Type
+-- b is subtype of union a
+-- c is union tag
+
+class IsOfUnion a b c | a -> c where
+  tagOfUnion :: Proxy a -> b -> c

tests/Test.hm

@@ -57,8 +57,10 @@ import Test.System.Timer as Timer
 import Test.Text.Parsec as Parsec
 import Test.Text.Json as Json
 
+import Test.Unsafe.Union as Union
+
 main :: IO ()
-main = runTest $ TxG "lib" 
+main = runTest $ TxG "lib"
    [ TxG "Data" [
                    TxG "Map"      [M.test]
                  , TxG "String"   [S.test]
@@ -122,6 +124,7 @@ main = runTest $ TxG "lib"
                     ],
      TxG "Text"     [ TxG "Parsec" [Parsec.test]
                     , TxG "Json"   [Json.test]
+                    ],
+     TxG "Unsafe"   [ TxG "Union" [Union.test]
                     ]
    ]
-

tests/Test/Unsafe/Union.hm

@@ -0,0 +1,47 @@
+module Test.Unsafe.Union where
+
+import Test.QuickCheck (TestGroup(..), TestResult, quickCheck1)
+import Prelude (Bool, (==), IO)
+import Unsafe.Union (class IsOfUnion, tagOfUnion)
+import Data.Proxy (Proxy(..))
+import Data.Eq(class Eq)
+
+data InetOpt
+
+data TcpOpt
+  = TcpOptInt Integer
+  | TcpOptStr String
+
+data UdpOpt
+  = UdpOptInt Integer
+  | UdpOptStr String
+
+data Tag
+  = TcpOpt
+  | UdpOpt
+
+derive instance Eq Tag
+
+instance IsOfUnion InetOpt TcpOpt Tag where
+  tagOfUnion _ _ = TcpOpt
+
+instance IsOfUnion InetOpt UdpOpt Tag where
+  tagOfUnion _ _ = UdpOpt
+
+checkUnionType :: forall a. IsOfUnion InetOpt a Tag => a -> Tag
+checkUnionType = tagOfUnion (Proxy :: Proxy InetOpt)
+
+unionTypeTest :: forall a. IsOfUnion InetOpt a Tag => a -> Tag -> Bool
+unionTypeTest a typeTag = typeTag == (checkUnionType a)
+
+unionTypeTestTcp :: Bool
+unionTypeTestTcp = unionTypeTest (TcpOptInt 12) TcpOpt
+
+unionTypeTestUdp :: Bool
+unionTypeTestUdp = unionTypeTest (UdpOptStr "Str") UdpOpt
+
+test :: TestGroup (Integer -> IO TestResult)
+test = Exe [
+    quickCheck1 "TCP Option" unionTypeTestTcp
+    , quickCheck1 "UDP Option" unionTypeTestUdp
+]