module Language.HERMIT.Plugin
       ( -- * The HERMIT Plugin
         HermitPass
       , hermitPlugin
)  where

import GhcPlugins
import Data.List
import System.IO

-- | Given a list of 'CommandLineOption's, produce the 'ModGuts' to 'ModGuts' function required to build a plugin.
type HermitPass = [CommandLineOption] -> ModGuts -> CoreM ModGuts

-- | Build a hermit plugin. This mainly handles the per-module options.
hermitPlugin :: HermitPass -> Plugin
hermitPlugin hp = defaultPlugin { installCoreToDos = install }
    where
        install :: [CommandLineOption] -> [CoreToDo] -> CoreM [CoreToDo]
        install opts todos = do
            reinitializeGlobals

            -- This is a bit of a hack; otherwise we lose what we've not seen
            liftIO $ hSetBuffering stdout NoBuffering

            dynFlags <- getDynFlags

            let
                myPass = CoreDoPluginPass "HERMIT" $ modFilter dynFlags hp opts
                -- at front, for now
                allPasses = myPass : todos

            return allPasses

-- | Determine whether to act on this module, choose plugin pass.
modFilter :: DynFlags -> HermitPass -> HermitPass
modFilter dynFlags hp opts guts | null modOpts && not (null opts) = return guts -- don't process this module
                       | otherwise    = hp modOpts guts
    where modOpts = filterOpts dynFlags opts guts

-- | Filter options to those pertaining to this module, stripping module prefix.
filterOpts :: DynFlags -> [CommandLineOption] -> ModGuts -> [CommandLineOption]
filterOpts dynFlags opts guts = [ drop len nm | nm <- opts, modName `isPrefixOf` nm ]
    where modName = showPpr dynFlags $ mg_module guts
          len = length modName + 1 -- for the colon