module DDC.Build.Interface.Store
        ( Store
        , new, wrap, load

        , Meta  (..)
        , getMeta
        , getModuleNames
        , getInterfaces

        , Super (..)
        , findSuper)
where
import DDC.Base.Pretty
import DDC.Build.Interface.Base         
import DDC.Build.Interface.Load
import DDC.Core.Call
import DDC.Core.Module
import DDC.Type.Exp
import System.Directory
import Data.Time.Clock
import Data.IORef
import Data.Maybe
import Data.Map                         (Map)
import qualified DDC.Core.Tetra         as E
import qualified DDC.Core.Salt          as A
import qualified Data.Map               as Map


---------------------------------------------------------------------------------------------------
-- | Abstract API to a collection of module interfaces.
--
--   This lives in IO land because in future we want to demand-load the
--   inferface files as needed, rather than loading the full dependency
--   tree. Keeping it in IO means that callers must also be in IO.
data Store
        = Store
        { -- | Metadata for interface files currently in the store.
          storeMeta       :: IORef [Meta]

          -- | Lookup the definition of the given top-level super, 
          --   from one or more of the provided modules.
        , storeSupers     :: IORef (Map ModuleName (Map E.Name Super)) 

          -- | Fully loaded interface files.
          --   In future we want to load parts of interface files on demand, 
          --   and not the whole lot.
        , storeInterfaces :: IORef [InterfaceAA] }


---------------------------------------------------------------------------------------------------
-- | Metadata for interfaces currently loaded into the store.
data Meta
        = Meta
        { metaFilePath     :: FilePath
        , metaTimeStamp    :: UTCTime
        , metaModuleName   :: ModuleName }
        deriving Show

instance Pretty Meta where
        ppr (Meta path stamp name)
         = hsep [ padL 60 $ text (show path)
                , padL 30 $ text (show stamp)
                , text (show name)]


-- | Interface for some top-level super.
data Super
        = Super
        { -- | Name of the super.
          superName             :: E.Name

          -- | Where the super was imported from.
          --
          --   This is the module that the name was resolved from. If that
          --   module re-exported an imported name then this may not be the
          --   module the super was actually defined in.
        , superModuleName       :: ModuleName

          -- | Tetra type for the super.
        , superTetraType        :: Type E.Name

          -- | Salt type for the super.
        , superSaltType         :: Type A.Name 

          -- | Import source for the super.
          --
          --   This can be used to refer to the super from a client module.
        , superImportValue      :: ImportValue E.Name }


---------------------------------------------------------------------------------------------------
-- | An empty interface store.
new :: IO Store
new
 = do   refMeta         <- newIORef []
        refSupers       <- newIORef Map.empty
        refInterfaces   <- newIORef []
        return  $ Store 
                { storeMeta             = refMeta
                , storeSupers           = refSupers 
                , storeInterfaces       = refInterfaces }


-- | Add a pre-loaded interface file to the store.
wrap    :: Store -> InterfaceAA -> IO ()
wrap store ii
 = do   modifyIORef (storeMeta store)
         $ \meta   -> meta ++ [metaOfInterface ii] 

        modifyIORef (storeSupers store)
         $ \supers -> Map.insert (interfaceModuleName ii)
                                 (supersOfInterface   ii)
                                 supers

        modifyIORef (storeInterfaces store)
         $ \iis    -> iis ++ [ii]


-- | Load a new interface from a file.
load    :: FilePath -> IO (Either Error InterfaceAA)
load filePath
 = do   timeStamp  <- getModificationTime filePath
        str        <- readFile filePath
        return $ loadInterface filePath timeStamp str


-- | Get metadata of interfaces currently in the store.
getMeta :: Store -> IO [Meta]
getMeta store
 = do   mm      <- readIORef (storeMeta store)
        return  $ mm


-- | Get names of the modules currently in the store.
getModuleNames :: Store -> IO [ModuleName]
getModuleNames store
 = do   supers  <- readIORef (storeSupers store)
        return  $ Map.keys supers


-- | Get the fully loaded interfaces.
getInterfaces :: Store -> IO [InterfaceAA]
getInterfaces store
 = do   ints    <- readIORef (storeInterfaces store)
        return ints


-- | See if a super is defined in any of the given modules, and if so
--   return the module name and super type.
--
--   NOTE: This function returns an IO [Super] in preparation for the case
--   where we load data from interface files on demand. We want to ensure
--   that the caller is also in IO, to make the refactoring easier later.
--
findSuper
        :: Store
        -> E.Name               -- ^ Name of desired super.
        -> [ModuleName]         -- ^ Names of modules to search.
        -> IO [Super]

findSuper store n modNames 
 = do   supers  <- readIORef (storeSupers store)
        return $ mapMaybe
                (\modName -> do
                        nSupers <- Map.lookup modName supers
                        Map.lookup n nSupers)
                modNames


---------------------------------------------------------------------------------------------------
-- | Extract metadata from an interface.
metaOfInterface   :: InterfaceAA -> Meta
metaOfInterface ii
        = Meta
        { metaFilePath   = interfaceFilePath   ii
        , metaTimeStamp  = interfaceTimeStamp  ii
        , metaModuleName = interfaceModuleName ii }


-- | Extract a map of super interfaces from the given module interface.
--
--   This contains all the information needed to import a super into
--   a client module.
--
supersOfInterface :: InterfaceAA -> Map E.Name Super
supersOfInterface ii
 | Just mmTetra <- interfaceTetraModule ii
 , Just mmSalt  <- interfaceSaltModule  ii
 = let  
        -- The current module name.
        modName = interfaceModuleName ii

        -- Collect Tetra types for all supers exported by the module.
        ntsTetra    
         = Map.fromList
           [ (n, t)     | (n, esrc)     <- moduleExportValues mmTetra
                        , let Just t    =  takeTypeOfExportSource esrc ]

        -- Collect Salt  types of all supers exported by the module.
        ntsSalt 
         = Map.fromList
           [ (n, t)     | (n, esrc)     <- moduleExportValues mmSalt
                        , let Just t    =  takeTypeOfExportSource esrc ]

        -- Build call patterns for all locally defined supers.
        --  The call pattern is the number of type parameters then value parameters
        --  for the super. We assume all supers are in prenex form, so they take
        --  all their type arguments before their value arguments.
        makeLocalArity b x
         | BName nSuper _       <- b
         , cs                   <- takeCallConsFromExp x
         , Just (csType, csValue, csBox) <- splitStdCallCons cs
         = (nSuper, (length csType, length csValue, length csBox))

         | otherwise = error "ddc-build.supersOfInterface: type is not in prenex form."

        nsLocalArities :: Map E.Name (Int, Int, Int)
                =  Map.fromList
                $  mapTopBinds makeLocalArity
                $  mmTetra

        -- Build an ImportSource for the given super name. A client module
        -- can use this to import the super into itself.
        makeImportValue n

         -- Super was defined as a top-level binding in the current module.
         | Just (aType, aValue, nBoxes) <- Map.lookup n nsLocalArities
         , Just tTetra                  <- Map.lookup n ntsTetra
         = ImportValueModule modName n tTetra (Just (aType, aValue, nBoxes))

         -- Super was imported into the current module from somewhere else.
         -- Pass along the same import declaration to the client.
         | Just impt            <- lookup n (moduleImportValues mmTetra)
         = impt

         | otherwise = error $ "ddc-build.supersOfInterface: no source" ++ show n

        makeSuper n tTetra
         | E.NameVar s  <- n
         = Just $ Super
                { superName         = n
                , superModuleName   = moduleName mmTetra
                , superTetraType    = tTetra
                , superSaltType     = let Just t = Map.lookup (A.NameVar s) ntsSalt  in t 
                , superImportValue  = makeImportValue n }
         | otherwise    = Nothing


   in   Map.fromList   
          [ (n, super)  | (n, tTetra)    <- Map.toList ntsTetra 
                        , let Just super = makeSuper n tTetra ]

 | otherwise
 = Map.empty