{-# LANGUAGE DeriveDataTypeable, TemplateHaskell #-}
-- | Session queries
--
-- We have to be very careful in the types in this module. We should not be
-- using internal types (with explicit sharing or types such as StrictMap),
-- except as part of abstract XShared types.
module IdeSession.Query (
    -- * Types
    Query
  , ManagedFiles(..)
  , InvalidSessionStateQueries(..)
    -- * Queries that rely on the static part of the state only
  , getSessionConfig
  , getSourcesDir
  , getDataDir
  , getDistDir
  , getSourceModule
  , getDataFile
  , getAllDataFiles
  , getCabalMacros
    -- * Queries that do not rely on computed state
  , getCodeGeneration
  , getEnv
  , getArgs
  , getGhcServer
  , getGhcVersion
  , getManagedFiles
  , getBuildExeStatus
  , getBuildDocStatus
  , getBuildLicensesStatus
  , getBreakInfo
    -- * Queries that rely on computed state
  , getSourceErrors
  , getLoadedModules
  , getFileMap
  , getSpanInfo
  , getExpTypes
  , getImports
  , getAutocompletion
  , getPkgDeps
  , getUseSites
  , getDotCabal
    -- * Debugging (internal use only)
  , dumpIdInfo
  , dumpAutocompletion
  , dumpFileMap
  ) where

import Prelude hiding (mod, span)
import Control.Exception (Exception, throwIO)
import Control.Monad (forM_)
import Data.Accessor ((^.), (^:), getVal)
import Data.List (isInfixOf, sortBy)
import Data.Maybe (listToMaybe, maybeToList)
import Data.Text (Text)
import Data.Typeable (Typeable)
import Data.Version (Version)
import System.Exit (ExitCode)
import System.FilePath ((</>))
import qualified Data.ByteString.Char8 as BSSC
import qualified Data.ByteString.Lazy as BSL
import qualified Data.Text as Text (pack, unpack)
import qualified System.FilePath.Find as Find

import IdeSession.Cabal
import IdeSession.Config
import IdeSession.GHC.API
import IdeSession.RPC.Client (ExternalException(..))
import IdeSession.State
import IdeSession.Strict.Container
import IdeSession.Types.Public
import IdeSession.Types.Translation
import IdeSession.Util.BlockingOps
import qualified IdeSession.Strict.IntMap as StrictIntMap
import qualified IdeSession.Strict.IntervalMap as StrictIntervalMap
import qualified IdeSession.Strict.List   as StrictList
import qualified IdeSession.Strict.Map    as StrictMap
import qualified IdeSession.Strict.Maybe  as StrictMaybe
import qualified IdeSession.Strict.Trie   as StrictTrie
import qualified IdeSession.Types.Private as Private

{------------------------------------------------------------------------------
  Types
------------------------------------------------------------------------------}

-- | The type of queries in a given session state.
--
-- Queries are in IO because they depend on the current state of the session
-- but they promise not to alter the session state (at least not in any visible
-- way; they might update caches, etc.).
--
type Query a = IdeSession -> IO a

-- | The collection of source and data files submitted by the user.
data ManagedFiles = ManagedFiles
  { sourceFiles :: [FilePath]
  , dataFiles   :: [FilePath]
  }
  deriving Show

{------------------------------------------------------------------------------
  Queries that rely on the static part of the state only
------------------------------------------------------------------------------}

-- | Recover the fixed config the session was initialized with.
getSessionConfig :: Query SessionConfig
getSessionConfig = staticQuery $ return . ideConfig

-- | Obtain the source files directory for this session.
getSourcesDir :: Query FilePath
getSourcesDir = staticQuery $ return . ideSessionSourceDir . ideSessionDir

-- | Obtain the data files directory for this session.
getDataDir :: Query FilePath
getDataDir = staticQuery $ return . ideSessionDataDir . ideSessionDir

-- | Obtain the directory prefix for results of Cabal invocations.
-- Executables compiled in this session end up in a subdirectory @build@,
-- haddocks in @doc@, concatenated licenses in file @licenses@, etc.
getDistDir :: Query FilePath
getDistDir = staticQuery $ return . ideSessionDistDir . ideSessionDir

-- | Read the current value of one of the source modules.
getSourceModule :: FilePath -> Query BSL.ByteString
getSourceModule path = staticQuery $ \IdeStaticInfo{ideSessionDir} ->
  BSL.readFile $ ideSessionSourceDir ideSessionDir </> path

-- | Read the current value of one of the data files.
getDataFile :: FilePath -> Query BSL.ByteString
getDataFile path = staticQuery $ \IdeStaticInfo{ideSessionDir} ->
  BSL.readFile $ ideSessionDataDir ideSessionDir </> path

-- | Get the list of all data files currently available to the session:
-- both the files copied via an update and files created by user code.
getAllDataFiles :: Query [FilePath]
getAllDataFiles = staticQuery $ \IdeStaticInfo{ideSessionDir} ->
  Find.find Find.always
            (Find.fileType Find.==? Find.RegularFile)
            (ideSessionDataDir ideSessionDir)

getCabalMacros :: Query BSL.ByteString
getCabalMacros = staticQuery $ \IdeStaticInfo{ideSessionDir} ->
  BSL.readFile $ cabalMacrosLocation (ideSessionDistDir ideSessionDir)

{------------------------------------------------------------------------------
  Queries that do not rely on computed state
------------------------------------------------------------------------------}

-- | Is code generation currently enabled?
getCodeGeneration :: Query Bool
getCodeGeneration = simpleQuery $ getVal ideGenerateCode

-- | Get all current environment overrides
getEnv :: Query [(String, Maybe String)]
getEnv = simpleQuery $ getVal ideEnv

-- | Get all current snippet args
getArgs :: Query [String]
getArgs = simpleQuery $ getVal ideArgs

-- | Get the RPC server used by the session.
getGhcServer :: Query GhcServer
getGhcServer = simpleQuery $ getVal ideGhcServer

-- | Which GHC version is `ide-backend-server` using?
getGhcVersion :: Query GhcVersion
getGhcVersion = simpleQuery $ getVal ideGhcVersion

-- | Get the collection of files submitted by the user and not deleted yet.
-- The module names are those supplied by the user as the first
-- arguments of the @updateSourceFile@ and @updateSourceFileFromFile@ calls,
-- as opposed to the compiler internal @module ... end@ module names.
-- Usually the two names are equal, but they needn't be.
getManagedFiles :: Query ManagedFiles
getManagedFiles = simpleQuery $ translate . getVal ideManagedFiles
  where
    translate :: ManagedFilesInternal -> ManagedFiles
    translate files = ManagedFiles {
        sourceFiles = map fst $ _managedSource files
      , dataFiles   = map fst $ _managedData   files
      }

-- | Get exit status of the last invocation of 'buildExe', if any.
getBuildExeStatus :: Query (Maybe ExitCode)
getBuildExeStatus = simpleQuery $ getVal ideBuildExeStatus

-- | Get exit status of the last invocation of 'buildDoc', if any.
getBuildDocStatus :: Query (Maybe ExitCode)
getBuildDocStatus = simpleQuery $ getVal ideBuildDocStatus

-- | Get exit status of the last invocation of 'buildLicenses', if any.
getBuildLicensesStatus :: Query (Maybe ExitCode)
getBuildLicensesStatus = simpleQuery $ getVal ideBuildLicensesStatus

-- | Get information about the last breakpoint that we hit
--
-- Returns Nothing if we are not currently stopped on a breakpoint.
getBreakInfo :: Query (Maybe BreakInfo)
getBreakInfo = simpleQuery $ toLazyMaybe . getVal ideBreakInfo

{------------------------------------------------------------------------------
  Queries that rely on computed state
------------------------------------------------------------------------------}

-- | Get any compilation errors or warnings in the current state of the
-- session, meaning errors that GHC reports for the current state of all the
-- source modules.
--
-- Note that in the initial implementation this will only return warnings from
-- the modules that changed in the last update, the intended semantics is that
-- morally it be a pure function of the current state of the files, and so it
-- would return all warnings (as if you did clean and rebuild each time).
--
-- getSourceErrors does internal normalization. This simplifies the life of the
-- client and anyway there shouldn't be that many source errors that it really
-- makes a big difference.
getSourceErrors :: Query [SourceError]
getSourceErrors = computedQuery $ \Computed{..} ->
  toLazyList $ StrictList.map (removeExplicitSharing computedCache) computedErrors

-- | Get the list of correctly compiled modules, as reported by the compiler
getLoadedModules :: Query [ModuleName]
getLoadedModules = computedQuery $ \Computed{..} ->
  toLazyList $ computedLoadedModules

-- | Get the mapping from filenames to modules (as computed by GHC)
getFileMap :: Query (FilePath -> Maybe ModuleId)
getFileMap = computedQuery $ \Computed{..} path ->
  fmap (removeExplicitSharing computedCache) $
    StrictMap.lookup path computedFileMap

-- | Get information about an identifier at a specific location
getSpanInfo :: Query (ModuleName -> SourceSpan -> [(SourceSpan, SpanInfo)])
getSpanInfo = computedQuery $ \computed@Computed{..} mod span ->
  let aux (a, b) = ( removeExplicitSharing computedCache a
                   , removeExplicitSharing computedCache b
                   )
  in map aux . maybeToList $ internalGetSpanInfo computed mod span

internalGetSpanInfo :: Computed -> ModuleName -> SourceSpan
                    -> Maybe (Private.SourceSpan, Private.SpanInfo)
internalGetSpanInfo Computed{..} mod span = case (mSpan, mIdMap) of
    (Just span', Just (Private.IdMap idMap)) ->
      let doms = Private.dominators span' idMap
      in listToMaybe (prioritize doms)
    _ -> Nothing
  where
    mSpan  = introduceExplicitSharing computedCache span
    mIdMap = StrictMap.lookup mod computedSpanInfo

    prioritize :: [(Private.SourceSpan, Private.SpanInfo)]
               -> [(Private.SourceSpan, Private.SpanInfo)]
    prioritize = sortBy $ \(_, a) (_, b) ->
      case (a, b) of
        (Private.SpanQQ _,       Private.SpanId _)       -> LT
        (Private.SpanInSplice _, Private.SpanId _)       -> LT
        (Private.SpanId _,       Private.SpanQQ _)       -> GT
        (Private.SpanId _,       Private.SpanInSplice _) -> GT
        (_, _) -> EQ

-- | Get information the type of a subexpressions and the subexpressions
-- around it
getExpTypes :: Query (ModuleName -> SourceSpan -> [(SourceSpan, Text)])
getExpTypes = computedQuery $ \Computed{..} mod span ->
  let mSpan   = introduceExplicitSharing computedCache span
      mExpMap = StrictMap.lookup mod computedExpTypes
  in case (mSpan, mExpMap) of
    (Just span', Just (Private.ExpMap expMap)) ->
      let aux (a, b) = ( removeExplicitSharing computedCache a
                       , b
                       )
          doms = map aux $ Private.dominators span' expMap
      in doms
    _ ->
      []

-- | Get import information
--
-- This information is available even for modules with parse/type errors
getImports :: Query (ModuleName -> Maybe [Import])
getImports = computedQuery $ \Computed{..} mod ->
  fmap (toLazyList . StrictList.map (removeExplicitSharing computedCache)) $
    StrictMap.lookup mod computedImports

-- | Autocompletion
--
-- Use 'idInfoQN' to translate these 'IdInfo's into qualified names, taking
-- into account the module imports.
getAutocompletion :: Query (ModuleName -> String -> [IdInfo])
getAutocompletion = computedQuery $ \Computed{..} ->
    autocomplete computedCache computedAutoMap
  where
    autocomplete :: Private.ExplicitSharingCache
                 -> Strict (Map ModuleName) (Strict Trie (Strict [] (XShared IdInfo)))
                 -> ModuleName -> String
                 -> [IdInfo]
    autocomplete cache mapOfTries modName name =
        let name' = BSSC.pack name
            n     = last (BSSC.split '.' name')
        in filter (\idInfo -> name `isInfixOf` idInfoQN idInfo)
             $ concatMap (toLazyList . StrictList.map (removeExplicitSharing cache))
             . StrictTrie.elems
             . StrictTrie.submap n
             $ StrictMap.findWithDefault StrictTrie.empty modName mapOfTries

-- | (Transitive) package dependencies
--
-- These are only available for modules that got compiled successfully.
getPkgDeps :: Query (ModuleName -> Maybe [PackageId])
getPkgDeps = computedQuery $ \Computed{..} mod ->
  fmap (toLazyList . StrictList.map (removeExplicitSharing computedCache)) $
    StrictMap.lookup mod computedPkgDeps

-- | Use sites
--
-- Use sites are only reported in modules that get compiled successfully.
getUseSites :: Query (ModuleName -> SourceSpan -> [SourceSpan])
getUseSites = computedQuery $ \computed@Computed{..} mod span ->
  maybeListToList $ do
    (_, spanId)        <- internalGetSpanInfo computed mod span
    Private.IdInfo{..} <- case spanId of
                            Private.SpanId       idInfo -> return idInfo
                            Private.SpanQQ       _      -> Nothing
                            Private.SpanInSplice idInfo -> return idInfo
    return $ map (removeExplicitSharing computedCache)
           . concatMap (maybeListToList . StrictMap.lookup idProp)
           $ StrictMap.elems computedUseSites
  where
    maybeListToList :: Maybe [a] -> [a]
    maybeListToList (Just xs) = xs
    maybeListToList Nothing   = []

-- | Minimal .cabal file for the loaded modules seen as a library.
-- The argument specifies the name of the library.
--
-- License is set to @AllRightsReserved@.
-- All transitive package dependencies are included,
-- with package versions set to the currently used versions.
-- Only modules that get compiled successfully are included.
-- Source directory is the currently used session source directory.
-- Warning: all modules named @Main@ (even in subdirectories
-- or files with different names) are ignored so that they
-- don't get in the way when we build an executable using the library
-- and so that the behaviour is consistent with that of @buildExe@.
getDotCabal :: Query (String -> Version -> BSL.ByteString)
getDotCabal session = withComputedState session
                      $ \idleState computed@Computed{..} -> do
  let sourcesDir       = ideSessionSourceDir . ideSessionDir $ ideStaticInfo session
      options          = idleState ^. ideGhcOpts
      relativeIncludes = idleState ^. ideRelativeIncludes
  buildDotCabal sourcesDir relativeIncludes options computed

{------------------------------------------------------------------------------
  Debugging
------------------------------------------------------------------------------}

-- | Print the id info maps to stdout (for debugging purposes only)
dumpIdInfo :: IdeSession -> IO ()
dumpIdInfo session = withComputedState session $ \_ Computed{..} ->
  forM_ (StrictMap.toList computedSpanInfo) $ \(mod, idMap) -> do
    putStrLn $ "*** " ++ Text.unpack mod ++ " ***"
    forM_ (StrictIntervalMap.toList (Private.idMapToMap idMap)) $ \(i, idInfo) -> do
      let idInfo' = removeExplicitSharing computedCache idInfo
          (StrictIntervalMap.Interval (fn, fromLine, fromCol) (_, toLine, toCol)) = i
          fn' = dereferenceFilePathPtr computedCache fn
      putStrLn $ show (fn', fromLine, fromCol, toLine, toCol)  ++ ": " ++ show idInfo'

-- | Print autocompletion to stdout (for debugging purposes only)
dumpAutocompletion :: IdeSession -> IO ()
dumpAutocompletion session = withComputedState session $ \_ Computed{..} ->
  forM_ (StrictMap.toList computedAutoMap) $ \(mod, autoMap) -> do
    putStrLn $ "*** " ++ Text.unpack mod ++ " ***"
    forM_ (StrictTrie.toList autoMap) $ \(key, idInfos) ->
      forM_ (toLazyList idInfos) $ \idInfo -> do
        let idInfo' :: IdInfo
            idInfo' = removeExplicitSharing computedCache idInfo
        putStrLn $ show key  ++ ": " ++ show idInfo'

-- | Print file mapping to stdout (for debugging purposes only)
dumpFileMap :: IdeSession -> IO ()
dumpFileMap session = withComputedState session $ \_ Computed{..} ->
  forM_ (StrictMap.toList computedFileMap) $ \(path, mod) -> do
    let mod' = removeExplicitSharing computedCache mod
    putStrLn $ path ++ ": " ++ show mod'

{------------------------------------------------------------------------------
  Auxiliary
------------------------------------------------------------------------------}

-- | For the purposes of queries, we pretend that the 'IdeSessionServerDied'
-- state is a regular state, but we report the exception as a 'SourceError'
withIdleState :: IdeSession -> (IdeIdleState -> IO a) -> IO a
withIdleState IdeSession{ideState} f =
  $withStrictMVar ideState $ \st ->
    case st of
      IdeSessionIdle         idleState -> f idleState
      IdeSessionServerDied e idleState -> f (reportExAsErr e idleState)
      IdeSessionShutdown               -> fail "Session already shut down."
  where
    reportExAsErr :: ExternalException -> IdeIdleState -> IdeIdleState
    reportExAsErr e = ideComputed ^:
      StrictMaybe.just . updateComputed e . StrictMaybe.fromMaybe emptyComputed

    updateComputed :: ExternalException -> Computed -> Computed
    updateComputed (ExternalException remote _local) c =
      let err = Private.SourceError {
              Private.errorKind = Private.KindServerDied
            , Private.errorSpan = Private.TextSpan (Text.pack "<<server died>>")
            , Private.errorMsg  = Text.pack remote
            }
      in c { computedErrors = StrictList.singleton err }

    -- TODO: Do we really want an empty computed here? This means that if the
    -- user does not check getSourceErrors they might get nil/empty rather
    -- than an error.
    emptyComputed :: Computed
    emptyComputed = Computed {
        computedErrors        = StrictList.nil
      , computedLoadedModules = StrictList.nil
      , computedFileMap       = StrictMap.empty
      , computedSpanInfo      = StrictMap.empty
      , computedExpTypes      = StrictMap.empty
      , computedUseSites      = StrictMap.empty
      , computedImports       = StrictMap.empty
      , computedAutoMap       = StrictMap.empty
      , computedPkgDeps       = StrictMap.empty
      , computedCache         = Private.ExplicitSharingCache {
            Private.filePathCache = StrictIntMap.empty
          , Private.idPropCache   = StrictIntMap.empty
          }
      }

withComputedState :: IdeSession -> (IdeIdleState -> Computed -> IO a) -> IO a
withComputedState session f = withIdleState session $ \idleState ->
  case toLazyMaybe (idleState ^. ideComputed) of
    Just computed -> f idleState computed
    Nothing       -> throwIO InvalidSessionStateQueries

data InvalidSessionStateQueries = InvalidSessionStateQueries
    deriving Typeable
instance Show InvalidSessionStateQueries where
    show InvalidSessionStateQueries = "This session state does not admit queries."
instance Exception InvalidSessionStateQueries

staticQuery :: (IdeStaticInfo -> IO a) -> Query a
staticQuery f = f . ideStaticInfo

simpleQuery :: (IdeIdleState -> a) -> Query a
simpleQuery f session = withIdleState session $ return . f

computedQuery :: (Computed -> a) -> Query a
computedQuery f session = withComputedState session $ const (return . f)