{-# LANGUAGE GADTs                #-}
{-# LANGUAGE TemplateHaskell      #-}
{-# LANGUAGE TypeOperators        #-}
{-# LANGUAGE TypeSynonymInstances #-}
--------------------------------------------------------------------------------
-- |
-- Module      :  Data.Comp.Show
-- Copyright   :  (c) 2010-2011 Patrick Bahr, Tom Hvitved
-- License     :  BSD3
-- Maintainer  :  Patrick Bahr <paba@diku.dk>
-- Stability   :  experimental
-- Portability :  non-portable (GHC Extensions)
--
-- This module defines showing of signatures, which lifts to showing of
-- terms and contexts.
--
--------------------------------------------------------------------------------

module Data.Comp.Show
    ( ShowF(..)
    ) where

import Data.Comp.Algebra
import Data.Comp.Annotation
import Data.Comp.Derive (liftSum)
import Data.Comp.Derive.Show
import Data.Comp.Derive.Utils (derive)
import Data.Comp.Term

instance (Functor f, ShowF f) => ShowF (Cxt h f) where
    showF :: Cxt h f String -> String
showF (Hole String
s) = String
s
    showF (Term f (Cxt h f String)
t) = f String -> String
forall (f :: * -> *). ShowF f => f String -> String
showF (f String -> String) -> f String -> String
forall a b. (a -> b) -> a -> b
$ (Cxt h f String -> String) -> f (Cxt h f String) -> f String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Cxt h f String -> String
forall (f :: * -> *). ShowF f => f String -> String
showF f (Cxt h f String)
t

instance (Functor f, ShowF f, Show a) => Show (Cxt h f a) where
    show :: Cxt h f a -> String
show = Alg f String -> (a -> String) -> Cxt h f a -> String
forall (f :: * -> *) h a b.
Functor f =>
Alg f b -> (a -> b) -> Cxt h f a -> b
free Alg f String
forall (f :: * -> *). ShowF f => f String -> String
showF a -> String
forall a. Show a => a -> String
show

instance (ShowF f, Show p) => ShowF (f :&: p) where
    showF :: (:&:) f p String -> String
showF (f String
v :&: p
p) = f String -> String
forall (f :: * -> *). ShowF f => f String -> String
showF f String
v String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" :&: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ p -> String
forall a. Show a => a -> String
show p
p

$(derive [liftSum] [''ShowF])
$(derive [makeShowF] [''Maybe, ''[], ''(,)])

instance (ShowConstr f, Show p) => ShowConstr (f :&: p) where
    showConstr :: (:&:) f p a -> String
showConstr (f a
v :&: p
p) = f a -> String
forall (f :: * -> *) a. ShowConstr f => f a -> String
showConstr f a
v String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" :&: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ p -> String
forall a. Show a => a -> String
show p
p

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