diff --git a/lib/Data/Proxy.hm b/lib/Data/Proxy.hm new file mode 100644 index 0000000..85a08f6 --- /dev/null +++ b/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, feng@emqx.io +-- Yang M, yangm@emqx.io +-- firest, shuai.wen@emqx.io +-- Stability : experimental +-- Portability : portable +-- +-- The Proxy module. +-- +----------------------------------------------------------------------------- +module Data.Proxy where + +data Proxy a = Proxy diff --git a/lib/Unsafe/Union.hm b/lib/Unsafe/Union.hm new file mode 100644 index 0000000..081a91e --- /dev/null +++ b/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, feng@emqx.io +-- Yang M, yangm@emqx.io +-- firest, shuai.wen@emqx.io +-- 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 diff --git a/tests/Test.hm b/tests/Test.hm index bfaffd3..93b235c 100644 --- a/tests/Test.hm +++ b/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] ] ] - diff --git a/tests/Test/Unsafe/Union.hm b/tests/Test/Unsafe/Union.hm new file mode 100644 index 0000000..77e5a49 --- /dev/null +++ b/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 +]