ghc-mod/NotCPP/ScopeLookup.hs

66 lines
2.0 KiB
Haskell

{-# LANGUAGE TemplateHaskell #-}
-- |
-- This module exports 'scopeLookup', which will find a variable or
-- value constructor for you and present it for your use. E.g. at some
-- point in the history of the acid-state package, 'openAcidState' was
-- renamed 'openLocalState'; for compatibility with both, you could
-- use:
--
-- > openState :: IO (AcidState st)
-- > openState = case $(scopeLookup "openLocalState") of
-- > Just open -> open defaultState
-- > Nothing -> case $(scopeLookup "openAcidState") of
-- > Just open -> open defaultState
-- > Nothing -> error
-- > "openState: runtime name resolution has its drawbacks :/"
--
-- Or, for this specific case, you can use 'scopeLookups':
--
-- > openState :: IO (AcidState st)
-- > openState = open defaultState
-- > where
-- > open = $(scopeLookups ["openLocalState","openAcidState"])
--
-- Now if neither of the names are found then TH will throw a
-- compile-time error.
module NotCPP.ScopeLookup (
scopeLookup,
scopeLookups,
scopeLookup',
liftMaybe,
recoverMaybe,
maybeReify,
infoToExp,
) where
import Control.Applicative ((<$>))
import Language.Haskell.TH (Q, Exp, recover, reify)
import NotCPP.LookupValueName
import NotCPP.Utils
-- | Produces a spliceable expression which expands to @'Just' val@ if
-- the given string refers to a value @val@ in scope, or 'Nothing'
-- otherwise.
--
-- @scopeLookup = 'fmap' 'liftMaybe' . 'scopeLookup''@
scopeLookup :: String -> Q Exp
scopeLookup = fmap liftMaybe . scopeLookup'
-- | Finds the first string in the list that names a value, and produces
-- a spliceable expression of that value, or reports a compile error if
-- it fails.
scopeLookups :: [String] -> Q Exp
scopeLookups xs = foldr
(\s r -> maybe r return =<< scopeLookup' s)
(fail ("scopeLookups: none found: " ++ show xs))
xs
-- | Produces @'Just' x@ if the given string names the value @x@,
-- or 'Nothing' otherwise.
scopeLookup' :: String -> Q (Maybe Exp)
scopeLookup' s = recover (return Nothing) $ do
Just n <- lookupValueName s
infoToExp <$> reify n