Skip to content

Instantly share code, notes, and snippets.

@fieldstrength
Created July 19, 2018 13:28
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save fieldstrength/3c91bfe88fa900f3657dad95c8d4d400 to your computer and use it in GitHub Desktop.
Save fieldstrength/3c91bfe88fa900f3657dad95c8d4d400 to your computer and use it in GitHub Desktop.
Constrained typed extractions with GADTs
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE ViewPatterns #-}
module Things where
-- Data
data X = X String Bool Char
-- What I get as input
data Ty = STRING | BOOL | INT
-- Representation of things I can pick out of the data.
data Thing :: * -> * where
TString :: Thing String
TBool :: Thing Bool
TInt :: Thing Char
-- Existentialized version of Thing, witnesses the constraint that I'll need.
data SomeThing
= forall k. Show k => SomeThing (Thing k)
-- A polymorphic structure
data Foo a b = Foo a b deriving Show
toSomeThing :: Ty -> SomeThing
toSomeThing BOOL = SomeThing TBool
toSomeThing INT = SomeThing TInt
toSomeThing STRING = SomeThing TString
-- dependently-typed extraction
extractThing :: Thing a -> X -> a
extractThing TString (X s b i) = s
extractThing TBool (X s b i) = b
extractThing TInt (X s b i) = i
-- Extract various parts of something into a polymorphic structure
extractThings :: Thing a -> Thing b -> X -> Foo a b
extractThings ta tb x = Foo (extractThing ta x) (extractThing tb x)
-- a "dependently typed" operation but returns a simple type
doit :: (Show a, Show b) => Thing a -> Thing b -> X -> String
doit ta tb = show . extractThings ta tb
-- monomorphic signature version
doitSimple :: Ty -> Ty -> X -> String
doitSimple (toSomeThing -> SomeThing ta) (toSomeThing -> SomeThing tb) = doit ta tb
-- But this doesn't work!
--doitBad :: Ty -> Ty -> X -> String
--doitBad a b = doit ta tb
-- where
-- (SomeThing ta) = toSomeThing a
-- (SomeThing tb) = toSomeThing b
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment