content: {-# LANGUAGE TemplateHaskell, DeriveDataTypeable, DeriveGeneric, NamedFieldPuns, RecordWildCards #-}
  
  -- | The public types
  module IdeSession.Types.Public (
      -- * Types
      IdNameSpace(..)
    , Type
    , Name
    , IdInfo(..)
    , IdProp(..)
    , IdScope(..)
    , SourceSpan(..)
    , EitherSpan(..)
    , SourceError(..)
    , SourceErrorKind(..)
    , ModuleName
    , ModuleId(..)
    , PackageId(..)
  --  , IdMap(..)
  --  , LoadedModules
    , ImportEntities(..)
    , Import(..)
    , SpanInfo(..)
    , RunBufferMode(..)
    , RunResult(..)
    , BreakInfo(..)
    , Value
    , VariableEnv
    , Targets(..)
    , UpdateStatus(..)
      -- * Util
    , idInfoQN
  --, idInfoAtLocation
    , haddockLink
    ) where
  
  import Prelude hiding (span)
  import Control.Applicative ((<$>), (<*>))
  import Data.Text (Text)
  import qualified Data.Text as Text
  import Data.Binary (Binary(..), getWord8, putWord8)
  import Data.Aeson.TH (deriveJSON, defaultOptions)
  import Data.Typeable (Typeable)
  import GHC.Generics (Generic)
  
  import IdeSession.Util () -- Binary instance for Text
  import IdeSession.Util.PrettyVal
  import IdeSession.Types.Progress
  
  {------------------------------------------------------------------------------
    Types
  ------------------------------------------------------------------------------}
  
  -- | Identifiers in Haskell are drawn from a number of different name spaces
  data IdNameSpace =
      VarName    -- ^ Variables, including real data constructors
    | DataName   -- ^ Source data constructors
    | TvName     -- ^ Type variables
    | TcClsName  -- ^ Type constructors and classes
    deriving (Show, Eq, Generic)
  
  -- | Information about identifiers
  data IdInfo = IdInfo {
      idProp  :: {-# UNPACK #-} !IdProp
    , idScope :: !IdScope
    }
    deriving (Eq, Generic)
  
  -- | Variable name
  type Name = Text
  
  -- | For now we represent types in pretty-printed form
  type Type = Text
  
  -- | Identifier info that is independent of the usage site
  data IdProp = IdProp {
      -- | The base name of the identifer at this location. Module prefix
      -- is not included.
      idName  :: !Name
      -- | Namespace this identifier is drawn from
    , idSpace :: !IdNameSpace
      -- | The type
      -- We don't always know this; in particular, we don't know kinds because
      -- the type checker does not give us LSigs for top-level annotations)
    , idType  :: !(Maybe Type)
      -- | Module the identifier was defined in
    , idDefinedIn :: {-# UNPACK #-} !ModuleId
      -- | Where in the module was it defined (not always known)
    , idDefSpan :: !EitherSpan
      -- | Haddock home module
    , idHomeModule :: !(Maybe ModuleId)
    }
    deriving (Eq, Generic)
  
  -- TODO: Ideally, we would have
  -- 1. SourceSpan for Local rather than EitherSpan
  -- 2. SourceSpan for idImportSpan
  -- 3. Have a idImportedFromPackage, but unfortunately ghc doesn't give us
  --    this information (it's marked as a TODO in RdrName.lhs)
  data IdScope =
      -- | This is a binding occurrence (@f x = ..@, @\x -> ..@, etc.)
      Binder
      -- | Defined within this module
    | Local
      -- | Imported from a different module
    | Imported {
          idImportedFrom :: {-# UNPACK #-} !ModuleId
        , idImportSpan   :: !EitherSpan
          -- | Qualifier used for the import
          --
          -- > IMPORTED AS                       idImportQual
          -- > import Data.List                  ""
          -- > import qualified Data.List        "Data.List."
          -- > import qualified Data.List as L   "L."
        , idImportQual   :: !Text
        }
      -- | Wired into the compiler (@()@, @True@, etc.)
    | WiredIn
    deriving (Eq, Generic)
  
  data SourceSpan = SourceSpan
    { spanFilePath   :: !FilePath
    , spanFromLine   :: {-# UNPACK #-} !Int
    , spanFromColumn :: {-# UNPACK #-} !Int
    , spanToLine     :: {-# UNPACK #-} !Int
    , spanToColumn   :: {-# UNPACK #-} !Int
    }
    deriving (Eq, Ord, Generic)
  
  data EitherSpan =
      ProperSpan {-# UNPACK #-} !SourceSpan
    | TextSpan !Text
    deriving (Eq, Generic)
  
  -- | An error or warning in a source module.
  --
  -- Most errors are associated with a span of text, but some have only a
  -- location point.
  data SourceError = SourceError
    { errorKind :: !SourceErrorKind
    , errorSpan :: !EitherSpan
    , errorMsg  :: !Text
    }
    deriving (Show, Eq, Generic)
  
  -- | Severity of an error.
  data SourceErrorKind = KindError | KindWarning | KindServerDied
    deriving (Show, Eq, Generic)
  
  type ModuleName = Text
  
  data ModuleId = ModuleId
    { moduleName    :: !ModuleName
    , modulePackage :: {-# UNPACK #-} !PackageId
    }
    deriving (Eq, Ord, Generic)
  
  -- | A package ID in ide-backend consists of a human-readable package name
  -- and version (what Cabal calls a source ID) along with ghc's internal
  -- package key (primarily for internal use).
  data PackageId = PackageId
    { packageName    :: !Text
    , packageVersion :: !(Maybe Text)
    , packageKey     :: !Text
    }
    deriving (Eq, Ord, Generic)
  
  {-
  newtype IdMap = IdMap { idMapToMap :: Map SourceSpan IdInfo }
  
  type LoadedModules = Map ModuleName IdMap
  -}
  
  data ImportEntities =
      ImportOnly   ![Text]
    | ImportHiding ![Text]
    | ImportAll
    deriving (Show, Eq, Ord, Generic)
  
  data Import = Import {
      importModule    :: !ModuleId
    -- | Used only for ghc's PackageImports extension
    , importPackage   :: !(Maybe Text)
    , importQualified :: !Bool
    , importImplicit  :: !Bool
    , importAs        :: !(Maybe ModuleName)
    , importEntities  :: !ImportEntities
    }
    deriving (Show, Eq, Ord, Generic)
  
  -- | Returned when the IDE asks "what's at this particular location?"
  data SpanInfo =
      -- | Identifier
      SpanId IdInfo
      -- | Quasi-quote. The 'IdInfo' field gives the quasi-quoter
    | SpanQQ IdInfo
    deriving (Eq, Generic)
  
  -- | Buffer modes for running code
  --
  -- Note that 'NoBuffering' means that something like 'putStrLn' will do a
  -- syscall per character, and each of these characters will be read and sent
  -- back to the client. This results in a large overhead.
  --
  -- When using 'LineBuffering' or 'BlockBuffering', 'runWait' will not report
  -- any output from the snippet until it outputs a linebreak/fills the buffer,
  -- respectively (or does an explicit flush). However, you can specify a timeout
  -- in addition to the buffering mode; if you set this to @Just n@, the buffer
  -- will be flushed every @n@ microseconds.
  --
  -- NOTE: This is duplicated in the IdeBackendRTS (defined in IdeSession)
  data RunBufferMode =
      RunNoBuffering
    | RunLineBuffering  { runBufferTimeout   :: Maybe Int }
    | RunBlockBuffering { runBufferBlockSize :: Maybe Int
                        , runBufferTimeout   :: Maybe Int
                        }
    deriving (Typeable, Show, Generic, Eq)
  
  -- | The outcome of running code
  data RunResult =
      -- | The code terminated okay
      RunOk
      -- | The code threw an exception
    | RunProgException String
      -- | GHC itself threw an exception when we tried to run the code
    | RunGhcException String
      -- | The session was restarted
    | RunForceCancelled
      -- | Execution was paused because of a breakpoint
    | RunBreak
    deriving (Typeable, Show, Eq, Generic)
  
  -- | Information about a triggered breakpoint
  data BreakInfo = BreakInfo {
      -- | Module containing the breakpoint
      breakInfoModule :: ModuleName
      -- | Location of the breakpoint
    , breakInfoSpan :: SourceSpan
      -- | Type of the result
    , breakInfoResultType :: Type
      -- | Local variables and their values
    , breakInfoVariableEnv :: VariableEnv
    }
    deriving (Typeable, Show, Eq, Generic)
  
  -- | We present values only in pretty-printed form
  type Value = Text
  
  -- | Variables during execution (in debugging mode)
  type VariableEnv = [(Name, Type, Value)]
  
  data Targets = TargetsInclude [FilePath] | TargetsExclude [FilePath]
    deriving (Typeable, Generic, Eq, Show)
  
  -- | This type represents the status of the compilation from an IDE update.
  data UpdateStatus =
    -- | Indicates that the server is restarting because it needs to to fulfil the
    -- update.
      UpdateStatusRequiredRestart
    -- | Indicates that this update has caused the server to start again, since it
    -- died last update.
    | UpdateStatusErrorRestart Text
    -- | Gives compilation progress updates.
    | UpdateStatusProgress Progress
  
    -- | The update completed successfully.
    | UpdateStatusDone
    -- | The update failed, yielding an error. No more status updates should come
    -- after this.
    | UpdateStatusFailed Text
    -- The server tried to restart, but failed to restart. No more status updates
    -- should come after this.
    | UpdateStatusFailedToRestart
    deriving (Typeable, Generic, Eq, Show)
  
  {------------------------------------------------------------------------------
    Show instances
  ------------------------------------------------------------------------------}
  
  instance Show SourceSpan where
    show (SourceSpan{..}) =
         spanFilePath ++ "@"
      ++ show spanFromLine ++ ":" ++ show spanFromColumn ++ "-"
      ++ show spanToLine   ++ ":" ++ show spanToColumn
  
  instance Show IdProp where
    show (IdProp {..}) =
         Text.unpack idName ++ " "
      ++ "(" ++ show idSpace ++ ")"
      ++ (case idType of Just typ -> " :: " ++ Text.unpack typ; Nothing -> [])
      ++ " defined in "
      ++ show idDefinedIn
      ++ " at " ++ show idDefSpan
      ++ (case idHomeModule of Just home -> " (home " ++ show home ++ ")"
                               Nothing   -> "")
  
  instance Show IdScope where
    show Binder          = "binding occurrence"
    show Local           = "defined locally"
    show WiredIn         = "wired in to the compiler"
    show (Imported {..}) =
             "imported from " ++ show idImportedFrom
          ++ (if Text.null idImportQual
                then []
                else " as '" ++ Text.unpack idImportQual ++ "'")
          ++ " at "++ show idImportSpan
  
  instance Show EitherSpan where
    show (ProperSpan srcSpan) = show srcSpan
    show (TextSpan str)       = Text.unpack str
  
  instance Show ModuleId where
    show (ModuleId mo pkg) = show pkg ++ ":" ++ Text.unpack mo
  
  instance Show PackageId where
    show (PackageId name (Just version) _pkey) =
      Text.unpack name ++ "-" ++ Text.unpack version
    show (PackageId name Nothing _pkey) =
      Text.unpack name
  
  instance Show IdInfo where
    show IdInfo{..} = show idProp ++ " (" ++ show idScope ++ ")"
  
  instance Show SpanInfo where
    show (SpanId idInfo) = show idInfo
    show (SpanQQ idInfo) = "quasi-quote with quoter " ++ show idInfo
  
  {-
  instance Show IdMap where
    show =
      let showIdInfo(span, idInfo) = "(" ++ show span ++ "," ++ show idInfo ++ ")"
      in unlines . map showIdInfo . Map.toList . idMapToMap
  -}
  
  {------------------------------------------------------------------------------
    Binary instances
  
    We only have Binary instances for those types that are shared between
    the public and private types, and for the "small" types that are the result of
    IDE session queries. We don't want Binary instances for entire LoadedModules
    maps and other "large" types.
  ------------------------------------------------------------------------------}
  
  instance Binary IdNameSpace where
    put VarName   = putWord8 0
    put DataName  = putWord8 1
    put TvName    = putWord8 2
    put TcClsName = putWord8 3
  
    get = do
      header <- getWord8
      case header of
        0 -> return VarName
        1 -> return DataName
        2 -> return TvName
        3 -> return TcClsName
        _ -> fail "IdNameSpace.get: invalid header"
  
  instance Binary SourceErrorKind where
    put KindError      = putWord8 0
    put KindWarning    = putWord8 1
    put KindServerDied = putWord8 2
  
    get = do
      header <- getWord8
      case header of
        0 -> return KindError
        1 -> return KindWarning
        2 -> return KindServerDied
        _ -> fail "SourceErrorKind.get: invalid header"
  
  instance Binary ImportEntities where
    put (ImportOnly names)   = putWord8 0 >> put names
    put (ImportHiding names) = putWord8 1 >> put names
    put ImportAll            = putWord8 2
  
    get = do
      header <- getWord8
      case header of
        0 -> ImportOnly   <$> get
        1 -> ImportHiding <$> get
        2 -> return ImportAll
        _ -> fail "ImportEntities.get: invalid header"
  
  instance Binary Import where
    put Import{..} = do
      put importModule
      put importPackage
      put importQualified
      put importImplicit
      put importAs
      put importEntities
  
    get = Import <$> get <*> get <*> get <*> get <*> get <*> get
  
  instance Binary SourceError where
    put SourceError{..} = do
      put errorKind
      put errorSpan
      put errorMsg
  
    get = SourceError <$> get <*> get <*> get
  
  instance Binary IdProp where
    put IdProp{..} = do
      put idName
      put idSpace
      put idType
      put idDefinedIn
      put idDefSpan
      put idHomeModule
  
    get = IdProp <$> get <*> get <*> get <*> get <*> get <*> get
  
  instance Binary IdScope where
    put Binder       = putWord8 0
    put Local        = putWord8 1
    put Imported{..} = do putWord8 2
                          put idImportedFrom
                          put idImportSpan
                          put idImportQual
    put WiredIn      = putWord8 3
  
    get = do
      header <- getWord8
      case header of
        0 -> return Binder
        1 -> return Local
        2 -> Imported <$> get <*> get <*> get
        3 -> return WiredIn
        _ -> fail "IdScope.get: invalid header"
  
  instance Binary SourceSpan where
    put (SourceSpan{..}) = do
      put spanFilePath
      put spanFromLine
      put spanFromColumn
      put spanToLine
      put spanToColumn
  
    get = SourceSpan <$> get <*> get <*> get <*> get <*> get
  
  instance Binary EitherSpan where
    put (ProperSpan span) = putWord8 0 >> put span
    put (TextSpan text)   = putWord8 1 >> put text
  
    get = do
      header <- getWord8
      case header of
        0 -> ProperSpan <$> get
        1 -> TextSpan <$> get
        _ -> fail "EitherSpan.get: invalid header"
  
  instance Binary ModuleId where
    put ModuleId{..} = put moduleName >> put modulePackage
    get = ModuleId <$> get <*> get
  
  instance Binary PackageId where
    put PackageId{..} = do
      put packageName
      put packageVersion
      put packageKey
    get = PackageId <$> get <*> get <*> get
  
  instance Binary IdInfo where
    put IdInfo{..} = put idProp >> put idScope
    get = IdInfo <$> get <*> get
  
  instance Binary RunBufferMode where
    put RunNoBuffering        = putWord8 0
    put RunLineBuffering{..}  = do putWord8 1
                                   put runBufferTimeout
    put RunBlockBuffering{..} = do putWord8 2
                                   put runBufferBlockSize
                                   put runBufferTimeout
  
    get = do
      header <- getWord8
      case header of
        0 -> return RunNoBuffering
        1 -> RunLineBuffering <$> get
        2 -> RunBlockBuffering <$> get <*> get
        _ -> fail "RunBufferMode.get: invalid header"
  
  instance Binary Targets where
    put (TargetsInclude l) = do
      putWord8 0
      put l
    put (TargetsExclude l) = do
      putWord8 1
      put l
  
    get = do
      header <- getWord8
      case header of
        0 -> TargetsInclude <$> get
        1 -> TargetsExclude <$> get
        _ -> fail "Targets.get: invalid header"
  
  {------------------------------------------------------------------------------
    JSON instances
  
    We provide these for the convenience of client code only; we don't use them
    internally.
  ------------------------------------------------------------------------------}
  
  $(concat <$> mapM (deriveJSON defaultOptions)
    [ ''BreakInfo
    , ''EitherSpan
    , ''IdInfo
    , ''IdNameSpace
    , ''IdProp
    , ''IdScope
    , ''Import
    , ''ImportEntities
    , ''ModuleId
    , ''PackageId
    , ''RunBufferMode
    , ''RunResult
    , ''SourceError
    , ''SourceErrorKind
    , ''SourceSpan
    , ''SpanInfo
    , ''UpdateStatus
    ])
  
  {------------------------------------------------------------------------------
    PrettyVal instances (these rely on Generics)
  ------------------------------------------------------------------------------}
  
  instance PrettyVal IdNameSpace
  instance PrettyVal IdInfo
  instance PrettyVal IdProp
  instance PrettyVal IdScope
  instance PrettyVal SourceSpan
  instance PrettyVal EitherSpan
  instance PrettyVal SourceError
  instance PrettyVal SourceErrorKind
  instance PrettyVal ModuleId
  instance PrettyVal PackageId
  instance PrettyVal ImportEntities
  instance PrettyVal Import
  instance PrettyVal SpanInfo
  instance PrettyVal RunBufferMode
  instance PrettyVal RunResult
  instance PrettyVal BreakInfo
  instance PrettyVal Targets
  instance PrettyVal UpdateStatus
  
  {------------------------------------------------------------------------------
    Util
  ------------------------------------------------------------------------------}
  
  -- | Construct qualified name following Haskell's scoping rules
  idInfoQN :: IdInfo -> String
  idInfoQN IdInfo{idProp = IdProp{idName}, idScope} =
    case idScope of
      Binder                 -> Text.unpack idName
      Local{}                -> Text.unpack idName
      Imported{idImportQual} -> Text.unpack idImportQual ++ Text.unpack idName
      WiredIn                -> Text.unpack idName
  
  -- | Show approximately what Haddock adds to documentation URLs.
  haddockSpaceMarks :: IdNameSpace -> String
  haddockSpaceMarks VarName   = "v"
  haddockSpaceMarks DataName  = "v"
  haddockSpaceMarks TvName    = "t"
  haddockSpaceMarks TcClsName = "t"
  
  -- | Show approximately a haddock link (without haddock root) for an id.
  -- This is an illustration and a test of the id info, but under ideal
  -- conditions could perhaps serve to link to documentation without
  -- going via Hoogle.
  haddockLink :: IdProp -> IdScope -> String
  haddockLink IdProp{..} idScope =
    case idScope of
      Imported{idImportedFrom} ->
           dashToSlash (modulePackage idImportedFrom)
        ++ "/doc/html/"
        ++ dotToDash (Text.unpack $ moduleName idImportedFrom) ++ ".html#"
        ++ haddockSpaceMarks idSpace ++ ":"
        ++ Text.unpack idName
      _ -> "<local identifier>"
   where
     dotToDash = map (\c -> if c == '.' then '-' else c)
     dashToSlash p = case packageVersion p of
       Nothing      -> Text.unpack (packageName p) ++ "/latest"
       Just version -> Text.unpack (packageName p) ++ "/" ++ Text.unpack version
  
  {-
  idInfoAtLocation :: Int -> Int -> IdMap -> [(SourceSpan, IdInfo)]
  idInfoAtLocation line col = filter inRange . idMapToList
    where
      inRange :: (SourceSpan, a) -> Bool
      inRange (SourceSpan{..}, _) =
        (line   > spanFromLine || (line == spanFromLine && col >= spanFromColumn)) &&
        (line   < spanToLine   || (line == spanToLine   && col <= spanToColumn))
  -}
  