Copyright | (c) Ivan Lazar Miljenovic |
---|---|
License | MIT |
Maintainer | Ivan.Miljenovic@gmail.com |
Safe Haskell | None |
Language | Haskell2010 |
Documentation
class WithTagged g where Source #
withTaggedF :: (Coercible a a', Coercible b b', Functor f) => (a' -> f (g b')) -> Tagged t a -> f (g (Tagged t b)) Source #
Strip off type safety, run the function, put type safety back on.
withTaggedF :: (Coercible a a', Coercible b b', Functor f, Coercible (g b') (g (Tagged t b)), Coercible (g (Tagged t b)) (g b')) => (a' -> f (g b')) -> Tagged t a -> f (g (Tagged t b)) Source #
Strip off type safety, run the function, put type safety back on.
tagInner :: Tagged t (g a) -> g (Tagged t a) Source #
tagInner :: (Coercible (Tagged t (g a)) (g (Tagged t a)), Coercible (g (Tagged t a)) (g a)) => Tagged t (g a) -> g (Tagged t a) Source #
tagOuter :: g (Tagged t a) -> Tagged t (g a) Source #
tagOuter :: Coercible (g (Tagged t a)) (Tagged t (g a)) => g (Tagged t a) -> Tagged t (g a) Source #
stripTag :: Coercible a a' => Tagged t a -> a' Source #
Remove the tag along with (potentially) any newtype wrappers added on.
Re-export
newtype Tagged k s b :: forall k. k -> * -> * #
A
value is a value Tagged
s bb
with an attached phantom type s
.
This can be used in place of the more traditional but less safe idiom of
passing in an undefined value with the type, because unlike an (s -> b)
,
a
can't try to use the argument Tagged
s bs
as a real value.
Moreover, you don't have to rely on the compiler to inline away the extra argument, because the newtype is "free"
Tagged
has kind k -> * -> *
if the compiler supports PolyKinds
, therefore
there is an extra k
showing in the instance haddocks that may cause confusion.