{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE NoIncoherentInstances #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NoUndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-tabs #-}

module Hcompta.Repr.Meta where

import Control.Applicative (Applicative(..))
-- import Control.Exception.Safe (MonadThrow, MonadCatch, MonadMask)
-- import qualified Control.Exception.Safe as Exn
import Control.Monad (Monad(..))
-- import qualified Control.Monad.Classes as MC
-- import qualified Control.Monad.Classes.Write as MC
import Control.Monad.IO.Class (MonadIO(..))
-- import Control.Monad.Trans.Class
-- import Control.Monad.Trans.State.Strict as ST
import Data.Bool
-- import Data.Either (Either(..))
import Data.Eq (Eq(..))
-- import Data.Foldable (asum)
import Data.Function (($), (.))
import Data.Functor (Functor(..))
-- import Data.Int (Int)
-- import qualified Data.List as List
-- import Data.Maybe (Maybe(..), fromMaybe)
-- import Data.Monoid ((<>))
-- import Data.Ord (Ord(..))
-- import Data.Text (Text)
-- import qualified Data.Text as Text
-- import Data.Text.Buildable (Buildable(..))
-- import qualified Data.Text.Lazy.Builder as TL (Builder)
-- import Prelude (pred, succ)
-- import Text.Show (Show(..))

import Hcompta.Expr
import Hcompta.Lib.Control.Monad
-- import Hcompta.Lib.Data.Monoid (Monoid1)
-- import Hcompta.Lib.Data.Text as Text

-- * Type 'Write'

-- | Meta-circular /tagless-final interpreter/,
-- producing an Haskell term of type @h@.
newtype Meta m h
 =      Meta
 {    unMeta :: m h }
 deriving (Applicative, Functor, Monad, MonadIO)

run :: Meta m h -> m h
run = unMeta

instance Monad m => Expr_Lit (Meta m) where
	lit = Meta . return
instance Monad m => Expr_Bool (Meta m) where
	and = liftM2Join $ \x y -> Meta $ return $ x && y
	or  = liftM2Join $ \x y -> Meta $ return $ x || y
	neg = liftMJoin  $ \x   -> Meta $ return $ not x
instance Monad m => Expr_Eq (Meta m) where
	eq = liftM2Join $ \x y -> Meta $ return $ x == y
instance MonadIO m => Expr_Fun (Meta m)