Skip to content

Instantly share code, notes, and snippets.

@danbornside
Forked from xplat/WrappedShow1.hs
Last active August 22, 2018 15:37
Show Gist options
  • Save danbornside/d6fb2425a009c06798e96dda5a901677 to your computer and use it in GitHub Desktop.
Save danbornside/d6fb2425a009c06798e96dda5a901677 to your computer and use it in GitHub Desktop.
{- errors:
common/src/Common/WrappedShow1.hs:42:43: error:
• Couldn't match expected type ‘[a] -> ShowS’ with actual type ‘a’
‘a’ is a rigid type variable bound by
the type signature for:
reifyShow :: forall a t.
(a -> a -> a)
-> a
-> (forall s. Reifies s (ReifiedShow a) => t -> ReflectedShow a s)
-> t
-> a
at common/src/Common/WrappedShow1.hs:38:6
• In the second argument of ‘ReifiedShow’, namely ‘z’
In the first argument of ‘reify’, namely ‘(ReifiedShow f z)’
In the expression: reify (ReifiedShow f z) (unreflectedShow (m xs))
• Relevant bindings include
m :: forall s. Reifies s (ReifiedShow a) => t -> ReflectedShow a s
(bound at common/src/Common/WrappedShow1.hs:42:15)
z :: a (bound at common/src/Common/WrappedShow1.hs:42:13)
f :: a -> a -> a (bound at common/src/Common/WrappedShow1.hs:42:11)
reifyShow :: (a -> a -> a)
-> a
-> (forall s. Reifies s (ReifiedShow a) => t -> ReflectedShow a s)
-> t
-> a
(bound at common/src/Common/WrappedShow1.hs:42:1)
-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE UndecidableInstances #-}
module Common.WrappedShow1 where
import Data.Functor.Classes
import Data.Reflection
import Data.Coerce
newtype WrappedShow1 f a = WrappedShow1 (f a)
instance Show1 (WrappedShow1 f)
instance (Show1 f, Show a) => Show (WrappedShow1 f a) where
showsPrec x = liftShowsPrec showsPrec showList x
showList x = liftShowList showsPrec showList x
data ReifiedShow a = ReifiedShow
{ reifiedShowsPrec :: Int -> a -> ShowS
, reifiedShowList :: [a] -> ShowS
}
instance Reifies s (ReifiedShow a) => Show (ReflectedShow a s) where
showsPrec prec p@(ReflectedShow x) = reifiedShowsPrec (reflect p) prec x
showList xs = reifiedShowList (reflect (head xs)) (coerce xs)
newtype ReflectedShow a s = ReflectedShow a
unreflectedShow :: ReflectedShow a s -> proxy s -> a
unreflectedShow (ReflectedShow a) _ = a
reifyShow
:: (a -> a -> a)
-> a
-> (forall (s :: *). Reifies s (ReifiedShow a) => t -> ReflectedShow a s)
-> t -> a
reifyShow f z m xs = reify (ReifiedShow f z) (unreflectedShow (m xs))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment