{-# LANGUAGE TypeSynonymInstances
           , FlexibleInstances
           , FlexibleContexts
           , DeriveDataTypeable
           , CPP
           , GADTs
           , DataKinds
           , OverloadedStrings
           , ScopedTypeVariables
           , TypeOperators
           #-}

{-# OPTIONS_GHC -Wall -fwarn-tabs #-}
----------------------------------------------------------------
--                                                    2017.06.19
-- |
-- Module      :  Language.Hakaru.Summary
-- Copyright   :  Copyright (c) 2017 the Hakaru team
-- License     :  BSD3
-- Maintainer  :  wren@community.haskell.org
-- Stability   :  experimental
-- Portability :  GHC-only
--
-- Take strings from Maple and interpret them in Haskell (Hakaru)
----------------------------------------------------------------
module Language.Hakaru.Summary
    ( summary
    , summaryDebug
    , MapleException(MapleInterpreterException)
    ) where

import Language.Hakaru.Syntax.ABT
import Language.Hakaru.Syntax.AST
import Language.Hakaru.Maple 

----------------------------------------------------------------

summary
    :: forall abt a
    .  (ABT Term abt) 
    => abt '[] a -> IO (abt '[] a)
summary :: abt '[] a -> IO (abt '[] a)
summary = MapleOptions (MapleCommand a a) -> abt '[] a -> IO (abt '[] a)
forall (abt :: [Hakaru] -> Hakaru -> *) (i :: Hakaru)
       (o :: Hakaru).
ABT Term abt =>
MapleOptions (MapleCommand i o) -> abt '[] i -> IO (abt '[] o)
sendToMaple MapleOptions ()
defaultMapleOptions{command :: MapleCommand a a
command=Transform '[ '( '[], a)] a -> MapleCommand a a
forall (i :: Hakaru) (o :: Hakaru).
Transform '[ '( '[], i)] o -> MapleCommand i o
MapleCommand Transform '[ '( '[], a)] a
forall (a :: Hakaru). Transform '[LC a] a
Summarize}

summaryDebug
    :: forall abt a
    .  (ABT Term abt) 
    => Bool -> abt '[] a -> IO (abt '[] a)
summaryDebug :: Bool -> abt '[] a -> IO (abt '[] a)
summaryDebug Bool
d = MapleOptions (MapleCommand a a) -> abt '[] a -> IO (abt '[] a)
forall (abt :: [Hakaru] -> Hakaru -> *) (i :: Hakaru)
       (o :: Hakaru).
ABT Term abt =>
MapleOptions (MapleCommand i o) -> abt '[] i -> IO (abt '[] o)
sendToMaple
   MapleOptions ()
defaultMapleOptions{command :: MapleCommand a a
command=Transform '[ '( '[], a)] a -> MapleCommand a a
forall (i :: Hakaru) (o :: Hakaru).
Transform '[ '( '[], i)] o -> MapleCommand i o
MapleCommand Transform '[ '( '[], a)] a
forall (a :: Hakaru). Transform '[LC a] a
Summarize,
                       debug :: Bool
debug=Bool
d}

----------------------------------------------------------------
----------------------------------------------------------- fin.