Guest User

Untitled

a guest
Jul 19th, 2018
95
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 1.62 KB | None | 0 0
  1. {-# LANGUAGE ExistentialQuantification #-}
  2. {-# LANGUAGE GADTs #-}
  3. {-# LANGUAGE KindSignatures #-}
  4. {-# LANGUAGE ViewPatterns #-}
  5.  
  6. module Things where
  7.  
  8. -- Data
  9. data X = X String Bool Char
  10.  
  11. -- What I get as input
  12. data Ty = STRING | BOOL | INT
  13.  
  14. -- Representation of things I can pick out of the data.
  15. data Thing :: * -> * where
  16. TString :: Thing String
  17. TBool :: Thing Bool
  18. TInt :: Thing Char
  19.  
  20. -- Existentialized version of Thing, witnesses the constraint that I'll need.
  21. data SomeThing
  22. = forall k. Show k => SomeThing (Thing k)
  23.  
  24. -- A polymorphic structure
  25. data Foo a b = Foo a b deriving Show
  26.  
  27. toSomeThing :: Ty -> SomeThing
  28. toSomeThing BOOL = SomeThing TBool
  29. toSomeThing INT = SomeThing TInt
  30. toSomeThing STRING = SomeThing TString
  31.  
  32. -- dependently-typed extraction
  33. extractThing :: Thing a -> X -> a
  34. extractThing TString (X s b i) = s
  35. extractThing TBool (X s b i) = b
  36. extractThing TInt (X s b i) = i
  37.  
  38. -- Extract various parts of something into a polymorphic structure
  39. extractThings :: Thing a -> Thing b -> X -> Foo a b
  40. extractThings ta tb x = Foo (extractThing ta x) (extractThing tb x)
  41.  
  42. -- a "dependently typed" operation but returns a simple type
  43. doit :: (Show a, Show b) => Thing a -> Thing b -> X -> String
  44. doit ta tb = show . extractThings ta tb
  45.  
  46. -- monomorphic signature version
  47. doitSimple :: Ty -> Ty -> X -> String
  48. doitSimple (toSomeThing -> SomeThing ta) (toSomeThing -> SomeThing tb) = doit ta tb
  49.  
  50. -- But this doesn't work!
  51. --doitBad :: Ty -> Ty -> X -> String
  52. --doitBad a b = doit ta tb
  53. -- where
  54. -- (SomeThing ta) = toSomeThing a
  55. -- (SomeThing tb) = toSomeThing b
Add Comment
Please, Sign In to add comment