Monad.hs

module Language.Java.Paragon.NameResolution.Monad 
    ( 

     module Language.Java.Paragon.Monad.PiReader,

     NameRes, Expansion, runNameRes,

     getExpansion, withExpansion, extendExpansion,

     mkPExpansion, mkTExpansion, mkEExpansion, mkMExpansion, mkLExpansion    

    ) where

import Language.Java.Paragon.Syntax
import Language.Java.Paragon.Monad.PiReader

import Control.Monad
import Control.Applicative

import qualified Data.Map as Map


newtype NameRes a = NameRes { runNameRes :: Expansion -> PiReader a }

instance Monad NameRes where
  return = liftPR . return
  NameRes f >>= k = NameRes $ \e -> do
                         a <- f e
                         let NameRes g = k a
                          in g e

  fail = liftPR . fail

instance MonadPR NameRes where
  liftPR pr = NameRes $ \_ -> pr

instance MonadBase NameRes where
  liftBase = liftPR . liftBase
  withErrCtxt' prf (NameRes f) = NameRes $ withErrCtxt' prf . f
  tryM (NameRes f) = NameRes $ tryM . f

instance MonadIO NameRes where
  liftIO = liftPR . liftIO

instance Functor NameRes where
  fmap = liftM

instance Applicative NameRes where
  pure = return
  (<*>) = ap


getExpansion :: NameRes Expansion
getExpansion = NameRes return

withExpansion :: Expansion -> NameRes a -> NameRes a
withExpansion e (NameRes f) = NameRes $ \_ -> f e

extendExpansion :: Expansion -> NameRes a -> NameRes a
extendExpansion e1 nra = do
  e2 <- getExpansion
  withExpansion (Map.union e1 e2) nra

------------------------------------------
-- Building expansion maps

type Map = Map.Map

type Expansion = 
    Map (Ident (),                       NameType)   -- NameType may be (partially) unresolved
        (Either String (Maybe (Name ()), NameType))  -- NameType is now fully resolved

mkPExpansion, mkTExpansion, mkEExpansion, mkMExpansion, mkLExpansion :: 
    Ident () -> [((Ident (), NameType), Either String (Maybe (Name ()), NameType))]

mkPExpansion i = [((i, PName   ), return (Nothing, PName)),
                  ((i, POrTName), return (Nothing, PName)),
                  ((i, AmbName ), return (Nothing, PName))]

mkTExpansion i = [((i, TName   ), return (Nothing, TName)),
                  ((i, POrTName), return (Nothing, TName)),
                  ((i, AmbName ), return (Nothing, TName))]

mkEExpansion i = [((i, EName   ), return (Nothing, EName)),
                  ((i, EOrLName), return (Nothing, EName)),
                  ((i, AmbName ), return (Nothing, EName))]

mkMExpansion i = [((i, MName   ), return (Nothing, MName)),
                  ((i, MOrLName), return (Nothing, MName)),
                  ((i, AmbName ), return (Nothing, MName))]

mkLExpansion i = [((i, LName   ), return (Nothing, LName)),
                  ((i, MOrLName), return (Nothing, LName)),
                  ((i, EOrLName), return (Nothing, LName)),
                  ((i, AmbName ), return (Nothing, LName))]