{-# LANGUAGE TemplateHaskell #-}

module HsDev.Inspect.Types (
        Preloaded(..), preloadedId, preloadedMode, preloadedModule, asModule, toImport, preloaded,
        InspectedPreloaded,
        Environment, FixitiesTable,
        Resolved(..), resolvedModule, resolvedSource, resolvedDefs, resolvedImports, resolvedExports, resolvedScope, resolvedFixities,
        InspectedResolved,

        resolvedEnv, resolvedFixitiesTable,

        dropScope, noScope, withNoScope
        ) where

import Control.DeepSeq
import Control.Lens
import Data.Map (Map)
import qualified Data.Map as M
import Data.String
import Data.Text (Text)
import qualified Language.Haskell.Exts as H
import qualified Language.Haskell.Names as N
import qualified Language.Haskell.Names.GlobalSymbolTable as N

import HsDev.Symbols.Types
import HsDev.Symbols.Parsed (Parsed, pos)

-- | Preloaded module with contents and extensions
data Preloaded = Preloaded {
        _preloadedId :: ModuleId,
        _preloadedMode :: H.ParseMode,
        _preloadedModule :: H.Module H.SrcSpanInfo,
        -- ^ Loaded module head without declarations
        _preloaded :: Text }

instance NFData Preloaded where
        rnf (Preloaded mid _ _ cts) = rnf mid `seq` rnf cts

asModule :: Lens' Preloaded Module
asModule = lens g' s' where
        g' p = Module {
                _moduleId = _preloadedId p,
                _moduleDocs = Nothing,
                _moduleImports = map toImport idecls,
                _moduleExports = mempty,
                _moduleFixities = mempty,
                _moduleScope = mempty,
                _moduleSource = Just $ fmap (N.Scoped N.None) $ _preloadedModule p }
                where
                        H.Module _ _ _ idecls _ = _preloadedModule p
        s' p m = p {
                _preloadedId = _moduleId m,
                _preloadedModule = maybe (_preloadedModule p) dropScope (_moduleSource m) }

toImport :: H.ImportDecl H.SrcSpanInfo -> Import
toImport idecl@(H.ImportDecl _ mname qual _ _ _ alias _) = Import (idecl ^. pos) (fromString $ getModuleName mname) qual (fmap (fromString . getModuleName) alias) where
        getModuleName (H.ModuleName _ s) = s

type InspectedPreloaded = Inspected ModuleLocation ModuleTag Preloaded

-- | Symbols environment, used to resolve names in source
type Environment = N.Environment

-- | Fixities environment, needed to parse source
type FixitiesTable = Map Name H.Fixity

-- | Resolved module
data Resolved = Resolved {
        _resolvedModule :: H.ModuleName (),
        _resolvedSource :: Parsed,
        _resolvedDefs :: [Symbol],
        _resolvedImports :: [Import],
        _resolvedExports :: [N.Symbol],
        _resolvedScope :: N.Table,
        _resolvedFixities :: [H.Fixity] }

instance NFData Resolved where
        rnf (Resolved _ _ defs imps _ _ _) = rnf defs `seq` rnf imps

-- | Like @InspectedModule@, but for @Resolved@
type InspectedResolved = Inspected ModuleLocation ModuleTag Resolved

-- | Get environment for resolved module
resolvedEnv :: Resolved -> Environment
resolvedEnv r = M.singleton (_resolvedModule r) (_resolvedExports r)

-- | Get fixities table from resolved module
resolvedFixitiesTable :: Resolved -> FixitiesTable
resolvedFixitiesTable r = mconcat [M.singleton n f | f@(H.Fixity _ _ n) <- _resolvedFixities r]

-- | Drop extra info
dropScope :: Functor f => f (N.Scoped l) -> f l
dropScope = fmap (\(N.Scoped _ a) -> a)

-- | Empty scope info
noScope :: l -> N.Scoped l
noScope = N.Scoped N.None

-- | Set empty scope
withNoScope :: Functor f => f l -> f (N.Scoped l)
withNoScope = fmap noScope

makeLenses ''Preloaded
makeLenses ''Resolved