hasufell
/
ghc-mod
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Moving commands to Ghc monad

This commit is contained in:
mvoidex 2013-05-19 01:16:37 +04:00
parent bac4bbbcf3
commit f2f3b120af
7 changed files with 42 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
Language/Haskell/GhcMod.hs
View File

@ -1,17 +1,22 @@
module Language.Haskell.GhcMod ( module Language.Haskell.GhcMod (
browseModule browseModule
, checkSyntax , checkSyntax
, check
, module Language.Haskell.GhcMod.Cradle , module Language.Haskell.GhcMod.Cradle
, debugInfo , debugInfo
, debug , debug
, infoExpr , infoExpr
, info
, typeExpr , typeExpr
, typeOf
, listLanguages , listLanguages
, lintSyntax , lintSyntax
, listModules , listModules
, module Language.Haskell.GhcMod.Types , module Language.Haskell.GhcMod.Types
, listFlags , listFlags
, getGHCVersion , getGHCVersion
, withGHCDummyFile
, withGHC
) where ) where
import Language.Haskell.GhcMod.Browse import Language.Haskell.GhcMod.Browse
@ -19,6 +24,7 @@ import Language.Haskell.GhcMod.Check
import Language.Haskell.GhcMod.Cradle import Language.Haskell.GhcMod.Cradle
import Language.Haskell.GhcMod.Debug import Language.Haskell.GhcMod.Debug
import Language.Haskell.GhcMod.Flag import Language.Haskell.GhcMod.Flag
import Language.Haskell.GhcMod.GHCApi
import Language.Haskell.GhcMod.Info import Language.Haskell.GhcMod.Info
import Language.Haskell.GhcMod.Lang import Language.Haskell.GhcMod.Lang
import Language.Haskell.GhcMod.Lint import Language.Haskell.GhcMod.Lint

8
Language/Haskell/GhcMod/Browse.hs
View File

@ -1,4 +1,4 @@
module Language.Haskell.GhcMod.Browse (browseModule) where module Language.Haskell.GhcMod.Browse (browseModule, browse) where
import Control.Applicative import Control.Applicative
import Data.Char import Data.Char
@ -17,7 +17,7 @@ import Var
---------------------------------------------------------------- ----------------------------------------------------------------
browseModule :: Options -> String -> IO String browseModule :: Options -> String -> Ghc String
browseModule opt mdlName = convert opt . format <$> browse opt mdlName browseModule opt mdlName = convert opt . format <$> browse opt mdlName
where where
format format
@ -32,8 +32,8 @@ browseModule opt mdlName = convert opt . format <$> browse opt mdlName
(name, tail_) = break isSpace x (name, tail_) = break isSpace x
formatOps' [] = error "formatOps'" formatOps' [] = error "formatOps'"
browse :: Options -> String -> IO [String] browse :: Options -> String -> Ghc [String]
browse opt mdlName = withGHCDummyFile $ do browse opt mdlName = do
initializeFlags opt initializeFlags opt
getModule >>= getModuleInfo >>= listExports getModule >>= getModuleInfo >>= listExports
where where

8
Language/Haskell/GhcMod/Check.hs
View File

@ -1,4 +1,4 @@
module Language.Haskell.GhcMod.Check (checkSyntax) where module Language.Haskell.GhcMod.Check (checkSyntax, check) where
import Control.Applicative import Control.Applicative
import Control.Monad import Control.Monad
@ -12,13 +12,13 @@ import Prelude
---------------------------------------------------------------- ----------------------------------------------------------------
checkSyntax :: Options -> Cradle -> String -> IO String checkSyntax :: Options -> Cradle -> String -> Ghc String
checkSyntax opt cradle file = unlines <$> check opt cradle file checkSyntax opt cradle file = unlines <$> check opt cradle file
---------------------------------------------------------------- ----------------------------------------------------------------
check :: Options -> Cradle -> String -> IO [String] check :: Options -> Cradle -> String -> Ghc [String]
check opt cradle fileName = withGHC fileName $ checkIt `gcatch` handleErrMsg check opt cradle fileName = checkIt `gcatch` handleErrMsg
where where
checkIt = do checkIt = do
readLog <- initializeFlagsWithCradle opt cradle options True readLog <- initializeFlagsWithCradle opt cradle options True

9
Language/Haskell/GhcMod/Debug.hs
View File

@ -6,6 +6,7 @@ import Control.Monad
import Data.List (intercalate) import Data.List (intercalate)
import Data.Maybe import Data.Maybe
import GHC import GHC
import GhcMonad (liftIO)
import Language.Haskell.GhcMod.CabalApi import Language.Haskell.GhcMod.CabalApi
import Language.Haskell.GhcMod.GHCApi import Language.Haskell.GhcMod.GHCApi
import Language.Haskell.GhcMod.Types import Language.Haskell.GhcMod.Types
@ -13,17 +14,17 @@ import Prelude
---------------------------------------------------------------- ----------------------------------------------------------------
debugInfo :: Options -> Cradle -> String -> String -> IO String debugInfo :: Options -> Cradle -> String -> String -> Ghc String
debugInfo opt cradle ver fileName = unlines <$> debug opt cradle ver fileName debugInfo opt cradle ver fileName = unlines <$> debug opt cradle ver fileName
debug :: Options -> Cradle -> String -> String -> IO [String] debug :: Options -> Cradle -> String -> String -> Ghc [String]
debug opt cradle ver fileName = do debug opt cradle ver fileName = do
(gopts, incDir, pkgs) <- (gopts, incDir, pkgs) <-
if cabal then if cabal then
fromCabalFile (ghcOpts opt) cradle ||> return (ghcOpts opt, [], []) liftIO $ fromCabalFile (ghcOpts opt) cradle ||> return (ghcOpts opt, [], [])
else else
return (ghcOpts opt, [], []) return (ghcOpts opt, [], [])
[fast] <- withGHC fileName $ do [fast] <- do
void $ initializeFlagsWithCradle opt cradle gopts True void $ initializeFlagsWithCradle opt cradle gopts True
setTargetFile fileName setTargetFile fileName
pure . canCheckFast <$> depanal [] False pure . canCheckFast <$> depanal [] False

18
Language/Haskell/GhcMod/Info.hs
View File

@ -1,13 +1,13 @@
{-# LANGUAGE TupleSections, FlexibleInstances, TypeSynonymInstances #-} {-# LANGUAGE TupleSections, FlexibleInstances, TypeSynonymInstances #-}
{-# LANGUAGE Rank2Types #-} {-# LANGUAGE Rank2Types #-}
module Language.Haskell.GhcMod.Info (infoExpr, typeExpr) where module Language.Haskell.GhcMod.Info (infoExpr, info, typeExpr, typeOf) where
import Control.Applicative import Control.Applicative
import Control.Monad (void, when) import Control.Monad (void, when)
import CoreUtils import CoreUtils
import Data.Function import Data.Function
import Data.Generics import Data.Generics hiding (typeOf)
import Data.List import Data.List
import Data.Maybe import Data.Maybe
import Data.Ord as O import Data.Ord as O
@ -36,10 +36,10 @@ data Cmd = Info | Type deriving Eq
---------------------------------------------------------------- ----------------------------------------------------------------
infoExpr :: Options -> Cradle -> ModuleString -> Expression -> FilePath -> IO String infoExpr :: Options -> Cradle -> ModuleString -> Expression -> FilePath -> Ghc String
infoExpr opt cradle modstr expr file = (++ "\n") <$> info opt cradle file modstr expr infoExpr opt cradle modstr expr file = (++ "\n") <$> info opt cradle file modstr expr
info :: Options -> Cradle -> FilePath -> ModuleString -> Expression -> IO String info :: Options -> Cradle -> FilePath -> ModuleString -> Expression -> Ghc String
info opt cradle fileName modstr expr = info opt cradle fileName modstr expr =
inModuleContext Info opt cradle fileName modstr exprToInfo "Cannot show info" inModuleContext Info opt cradle fileName modstr exprToInfo "Cannot show info"
where where
@ -67,10 +67,10 @@ instance HasType (LHsBind Id) where
instance HasType (LPat Id) where instance HasType (LPat Id) where
getType _ (L spn pat) = return $ Just (spn, hsPatType pat) getType _ (L spn pat) = return $ Just (spn, hsPatType pat)
typeExpr :: Options -> Cradle -> ModuleString -> Int -> Int -> FilePath -> IO String typeExpr :: Options -> Cradle -> ModuleString -> Int -> Int -> FilePath -> Ghc String
typeExpr opt cradle modstr lineNo colNo file = Language.Haskell.GhcMod.Info.typeOf opt cradle file modstr lineNo colNo typeExpr opt cradle modstr lineNo colNo file = typeOf opt cradle file modstr lineNo colNo
typeOf :: Options -> Cradle -> FilePath -> ModuleString -> Int -> Int -> IO String typeOf :: Options -> Cradle -> FilePath -> ModuleString -> Int -> Int -> Ghc String
typeOf opt cradle fileName modstr lineNo colNo = typeOf opt cradle fileName modstr lineNo colNo =
inModuleContext Type opt cradle fileName modstr exprToType errmsg inModuleContext Type opt cradle fileName modstr exprToType errmsg
where where
@ -141,9 +141,9 @@ pprInfo pefas (thing, fixity, insts)
---------------------------------------------------------------- ----------------------------------------------------------------
inModuleContext :: Cmd -> Options -> Cradle -> FilePath -> ModuleString -> Ghc String -> String -> IO String inModuleContext :: Cmd -> Options -> Cradle -> FilePath -> ModuleString -> Ghc String -> String -> Ghc String
inModuleContext cmd opt cradle fileName modstr action errmsg = inModuleContext cmd opt cradle fileName modstr action errmsg =
withGHCDummyFile (valid ||> invalid ||> return errmsg) valid ||> invalid ||> return errmsg
where where
valid = do valid = do
void $ initializeFlagsWithCradle opt cradle ["-w:"] False void $ initializeFlagsWithCradle opt cradle ["-w:"] False

8
Language/Haskell/GhcMod/List.hs
View File

@ -1,4 +1,4 @@
module Language.Haskell.GhcMod.List (listModules) where module Language.Haskell.GhcMod.List (listModules, list) where
import Control.Applicative import Control.Applicative
import Data.List import Data.List
@ -10,11 +10,11 @@ import UniqFM
---------------------------------------------------------------- ----------------------------------------------------------------
listModules :: Options -> IO String listModules :: Options -> Ghc String
listModules opt = convert opt . nub . sort <$> list opt listModules opt = convert opt . nub . sort <$> list opt
list :: Options -> IO [String] list :: Options -> Ghc [String]
list opt = withGHCDummyFile $ do list opt = do
initializeFlags opt initializeFlags opt
getExposedModules <$> getSessionDynFlags getExposedModules <$> getSessionDynFlags
where where

19
src/GHCMod.hs
View File

@ -91,21 +91,21 @@ main = flip catches handlers $ do
cmdArg3 = cmdArg !. 3 cmdArg3 = cmdArg !. 3
cmdArg4 = cmdArg !. 4 cmdArg4 = cmdArg !. 4
res <- case cmdArg0 of res <- case cmdArg0 of
"browse" -> concat <$> mapM (browseModule opt) (tail cmdArg) "browse" -> withGHCDummyFile $ concat <$> mapM (browseModule opt) (tail cmdArg)
"list" -> listModules opt "list" -> withGHCDummyFile $ listModules opt
"check" -> withFile (checkSyntax opt cradle) cmdArg1 "check" -> withGHCFile (checkSyntax opt cradle) cmdArg1
"expand" -> withFile (checkSyntax opt { expandSplice = True } cradle) cmdArg1 "expand" -> withGHCFile (checkSyntax opt { expandSplice = True } cradle) cmdArg1
"debug" -> withFile (debugInfo opt cradle strVer) cmdArg1 "debug" -> withGHCFile (debugInfo opt cradle strVer) cmdArg1
"type" -> withFile (typeExpr opt cradle cmdArg2 (read cmdArg3) (read cmdArg4)) cmdArg1 "type" -> withGHCFile (typeExpr opt cradle cmdArg2 (read cmdArg3) (read cmdArg4)) cmdArg1
"info" -> withFile (infoExpr opt cradle cmdArg2 cmdArg3) cmdArg1 "info" -> withGHCFile (infoExpr opt cradle cmdArg2 cmdArg3) cmdArg1
"lint" -> withFile (lintSyntax opt) cmdArg1 "lint" -> withFile (lintSyntax opt) cmdArg1
"lang" -> listLanguages opt "lang" -> listLanguages opt
"flag" -> listFlags opt "flag" -> listFlags opt
"boot" -> do "boot" -> do
mods <- listModules opt mods <- withGHCDummyFile $ listModules opt
langs <- listLanguages opt langs <- listLanguages opt
flags <- listFlags opt flags <- listFlags opt
pre <- concat <$> mapM (browseModule opt) preBrowsedModules pre <- withGHCDummyFile $ concat <$> mapM (browseModule opt) preBrowsedModules
return $ mods ++ langs ++ flags ++ pre return $ mods ++ langs ++ flags ++ pre
cmd -> throw (NoSuchCommand cmd) cmd -> throw (NoSuchCommand cmd)
putStr res putStr res
@ -130,6 +130,7 @@ main = flip catches handlers $ do
if exist if exist
then cmd file then cmd file
else throw (FileNotExist file) else throw (FileNotExist file)
withGHCFile cmd = withFile (\f -> withGHC f (cmd f))
xs !. idx xs !. idx
| length xs <= idx = throw SafeList | length xs <= idx = throw SafeList
| otherwise = xs !! idx | otherwise = xs !! idx