Migrate some commands to new server; move their implementation into l…

…ibrary.

lib/Scion/Backend.hs

@@ -0,0 +1,73 @@
+-- | The backend abstraction (well, the beginnings of it.)
+{-# LANGUAGE OverloadedStrings, GeneralizedNewtypeDeriving #-}
+module Scion.Backend 
+  ( supportedLanguages, supportedOptions, optionsPragma,
+    supportedPragmas,
+    ModuleName, mkModuleName, moduleNameText,
+    allExposedModuleNames,
+  )
+where
+
+import Scion.Types
+
+import qualified DynFlags as Ghc
+import qualified GHC as Ghc
+import qualified Packages as Ghc
+import qualified UniqFM as Ghc
+--import qualified Module as Ghc
+import qualified Distribution.InstalledPackageInfo as PInfo
+
+import qualified Data.Text            as T
+import Data.List ( nub, sort )
+
+-- | Sorted list of all supported @LANGUAGE@ pragmas.
+supportedLanguages :: [T.Text]
+supportedLanguages = sort $ map T.pack Ghc.supportedLanguages
+
+-- | Sorted list of all flags allowed in the @OPTIONS@ pragma.
+supportedOptions :: [T.Text]
+supportedOptions = sort $ map T.pack (nub Ghc.allFlags)
+
+-- | The compiler-specific @OPTIONS@ pragma.  (e.g., @OPTIONS_GHC@)
+optionsPragma :: T.Text
+optionsPragma = "OPTIONS_GHC"
+
+-- | List of supported pragmas.
+supportedPragmas :: [T.Text]
+supportedPragmas = sort $
+  [ "OPTIONS_GHC", "LANGUAGE", "INCLUDE", "WARNING", "DEPRECATED"
+  , "INLINE", "NOINLINE", "RULES", "SPECIALIZE", "UNPACK", "SOURCE"
+  , "SCC"
+  -- , "LINE" -- only used by code generators, still include?
+  ]
+
+-- -------------------------------------------------------------------
+
+-- TODO: Move this to a better place?
+
+-- | A module name (as used in @import@ lists).  E.g., @Control.Monad@.
+newtype ModuleName = ModuleName { moduleNameText :: T.Text }
+  deriving (Eq, Ord)
+
+instance Show ModuleName where
+  show (ModuleName txt) = T.unpack txt
+
+mkModuleName :: T.Text -> ModuleName
+mkModuleName = ModuleName
+
+-- | Return all exposed modules of the current session's package DBs.
+-- Note that this does /not/ include packages from the current
+-- session.
+--
+-- The provides a crude yet simple basis for completing @import@
+-- directives.
+allExposedModuleNames :: ScionM [ModuleName]
+allExposedModuleNames = do
+   dflags <- Ghc.getSessionDynFlags
+   let pkg_db = Ghc.pkgIdMap (Ghc.pkgState dflags)
+   return $ nub
+          . map (ModuleName . T.pack . Ghc.moduleNameString)
+          . concatMap PInfo.exposedModules 
+          -- . filter exposed
+          $ Ghc.eltsUFM pkg_db
+

scion.cabal

@@ -51,6 +51,7 @@ library
     list-tries   >= 0.1 && < 0.3,
     binary       == 0.5.*,
     array        >= 0.2 && < 0.4,
+    text         == 0.7.*,
     old-time     == 1.0.*
 
   if impl(ghc == 6.12.*)
@@ -79,6 +80,7 @@ library
     Scion.Inspect.PackageDB,
     Scion.Utils,
     Scion.Session,
+    Scion.Backend,
     Scion.Cabal,
     Scion.Ghc,
     Scion

server/Scion/Server/Commands2.hs

@@ -2,16 +2,16 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 module Scion.Server.Commands2 where
 
-import GHC (GhcException(..))
-import Exception (gcatch, ghandle)
-import Control.Exception ( throwIO, SomeException )
-import System.Exit (ExitCode)
 import Scion.Types
+import Scion.Backend
 import Scion.Server.Message
-import Data.String ( fromString )
 
-import DynFlags ( supportedLanguages, allFlags )
+import GHC (GhcException(..))
+import Exception (gcatch, ghandle)
 
+import Control.Exception ( throwIO, SomeException )
+import Data.String ( fromString )
+import System.Exit (ExitCode)
 import qualified Data.Map             as M
 import qualified Data.Text            as T
 
@@ -169,10 +169,18 @@ allCmds = M.fromList [ (cmdName c, c) | c <- allCommands ]
 allCommands :: [Cmd]
 allCommands =
   [ cmdPing
-  , cmdListSupportedPragmas
   , cmdConnectionInfo
+  , cmdListSupportedLanguages
+  , cmdListSupportedPragmas
+  , cmdListSupportedFlags
+  , cmdListExposedModules
   ]
 
+instance Message ModuleName where
+  toMsg mn = MsgText (moduleNameText mn)
+  fromMsg (MsgText txt) = Just (mkModuleName txt)
+  fromMsg _ = Nothing
+
 -- | Used to test whether the server is alive.
 cmdPing :: Cmd
 cmdPing =
@@ -191,17 +199,17 @@ cmdConnectionInfo = Cmd "connection-info" $ noArgs worker
                ,("pid",     pid)]
 
 cmdListSupportedLanguages :: Cmd
-cmdListSupportedLanguages = Cmd "list-supported-languages" $ noArgs cmd
-  where cmd = return (map T.pack supportedLanguages)
+cmdListSupportedLanguages =
+  Cmd "list-supported-languages" $ noArgs $ return supportedLanguages
 
 cmdListSupportedPragmas :: Cmd
 cmdListSupportedPragmas = 
   Cmd "list-supported-pragmas" $ noArgs $ return supportedPragmas
 
-supportedPragmas :: [T.Text]
-supportedPragmas =
-    [ "OPTIONS_GHC", "LANGUAGE", "INCLUDE", "WARNING", "DEPRECATED"
-    , "INLINE", "NOINLINE", "RULES", "SPECIALIZE", "UNPACK", "SOURCE"
-    , "SCC"
-    , "LINE" -- XXX: only used by code generators, still include?
-    ]
+cmdListSupportedFlags :: Cmd
+cmdListSupportedFlags =
+  Cmd "list-supported-flags" $ noArgs $ return supportedOptions
+
+cmdListExposedModules :: Cmd
+cmdListExposedModules =
+  Cmd "list-exposed-modules" $ noArgs $ allExposedModuleNames