{-# LANGUAGE FlexibleContexts     #-}
{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE GADTs                #-}
{-# LANGUAGE TemplateHaskell      #-}
{-# LANGUAGE TypeOperators        #-}
{-# LANGUAGE UndecidableInstances #-}
--------------------------------------------------------------------------------
-- |
-- Module      :  Data.Comp.Multi.Show
-- Copyright   :  (c) 2011 Patrick Bahr
-- License     :  BSD3
-- Maintainer  :  Patrick Bahr <paba@diku.dk>
-- Stability   :  experimental
-- Portability :  non-portable (GHC Extensions)
--
-- This module defines showing of (higher-order) signatures, which lifts to
-- showing of (higher-order) terms and contexts. All definitions are
-- generalised versions of those in "Data.Comp.Show".
--
--------------------------------------------------------------------------------

module Data.Comp.Multi.Show
    ( ShowHF(..)
    ) where

import Data.Comp.Multi.Algebra
import Data.Comp.Multi.Annotation
import Data.Comp.Multi.Derive
import Data.Comp.Multi.HFunctor
import Data.Comp.Multi.Term

instance KShow (K String) where
    kshow :: forall i. K String i -> K String i
kshow = forall a. a -> a
id

instance KShow (K ()) where
    kshow :: forall i. K () i -> K String i
kshow K () i
_ = forall a i. a -> K a i
K forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show ()

instance (ShowHF f, HFunctor f) => ShowHF (Cxt h f) where
    showHF :: Alg (Cxt h f) (K String)
showHF (Hole K String i
s) = K String i
s
    showHF (Term f (Cxt h f (K String)) i
t) = forall (f :: (* -> *) -> * -> *). ShowHF f => Alg f (K String)
showHF forall a b. (a -> b) -> a -> b
$ forall (h :: (* -> *) -> * -> *) (f :: * -> *) (g :: * -> *).
HFunctor h =>
(f :-> g) -> h f :-> h g
hfmap forall (f :: (* -> *) -> * -> *). ShowHF f => Alg f (K String)
showHF f (Cxt h f (K String)) i
t

instance (ShowHF f, HFunctor f, KShow a) => KShow (Cxt h f a) where
    kshow :: forall i. Cxt h f a i -> K String i
kshow = forall (f :: (* -> *) -> * -> *) h (a :: * -> *) (b :: * -> *).
HFunctor f =>
Alg f b -> (a :-> b) -> Cxt h f a :-> b
free forall (f :: (* -> *) -> * -> *). ShowHF f => Alg f (K String)
showHF forall (a :: * -> *) i. KShow a => a i -> K String i
kshow

instance (KShow (Cxt h f a)) => Show (Cxt h f a i) where
    show :: Cxt h f a i -> String
show = forall a i. K a i -> a
unK forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: * -> *) i. KShow a => a i -> K String i
kshow

instance (ShowHF f, Show p) => ShowHF (f :&: p) where
    showHF :: Alg (f :&: p) (K String)
showHF (f (K String) i
v :&: p
p) =  forall a i. a -> K a i
K forall a b. (a -> b) -> a -> b
$ forall a i. K a i -> a
unK (forall (f :: (* -> *) -> * -> *). ShowHF f => Alg f (K String)
showHF f (K String) i
v) forall a. [a] -> [a] -> [a]
++ String
" :&: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show p
p

$(derive [liftSum] [''ShowHF])