content: {-# LANGUAGE FlexibleInstances          #-}
  {-# LANGUAGE GeneralizedNewtypeDeriving #-}
  {-# LANGUAGE NoImplicitPrelude          #-}
  {-# LANGUAGE TypeFamilies               #-}
  {-# LANGUAGE TypeSynonymInstances       #-}
  module Fay.Compiler.ModuleT
    (
    -- * 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
    , runModuleT
    , MonadModule (..)
    -- * Module names
    , ModName (..)
    ) where
  
  import           Fay.Compiler.Prelude
  
  import           Control.Monad.Reader
  import           Control.Monad.State
  import qualified Data.Char            as Char (isAlphaNum, isUpper)
  import qualified Data.Map             as Map
  
  -- ModuleName extracted from Cabal, (c) 2008 Duncan Coutts, Licensed as BSD3
  newtype ModuleName = ModuleName [String]
    deriving (Eq, Ord, Show)
  
  fromString :: String -> ModuleName
  fromString string
    | all validModuleComponent components' = ModuleName components'
    | otherwise                            = error $ "ModuleName.fromString: invalid module name " ++ show string
  
    where
      components' = split string
  
      split cs = case break (=='.') cs of
        (chunk,[])     -> [chunk]
        (chunk,_:rest) -> chunk : split rest
  
      validModuleComponent :: String -> Bool
      validModuleComponent []     = False
      validModuleComponent (c:cs) = Char.isUpper c
                             && all validModuleChar cs
  
      validModuleChar :: Char -> Bool
      validModuleChar c = Char.isAlphaNum c || c == '_' || c == '\''
  
  
  -- | 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 ()
  
    -- | 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
  
  -- | 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 = lookupInCache
  
  -- | A standard module monad transformer.
  --
  -- @i@ is the type of module info, @m@ is the underlying monad.
  newtype ModuleT i m a =
    ModuleT
      (StateT (Map.Map ModuleName i)
              (ReaderT ([FilePath] -> ModuleName -> m i) m) a)
    deriving (Functor, Applicative, Monad)
  
  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
    readModuleInfo dirs mod' =
      lift =<< ModuleT ask <*> pure dirs <*> pure (convertModuleName mod')
  
  -- | Run a 'ModuleT' action
  runModuleT
    :: (Monad m, Monoid i)
    => ModuleT i m a -- ^ the monadic action to run
    -> 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) =
    runReaderT (runStateT a Map.empty) (\_ _ -> return mempty)
  