{-# LANGUAGE FlexibleContexts     #-}
{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE GADTs                #-}
{-# LANGUAGE TemplateHaskell      #-}
{-# LANGUAGE TypeApplications     #-}
{-# 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(..)
    , KShow(..)
    ) 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 = K String i -> K String i
forall a. a -> a
id

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

instance KShow f => Show (E f) where
  show :: E f -> String
show (E f i
x) = K String i -> String
forall a i. K a i -> a
unK (K String i -> String) -> K String i -> String
forall a b. (a -> b) -> a -> b
$ f i -> K String i
forall i. f i -> K String i
forall (a :: * -> *) i. KShow a => a i -> K String i
kshow f i
x

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) = f (K String) i -> K String i
Alg f (K String)
forall (f :: (* -> *) -> * -> *). ShowHF f => Alg f (K String)
showHF (f (K String) i -> K String i) -> f (K String) i -> K String i
forall a b. (a -> b) -> a -> b
$ Alg (Cxt h f) (K String) -> f (Cxt h f (K String)) :-> f (K String)
forall (f :: * -> *) (g :: * -> *). (f :-> g) -> f f :-> f g
forall (h :: (* -> *) -> * -> *) (f :: * -> *) (g :: * -> *).
HFunctor h =>
(f :-> g) -> h f :-> h g
hfmap Cxt h f (K String) i -> K String i
Alg (Cxt h f) (K String)
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 = Alg f (K String)
-> (a :-> K String) -> forall i. Cxt h f a i -> K String i
forall (f :: (* -> *) -> * -> *) h (a :: * -> *) (b :: * -> *).
HFunctor f =>
Alg f b -> (a :-> b) -> Cxt h f a :-> b
free f (K String) i -> K String i
Alg f (K String)
forall (f :: (* -> *) -> * -> *). ShowHF f => Alg f (K String)
showHF a i -> K String i
a :-> K String
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 = K String i -> String
forall a i. K a i -> a
unK (K String i -> String)
-> (Cxt h f a i -> K String i) -> Cxt h f a i -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cxt h f a i -> K String i
forall i. Cxt h f a i -> K String i
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) =  String -> K String i
forall a i. a -> K a i
K (String -> K String i) -> String -> K String i
forall a b. (a -> b) -> a -> b
$ K String i -> String
forall a i. K a i -> a
unK (f (K String) i -> K String i
Alg f (K String)
forall (f :: (* -> *) -> * -> *). ShowHF f => Alg f (K String)
showHF f (K String) i
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] [''ShowHF])