- Playing with Type Families, GADTs, RankNTypes.

Amoeba.cabal

@@ -68,7 +68,9 @@ library
                    GameLogic.Language.Parsers.Common,
                    GameLogic.Language.Parsers.RawToken,
                    GameLogic.Language.Translator,
-                   Test.EitherMonadCallTest
+                   Test.EitherMonadCallTest,
+                   Test.TypeFamilyTest,
+                   Test.TypeFamilyTest2
 
 executable Amoeba
   build-depends:   base >= 4
@@ -107,5 +109,7 @@ executable Amoeba
                    GameLogic.Language.Parsers.Common,
                    GameLogic.Language.Parsers.RawToken,
                    GameLogic.Language.Translator,
-                   Test.EitherMonadCallTest
+                   Test.EitherMonadCallTest,
+                   Test.TypeFamilyTest,
+                   Test.TypeFamilyTest2
 sers.ItemParser

Amoeba/Test/TypeFamilyTest.hs

@@ -0,0 +1,52 @@
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE RankNTypes #-}
+
+module Main where
+
+type Caption = String
+type Name = String
+type PlayerName = String
+
+data IntProperty = IntProperty Name Int
+    deriving (Show, Read, Eq)
+data IntResource = IntResource Name (Int, Int)
+    deriving (Show, Read, Eq)
+
+class Show a => Prop a where
+    type Out a :: *
+    getProperty :: a -> Out a
+
+instance Prop IntProperty where
+    type Out IntProperty = Int
+    getProperty (IntProperty _ k) = k
+
+instance Prop IntResource where
+    type Out IntResource = (Int, Int)
+    getProperty (IntResource _ k) = k
+
+
+data PropertyToken = forall p. Prop p => MkPropertyToken p
+type PropertyTokens = [PropertyToken]
+
+data RawToken = Item Name PropertyTokens
+
+instance Show PropertyToken where
+    show (MkPropertyToken p) = show p
+
+
+
+token1 = MkPropertyToken (IntProperty "int" 10)
+token2 = MkPropertyToken (IntResource "intResource" (10, 1000))
+tokens = [token1, token2]
+
+rawToken = Item "RawToken" tokens
+
+main = do
+    print $ getProperty (IntProperty "a" 10)
+    print $ getProperty (IntResource "b" (20, 20))
+
+    putStrLn "Ok."

Amoeba/Test/TypeFamilyTest2.hs

@@ -0,0 +1,58 @@
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE RankNTypes #-}
+
+module Main where
+
+type Caption = String
+type Name = String
+type PlayerName = String
+
+data IntProperty = IntProperty Name Int
+    deriving (Show, Read, Eq)
+data IntResource = IntResource Name (Int, Int)
+    deriving (Show, Read, Eq)
+
+class Prop a where
+    type Out a :: *
+    getProperty :: a -> Out a
+
+class PropertyBag a where
+    type Elem a :: *
+    empty :: a
+    insert :: Elem a -> a -> a
+    toList :: a -> [Elem a]
+
+instance Prop a => PropertyBag [a] where
+    type Elem [a] = a
+    empty = []
+    toList l = l
+    insert a l = a : l
+
+
+instance Prop IntProperty where
+    type Out IntProperty = Int
+    getProperty (IntProperty _ k) = k
+
+instance Prop IntResource where
+    type Out IntResource = (Int, Int)
+    getProperty (IntResource _ k) = k
+
+{-
+So, what?
+f :: (PropertyBag a, Prop b, b ~ Elem a) => a -> [b]
+f bag = toList bag
+
+prop1 = IntProperty "aa" 10
+b :: (PropertyBag a, Prop p, p ~ Elem a) => p -> a
+b p = insert (getProperty p) empty
+-}
+
+main = do
+
+  --  let x = b prop1
+
+    putStrLn "Ok."

Amoeba/Test/TypeFamilyTest3.hs

@@ -0,0 +1,47 @@
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE RankNTypes #-}
+
+module Main where
+
+type Caption = String
+type Name = String
+type PlayerName = String
+
+
+data PropertyToken a where
+     IntProperty :: Name -> Int -> PropertyToken Int
+     IntResource :: Name -> (Int, Int) -> PropertyToken (Int, Int)
+
+instance Show (PropertyToken Int) where
+    show (IntProperty _ i) = show i
+
+instance Show (PropertyToken (Int, Int)) where
+    show (IntResource _ i) = show i
+
+class Prop a where
+    type Out a :: *
+    getProperty :: a -> Out a
+
+instance Prop (PropertyToken a) where
+    type Out (PropertyToken a) = a
+    getProperty (IntProperty _ k) = k
+    getProperty (IntResource _ k) = k
+
+
+
+token1 = IntProperty "int" 10
+token2 = IntResource "intResource" (10, 1000)
+--tokens = [token1, token2]
+
+main = do
+    let res1 = getProperty (IntProperty "a" 10)
+    let res2 = getProperty (IntResource "b" (20, 20))
+
+    print res1
+    print res2
+
+    putStrLn "Ok."