Permalink
Browse files

- Playing with Type Families, GADTs, RankNTypes.

  • Loading branch information...
1 parent adc0e72 commit 401031c88103ba58edac4a47040552d47280bae0 @graninas committed Feb 19, 2014
Showing with 163 additions and 2 deletions.
  1. +6 −2 Amoeba.cabal
  2. +52 −0 Amoeba/Test/TypeFamilyTest.hs
  3. +58 −0 Amoeba/Test/TypeFamilyTest2.hs
  4. +47 −0 Amoeba/Test/TypeFamilyTest3.hs
View
@@ -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
@@ -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."
@@ -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."
@@ -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."

0 comments on commit 401031c

Please sign in to comment.