{-# 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 :: K String i -> K String i
kshow = K String i -> K String i
forall a. a -> a
id

instance KShow (K ()) where
    kshow :: K () i -> K String i
kshow _ = 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 (ShowHF f, HFunctor f) => ShowHF (Cxt h f) where
    showHF :: Cxt h f (K String) i -> K String i
showHF (Hole s :: K String i
s) = K String i
s
    showHF (Term t :: f (Cxt h f (K String)) i
t) = f (K String) i -> K String i
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)) i -> f (K String) i
forall (h :: (* -> *) -> * -> *) (f :: * -> *) (g :: * -> *).
HFunctor h =>
(f :-> g) -> h f :-> h g
hfmap 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 :: 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 Alg f (K String)
forall (f :: (* -> *) -> * -> *). ShowHF f => Alg f (K String)
showHF 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 (a :: * -> *) i. KShow a => a i -> K String i
kshow

instance (ShowHF f, Show p) => ShowHF (f :&: p) where
    showHF :: (:&:) f p (K String) i -> K String i
showHF (v :: f (K String) i
v :&: p :: 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
forall (f :: (* -> *) -> * -> *). ShowHF f => Alg f (K String)
showHF f (K String) i
v) String -> ShowS
forall a. [a] -> [a] -> [a]
++ " :&: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ p -> String
forall a. Show a => a -> String
show p
p

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