{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE TypeSynonymInstances       #-}
{-# LANGUAGE UndecidableInstances       #-}
module Distribution.HaskellSuite.Modules
  (
  -- * Module monad
  -- | When you need to resolve modules, you work in a 'ModuleT' monad (or
  -- another monad that is an instance of 'MonadModule') and use the
  -- 'getModuleInfo' function.
  --
  -- It finds an installed module by its name and reads (and caches) its
  -- info from the info file. Then you run a 'ModuleT' monadic action
  -- using 'evalModuleT' or 'runModuleT'.
  --
  -- To run a 'ModuleT' action you'll also need to provide the set of
  -- packages (represented by their 'InstalledPackageInfo') in which to
  -- search for modules. You can get such a set from either
  -- 'getInstalledPackages' or 'readPackagesInfo', depending on your use
  -- case.
    ModuleT
  , getModuleInfo
  , evalModuleT
  , runModuleT
  , MonadModule(..)
  -- * Module names
  , ModName(..)
  , convertModuleName
  ) where
import           Control.Monad
import           Control.Monad.Cont
import           Control.Monad.Except
import           Control.Monad.Reader
import           Control.Monad.State
import           Control.Monad.Writer
import           Data.List
import qualified Data.Map                           as Map
import           Distribution.HaskellSuite.Packages
import           Distribution.InstalledPackageInfo
import           Distribution.ModuleName
import           Distribution.Simple.Utils
import           Distribution.Text
import           System.FilePath

-- | This class defines the interface that is used by 'getModuleInfo', so
-- that you can use it in monads other than 'ModuleT'.
--
-- You don't typically have to define your own instances of this class, but
-- here are a couple of cases when you might:
--
-- * A pure (non-'MonadIO') mockup module monad for testing purposes
--
-- * A transformer over 'ModuleT'
--
-- * You need a more complex way to retrieve the module info
class Monad m => MonadModule m where
  -- | The type of module info
  type ModuleInfo m
  lookupInCache :: ModName n => n -> m (Maybe (ModuleInfo m))
  insertInCache :: ModName n => n -> ModuleInfo m -> m ()
  getPackages :: m Packages

  -- | Read the module info, given a list of search paths and the module
  -- name
  readModuleInfo :: ModName n => [FilePath] -> n -> m (ModuleInfo m)

-- | Different libraries (Cabal, haskell-src-exts, ...) use different types
-- to represent module names. Hence this class.
class ModName n where
  modToString :: n -> String

instance ModName String where
  modToString = id

instance ModName ModuleName where
  modToString = display

-- | Convert module name from arbitrary representation to Cabal's one
convertModuleName :: (ModName n) => n -> ModuleName
convertModuleName = fromString . modToString

-- | Tries to find the module in the current set of packages, then find the
-- module's info file, and reads and caches its contents.
--
-- Returns 'Nothing' if the module could not be found in the current set of
-- packages. If the module is found, but something else goes wrong (e.g.
-- there's no info file for it), an exception is thrown.
getModuleInfo :: (MonadModule m, ModName n) => n -> m (Maybe (ModuleInfo m))
getModuleInfo name = do
  cached <- lookupInCache name
  case cached of
    Just i -> return $ Just i
    Nothing -> do
      pkgs <- getPackages
      case findModule'sPackage pkgs name of
        Nothing -> return Nothing
        Just pkg -> do
          i <- readModuleInfo (libraryDirs pkg) name
          insertInCache name i
          return $ Just i

findModule'sPackage :: ModName n => Packages -> n -> Maybe InstalledPackageInfo
findModule'sPackage pkgs m =
  find
    ((convertModuleName m `elem`) . map exposedName . exposedModules)
    pkgs

-- | A standard module monad transformer.
--
-- @i@ is the type of module info, @m@ is the underlying monad.
newtype ModuleT i m a =
  ModuleT { unModuleT ::
    StateT (Map.Map ModuleName i)
      (ReaderT (Packages, [FilePath] -> ModuleName -> m i) m)
      a
  }
  deriving (Functor, Applicative, Monad, MonadWriter w, MonadError e, MonadCont)

instance MonadTrans (ModuleT i) where
  lift = ModuleT . lift . lift

instance MonadIO m => MonadIO (ModuleT i m) where
  liftIO = ModuleT . liftIO

instance (Functor m, Monad m) => MonadModule (ModuleT i m) where
  type ModuleInfo (ModuleT i m) = i
  lookupInCache n = ModuleT $ Map.lookup (convertModuleName n) <$> get
  insertInCache n i = ModuleT $ modify $ Map.insert (convertModuleName n) i
  getPackages = ModuleT $ asks fst
  readModuleInfo dirs mod =
    lift =<< ModuleT (asks snd) <*> pure dirs <*> pure (convertModuleName mod)

mapModuleT :: Monad m => (m a -> m b) -> ModuleT i m a -> ModuleT i m b
mapModuleT f m = ModuleT $ mapStateT (mapReaderT f') (unModuleT m)
  where
    f' ma = do
      (a,c) <- ma
      b <- f (return a)
      return (b,c)

instance MonadReader r m => MonadReader r (ModuleT i m) where
  ask    = lift ask
  local  = mapModuleT . local
  reader = lift . reader

instance MonadState s m => MonadState s (ModuleT i m) where
  get   = lift get
  put   = lift . put
  state = lift . state

-- | Run a 'ModuleT' action
runModuleT
  :: MonadIO m
  => ModuleT i m a -- ^ the monadic action to run
  -> Packages -- ^ packages in which to look for modules
  -> String -- ^ file extension of info files
  -> (FilePath -> m i) -- ^ how to read information from an info file
  -> Map.Map ModuleName i -- ^ initial set of module infos
  -> m (a, Map.Map ModuleName i)
  -- ^ return value, plus all cached module infos (that is, the initial set
  -- plus all infos that have been read by the action itself)
runModuleT (ModuleT a) pkgs suffix readInfo modMap =
  runReaderT (runStateT a modMap) (pkgs, findAndReadInfo)
  where
    findAndReadInfo dirs name = do
      (base, rel) <- liftIO $ findModuleFile dirs [suffix] name
      readInfo $ base </> rel

-- | Run a 'ModuleT' action.
--
-- This is a simplified version of 'runModuleT'.
evalModuleT
  :: MonadIO m
  => ModuleT i m a -- ^ the monadic action to run
  -> Packages -- ^ packages in which to look for modules
  -> String -- ^ file extension of info files
  -> (FilePath -> m i) -- ^ how to read information from an info file
  -> m a
evalModuleT a pkgs suffix readInfo =
  fst `liftM` runModuleT a pkgs suffix readInfo Map.empty