{-# LANGUAGE CPP                        #-}
{-# LANGUAGE DeriveFunctor              #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses      #-}

-- | The transformer stack used during desugaring.

module Fay.Compiler.Desugar.Types
  ( DesugarReader (..)
  , Desugar
  , runDesugar
  ) where

import           Fay.Types            (CompileError (..))

#if __GLASGOW_HASKELL__ < 710
import           Control.Applicative
#endif
import           Control.Monad.Except
import           Control.Monad.Reader

data DesugarReader l = DesugarReader
  { DesugarReader l -> Int
readerNameDepth     :: Int
  , DesugarReader l -> l
readerNoInfo        :: l
  , DesugarReader l -> String
readerTmpNamePrefix :: String
  }

newtype Desugar l a = Desugar
  { Desugar l a
-> ReaderT (DesugarReader l) (ExceptT CompileError IO) a
unDesugar :: (ReaderT (DesugarReader l)
                       (ExceptT CompileError IO))
                       a
  } deriving ( MonadReader (DesugarReader l)
             , MonadError CompileError
             , Monad (Desugar l)
Monad (Desugar l)
-> (forall a. IO a -> Desugar l a) -> MonadIO (Desugar l)
IO a -> Desugar l a
forall l. Monad (Desugar l)
forall a. IO a -> Desugar l a
forall l a. IO a -> Desugar l a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> Desugar l a
$cliftIO :: forall l a. IO a -> Desugar l a
$cp1MonadIO :: forall l. Monad (Desugar l)
MonadIO
             , Applicative (Desugar l)
a -> Desugar l a
Applicative (Desugar l)
-> (forall a b. Desugar l a -> (a -> Desugar l b) -> Desugar l b)
-> (forall a b. Desugar l a -> Desugar l b -> Desugar l b)
-> (forall a. a -> Desugar l a)
-> Monad (Desugar l)
Desugar l a -> (a -> Desugar l b) -> Desugar l b
Desugar l a -> Desugar l b -> Desugar l b
forall l. Applicative (Desugar l)
forall a. a -> Desugar l a
forall l a. a -> Desugar l a
forall a b. Desugar l a -> Desugar l b -> Desugar l b
forall a b. Desugar l a -> (a -> Desugar l b) -> Desugar l b
forall l a b. Desugar l a -> Desugar l b -> Desugar l b
forall l a b. Desugar l a -> (a -> Desugar l b) -> Desugar l b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> Desugar l a
$creturn :: forall l a. a -> Desugar l a
>> :: Desugar l a -> Desugar l b -> Desugar l b
$c>> :: forall l a b. Desugar l a -> Desugar l b -> Desugar l b
>>= :: Desugar l a -> (a -> Desugar l b) -> Desugar l b
$c>>= :: forall l a b. Desugar l a -> (a -> Desugar l b) -> Desugar l b
$cp1Monad :: forall l. Applicative (Desugar l)
Monad
             , a -> Desugar l b -> Desugar l a
(a -> b) -> Desugar l a -> Desugar l b
(forall a b. (a -> b) -> Desugar l a -> Desugar l b)
-> (forall a b. a -> Desugar l b -> Desugar l a)
-> Functor (Desugar l)
forall a b. a -> Desugar l b -> Desugar l a
forall a b. (a -> b) -> Desugar l a -> Desugar l b
forall l a b. a -> Desugar l b -> Desugar l a
forall l a b. (a -> b) -> Desugar l a -> Desugar l b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Desugar l b -> Desugar l a
$c<$ :: forall l a b. a -> Desugar l b -> Desugar l a
fmap :: (a -> b) -> Desugar l a -> Desugar l b
$cfmap :: forall l a b. (a -> b) -> Desugar l a -> Desugar l b
Functor
             , Functor (Desugar l)
a -> Desugar l a
Functor (Desugar l)
-> (forall a. a -> Desugar l a)
-> (forall a b. Desugar l (a -> b) -> Desugar l a -> Desugar l b)
-> (forall a b c.
    (a -> b -> c) -> Desugar l a -> Desugar l b -> Desugar l c)
-> (forall a b. Desugar l a -> Desugar l b -> Desugar l b)
-> (forall a b. Desugar l a -> Desugar l b -> Desugar l a)
-> Applicative (Desugar l)
Desugar l a -> Desugar l b -> Desugar l b
Desugar l a -> Desugar l b -> Desugar l a
Desugar l (a -> b) -> Desugar l a -> Desugar l b
(a -> b -> c) -> Desugar l a -> Desugar l b -> Desugar l c
forall l. Functor (Desugar l)
forall a. a -> Desugar l a
forall l a. a -> Desugar l a
forall a b. Desugar l a -> Desugar l b -> Desugar l a
forall a b. Desugar l a -> Desugar l b -> Desugar l b
forall a b. Desugar l (a -> b) -> Desugar l a -> Desugar l b
forall l a b. Desugar l a -> Desugar l b -> Desugar l a
forall l a b. Desugar l a -> Desugar l b -> Desugar l b
forall l a b. Desugar l (a -> b) -> Desugar l a -> Desugar l b
forall a b c.
(a -> b -> c) -> Desugar l a -> Desugar l b -> Desugar l c
forall l a b c.
(a -> b -> c) -> Desugar l a -> Desugar l b -> Desugar l c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: Desugar l a -> Desugar l b -> Desugar l a
$c<* :: forall l a b. Desugar l a -> Desugar l b -> Desugar l a
*> :: Desugar l a -> Desugar l b -> Desugar l b
$c*> :: forall l a b. Desugar l a -> Desugar l b -> Desugar l b
liftA2 :: (a -> b -> c) -> Desugar l a -> Desugar l b -> Desugar l c
$cliftA2 :: forall l a b c.
(a -> b -> c) -> Desugar l a -> Desugar l b -> Desugar l c
<*> :: Desugar l (a -> b) -> Desugar l a -> Desugar l b
$c<*> :: forall l a b. Desugar l (a -> b) -> Desugar l a -> Desugar l b
pure :: a -> Desugar l a
$cpure :: forall l a. a -> Desugar l a
$cp1Applicative :: forall l. Functor (Desugar l)
Applicative
             )

runDesugar :: String -> l -> Desugar l a -> IO (Either CompileError a)
runDesugar :: String -> l -> Desugar l a -> IO (Either CompileError a)
runDesugar String
tmpNamePrefix l
emptyAnnotation Desugar l a
m =
    ExceptT CompileError IO a -> IO (Either CompileError a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ReaderT (DesugarReader l) (ExceptT CompileError IO) a
-> DesugarReader l -> ExceptT CompileError IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (Desugar l a
-> ReaderT (DesugarReader l) (ExceptT CompileError IO) a
forall l a.
Desugar l a
-> ReaderT (DesugarReader l) (ExceptT CompileError IO) a
unDesugar Desugar l a
m) (Int -> l -> String -> DesugarReader l
forall l. Int -> l -> String -> DesugarReader l
DesugarReader Int
0 l
emptyAnnotation String
tmpNamePrefix))