Skip to content

Instantly share code, notes, and snippets.

@kosmikus
Created May 24, 2017 08:41
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 kosmikus/b20423dd1d44826ebc173e558f49cc37 to your computer and use it in GitHub Desktop.
Save kosmikus/b20423dd1d44826ebc173e558f49cc37 to your computer and use it in GitHub Desktop.
type family SExprExt (ext :: k1) (f :: k2) = (r :: (* -> *)) | r -> ext where
SExprExt ('[] :: [* -> *]) f = Union (MapList ('[] :: [* -> *]) f)
SExprExt r f = Union (MapList r f)
class (Functor (SExprExt ext f), Foldable (SExprExt ext f), Traversable (SExprExt ext f)) => SimpleExprExtension ext f a where
functorWitness :: p ext f a -> Dict (Functor (SExprExt ext f))
functorWitness _ = Dict
foldableWitness :: p ext f a -> Dict (Foldable (SExprExt ext f))
foldableWitness _ = Dict
traversableWitness :: p ext f a -> Dict (Traversable (SExprExt ext f))
traversableWitness _ = Dict
type family MapList (l :: [ * -> * ]) f = (r :: [* -> *] ) | r -> l where
MapList '[] f = '[]
MapList (ext ': rest) f = (SExprExt ext f) ': MapList rest f
type MapConstraint constr l f = ConstrainedMembers constr (MapList l f)
instance (Functor (SExprExt ext f), Foldable (SExprExt ext f), Traversable (SExprExt ext f)) => SimpleExprExtension ext f a
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment