{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
-- | Interpreter to compute a host-term.
module Language.Symantic.Repr.Host where

import Control.Applicative as Applicative
import Control.Monad as Monad
import Data.Foldable as Foldable
import Data.Functor as Functor
import Data.Monoid as Monoid
import Data.Traversable as Traversable
import qualified Data.Tuple as Tuple
import qualified Data.Bool as Bool
import qualified Data.List as List
import qualified Data.Map.Strict as Map
import qualified Data.Maybe as Maybe
import qualified System.IO as IO

-- import Language.Symantic.Type
import Language.Symantic.Expr hiding (Sym_Monad(..))
import qualified Language.Symantic.Expr as Expr

-- * Type 'Repr_Host'

-- | Interpreter's data.
newtype Repr_Host h = Repr_Host { unRepr_Host :: h }
instance Functor Repr_Host where
	fmap f (Repr_Host a) = Repr_Host (f a)
instance Applicative Repr_Host where
	pure = Repr_Host
	(Repr_Host f) <*> (Repr_Host a) = Repr_Host (f a)
instance Monad Repr_Host where
	return = Repr_Host
	(Repr_Host a) >>= f = f a

-- | Interpreter.
host_from_expr :: Repr_Host h -> h
host_from_expr = unRepr_Host

instance Sym_Lambda Repr_Host where
	($$)  = (Applicative.<*>)
	lam f = Repr_Host (unRepr_Host . f . Repr_Host)
instance Sym_Bool Repr_Host where
	bool = Repr_Host
	not  = liftM Bool.not
	(&&) = liftM2 (Prelude.&&)
	(||) = liftM2 (Prelude.||)
instance Sym_Int Repr_Host where
	int    = Repr_Host
	abs    = liftM Prelude.abs
	negate = liftM Prelude.negate
	(+)    = liftM2 (Prelude.+)
	(-)    = liftM2 (Prelude.-)
	(*)    = liftM2 (Prelude.*)
	mod    = liftM2 Prelude.mod
instance Sym_Text Repr_Host where
	text = Repr_Host
instance Sym_Maybe Repr_Host where
	nothing = Repr_Host Nothing
	just    = liftM Just
	maybe   = liftM3 Maybe.maybe
instance Sym_IO Repr_Host where
	io_hClose   = liftM IO.hClose
	io_openFile = liftM2 IO.openFile
instance Sym_If Repr_Host where
	if_ (Repr_Host b) ok ko = if b then ok else ko
instance Sym_When Repr_Host where
	when (Repr_Host b) = Monad.when b
instance Sym_Eq Repr_Host where
	(==) = liftM2 (Prelude.==)
instance Sym_Ord Repr_Host where
	compare = liftM2 Prelude.compare
instance Sym_List Repr_Host where
	list_empty   = return []
	list_cons    = liftM2 (:)
	list         = sequence
	list_filter  = liftM2 List.filter
	list_zipWith = liftM3 List.zipWith
	list_reverse = liftM  List.reverse
instance Sym_Tuple2 Repr_Host where
	tuple2 = liftM2 (,)
	fst    = liftM  Tuple.fst
	snd    = liftM  Tuple.snd
instance Sym_Map Repr_Host where
	map_from_list    = liftM  Map.fromList
	mapWithKey       = liftM2 Map.mapWithKey
	map_lookup       = liftM2 Map.lookup
	map_keys         = liftM  Map.keys
	map_member       = liftM2 Map.member
	map_insert       = liftM3 Map.insert
	map_delete       = liftM2 Map.delete
	map_difference   = liftM2 Map.difference
	map_foldrWithKey = liftM3 Map.foldrWithKey
instance Sym_Functor Repr_Host where
	fmap = liftM2 (Functor.<$>)
instance Expr.Sym_Monad Repr_Host where
	return = liftM Monad.return
	(>>=)  = Monad.liftM2 (Monad.>>=)
instance Sym_Either Repr_Host where
	right = liftM Right
	left  = liftM Left
instance Sym_Monoid Repr_Host where
	mempty  = Repr_Host Monoid.mempty
	mappend = liftM2 Monoid.mappend
instance Sym_Foldable Repr_Host where
	foldMap = liftM2 Foldable.foldMap
	null    = liftM Foldable.null
	length  = liftM Foldable.length
	minimum = liftM Foldable.minimum
	maximum = liftM Foldable.maximum
	elem    = liftM2 Foldable.elem
instance Sym_Applicative Repr_Host where
	pure  = liftM Applicative.pure
	(<*>) = liftM2 (Applicative.<*>)
instance Sym_Traversable Repr_Host where
	traverse = liftM2 Traversable.traverse