Monad.hs 1.89 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74
-- |
-- Module      :  Compiler.Mu.Monad
-- Copyright   :  nathyong 2016
-- License     :  BSD3
--
-- Maintainer  :  nathyong@gmail.com
-- Stability   :  experimental
-- Portability :  unknown
--
-- Monad for interfacing with Mu
--

{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TemplateHaskell #-}

module Compiler.Mu.Monad (
      -- * Monad
      Mu
    , buildMu
    , runMu
      -- * Interface
    , flatten
) where

import Control.Monad.Except (MonadError, ExceptT, runExceptT)
import Control.Monad.State (State, MonadState, evalState, get)

import Lens.Micro.Platform (assign, modifying, makeLenses)

import Mu.PrettyPrint (PrettyPrint (..))
import Mu.Syntax
import Mu.Builder hiding (flatten)
import qualified Mu.Builder


-------------------------------------------------- * Data structures

data MuState = MuState
    { _builderState :: BuilderState
    , _currentBlock :: ()
    }

makeLenses ''MuState

emptyMuState :: MuState
emptyMuState = MuState emptyBuilderState ()

-------------------------------------------------- * Monad

newtype Mu a = Mu (ExceptT MuException (State MuState) a)
    deriving (Functor, Applicative, Monad, MonadState MuState, MonadError MuException)

instance PrettyPrint MuState where
    ppFormat = ppFormat . flatten

instance MuBuilder Mu where
    getBuilderState = get >>= return . _builderState
    putBuilderState = assign builderState
    getsBuilderState f = get >>= return . f . _builderState
    modifyBuilderState = modifying builderState

buildMu :: Mu a -> Either MuException Program
buildMu mu = case runMu (mu >> get) of
    Left x -> Left x
    Right ms -> Right (flatten ms)

runMu :: Mu a -> Either MuException a
runMu (Mu code) = evalState (runExceptT code) emptyMuState

-------------------------------------------------- * Utility functions

-- | Transform a BuilderState into a Program
flatten :: MuState -> Program
flatten (MuState bs _) = Mu.Builder.flatten bs