Monad.hs

module Language.Java.Paragon.NameResolution.Monad 
    ( 

     module Language.Java.Paragon.Monad.PiReader,

     NameRes, Expansion, runNameRes,

     getCurrentName,

     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.Strict as Map
import qualified Data.ByteString.Char8 as B

-- Remember the fully qualified name of the current entity
-- so we don't go looking for it, plus the list of names in scope.
newtype NameRes a = NameRes { runNameRes :: Name () -> Expansion -> PiReader a }

instance Monad NameRes where
  return = liftPR . return
  NameRes f >>= k = NameRes $ \n e -> do
                         a <- f n e
                         let NameRes g = k a
                          in g n 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

getCurrentName :: NameRes (Name ())
getCurrentName = NameRes $ \n _ -> return n

withExpansion :: Expansion -> NameRes a -> NameRes a
withExpansion e (NameRes f) = NameRes $ \n _ -> f n 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 (B.ByteString,                   NameType)   -- NameType may be (partially) unresolved
        (Either String (Maybe (Name ()), NameType))  -- NameType is now fully resolved

mkPExpansion, mkTExpansion, mkEExpansion, mkMExpansion, mkLExpansion :: 
    B.ByteString -> [((B.ByteString, 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))]