Moving commands to Ghc monad
This commit is contained in:
mvoidex
parent
bac4bbbcf3
commit
f2f3b120af
@ -1,17 +1,22 @@
|
||||
module Language.Haskell.GhcMod (
|
||||
browseModule
|
||||
, checkSyntax
|
||||
, check
|
||||
, module Language.Haskell.GhcMod.Cradle
|
||||
, debugInfo
|
||||
, debug
|
||||
, infoExpr
|
||||
, info
|
||||
, typeExpr
|
||||
, typeOf
|
||||
, listLanguages
|
||||
, lintSyntax
|
||||
, listModules
|
||||
, module Language.Haskell.GhcMod.Types
|
||||
, listFlags
|
||||
, getGHCVersion
|
||||
, withGHCDummyFile
|
||||
, withGHC
|
||||
) where
|
||||
|
||||
import Language.Haskell.GhcMod.Browse
|
||||
@ -19,6 +24,7 @@ import Language.Haskell.GhcMod.Check
|
||||
import Language.Haskell.GhcMod.Cradle
|
||||
import Language.Haskell.GhcMod.Debug
|
||||
import Language.Haskell.GhcMod.Flag
|
||||
import Language.Haskell.GhcMod.GHCApi
|
||||
import Language.Haskell.GhcMod.Info
|
||||
import Language.Haskell.GhcMod.Lang
|
||||
import Language.Haskell.GhcMod.Lint
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
module Language.Haskell.GhcMod.Browse (browseModule) where
|
||||
module Language.Haskell.GhcMod.Browse (browseModule, browse) where
|
||||
|
||||
import Control.Applicative
|
||||
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
|
||||
where
|
||||
format
|
||||
@ -32,8 +32,8 @@ browseModule opt mdlName = convert opt . format <$> browse opt mdlName
|
||||
(name, tail_) = break isSpace x
|
||||
formatOps' [] = error "formatOps'"
|
||||
|
||||
browse :: Options -> String -> IO [String]
|
||||
browse opt mdlName = withGHCDummyFile $ do
|
||||
browse :: Options -> String -> Ghc [String]
|
||||
browse opt mdlName = do
|
||||
initializeFlags opt
|
||||
getModule >>= getModuleInfo >>= listExports
|
||||
where
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
module Language.Haskell.GhcMod.Check (checkSyntax) where
|
||||
module Language.Haskell.GhcMod.Check (checkSyntax, check) where
|
||||
|
||||
import Control.Applicative
|
||||
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
|
||||
|
||||
----------------------------------------------------------------
|
||||
|
||||
check :: Options -> Cradle -> String -> IO [String]
|
||||
check opt cradle fileName = withGHC fileName $ checkIt `gcatch` handleErrMsg
|
||||
check :: Options -> Cradle -> String -> Ghc [String]
|
||||
check opt cradle fileName = checkIt `gcatch` handleErrMsg
|
||||
where
|
||||
checkIt = do
|
||||
readLog <- initializeFlagsWithCradle opt cradle options True
|
||||
|
||||
@ -6,6 +6,7 @@ import Control.Monad
|
||||
import Data.List (intercalate)
|
||||
import Data.Maybe
|
||||
import GHC
|
||||
import GhcMonad (liftIO)
|
||||
import Language.Haskell.GhcMod.CabalApi
|
||||
import Language.Haskell.GhcMod.GHCApi
|
||||
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
|
||||
|
||||
debug :: Options -> Cradle -> String -> String -> IO [String]
|
||||
debug :: Options -> Cradle -> String -> String -> Ghc [String]
|
||||
debug opt cradle ver fileName = do
|
||||
(gopts, incDir, pkgs) <-
|
||||
if cabal then
|
||||
fromCabalFile (ghcOpts opt) cradle ||> return (ghcOpts opt, [], [])
|
||||
liftIO $ fromCabalFile (ghcOpts opt) cradle ||> return (ghcOpts opt, [], [])
|
||||
else
|
||||
return (ghcOpts opt, [], [])
|
||||
[fast] <- withGHC fileName $ do
|
||||
[fast] <- do
|
||||
void $ initializeFlagsWithCradle opt cradle gopts True
|
||||
setTargetFile fileName
|
||||
pure . canCheckFast <$> depanal [] False
|
||||
|
||||
@ -1,13 +1,13 @@
|
||||
{-# LANGUAGE TupleSections, FlexibleInstances, TypeSynonymInstances #-}
|
||||
{-# 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.Monad (void, when)
|
||||
import CoreUtils
|
||||
import Data.Function
|
||||
import Data.Generics
|
||||
import Data.Generics hiding (typeOf)
|
||||
import Data.List
|
||||
import Data.Maybe
|
||||
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
|
||||
|
||||
info :: Options -> Cradle -> FilePath -> ModuleString -> Expression -> IO String
|
||||
info :: Options -> Cradle -> FilePath -> ModuleString -> Expression -> Ghc String
|
||||
info opt cradle fileName modstr expr =
|
||||
inModuleContext Info opt cradle fileName modstr exprToInfo "Cannot show info"
|
||||
where
|
||||
@ -67,10 +67,10 @@ instance HasType (LHsBind Id) where
|
||||
instance HasType (LPat Id) where
|
||||
getType _ (L spn pat) = return $ Just (spn, hsPatType pat)
|
||||
|
||||
typeExpr :: Options -> Cradle -> ModuleString -> Int -> Int -> FilePath -> IO String
|
||||
typeExpr opt cradle modstr lineNo colNo file = Language.Haskell.GhcMod.Info.typeOf opt cradle file modstr lineNo colNo
|
||||
typeExpr :: Options -> Cradle -> ModuleString -> Int -> Int -> FilePath -> Ghc String
|
||||
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 =
|
||||
inModuleContext Type opt cradle fileName modstr exprToType errmsg
|
||||
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 =
|
||||
withGHCDummyFile (valid ||> invalid ||> return errmsg)
|
||||
valid ||> invalid ||> return errmsg
|
||||
where
|
||||
valid = do
|
||||
void $ initializeFlagsWithCradle opt cradle ["-w:"] False
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
module Language.Haskell.GhcMod.List (listModules) where
|
||||
module Language.Haskell.GhcMod.List (listModules, list) where
|
||||
|
||||
import Control.Applicative
|
||||
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
|
||||
|
||||
list :: Options -> IO [String]
|
||||
list opt = withGHCDummyFile $ do
|
||||
list :: Options -> Ghc [String]
|
||||
list opt = do
|
||||
initializeFlags opt
|
||||
getExposedModules <$> getSessionDynFlags
|
||||
where
|
||||
|
||||
@ -91,21 +91,21 @@ main = flip catches handlers $ do
|
||||
cmdArg3 = cmdArg !. 3
|
||||
cmdArg4 = cmdArg !. 4
|
||||
res <- case cmdArg0 of
|
||||
"browse" -> concat <$> mapM (browseModule opt) (tail cmdArg)
|
||||
"list" -> listModules opt
|
||||
"check" -> withFile (checkSyntax opt cradle) cmdArg1
|
||||
"expand" -> withFile (checkSyntax opt { expandSplice = True } cradle) cmdArg1
|
||||
"debug" -> withFile (debugInfo opt cradle strVer) cmdArg1
|
||||
"type" -> withFile (typeExpr opt cradle cmdArg2 (read cmdArg3) (read cmdArg4)) cmdArg1
|
||||
"info" -> withFile (infoExpr opt cradle cmdArg2 cmdArg3) cmdArg1
|
||||
"browse" -> withGHCDummyFile $ concat <$> mapM (browseModule opt) (tail cmdArg)
|
||||
"list" -> withGHCDummyFile $ listModules opt
|
||||
"check" -> withGHCFile (checkSyntax opt cradle) cmdArg1
|
||||
"expand" -> withGHCFile (checkSyntax opt { expandSplice = True } cradle) cmdArg1
|
||||
"debug" -> withGHCFile (debugInfo opt cradle strVer) cmdArg1
|
||||
"type" -> withGHCFile (typeExpr opt cradle cmdArg2 (read cmdArg3) (read cmdArg4)) cmdArg1
|
||||
"info" -> withGHCFile (infoExpr opt cradle cmdArg2 cmdArg3) cmdArg1
|
||||
"lint" -> withFile (lintSyntax opt) cmdArg1
|
||||
"lang" -> listLanguages opt
|
||||
"flag" -> listFlags opt
|
||||
"boot" -> do
|
||||
mods <- listModules opt
|
||||
mods <- withGHCDummyFile $ listModules opt
|
||||
langs <- listLanguages opt
|
||||
flags <- listFlags opt
|
||||
pre <- concat <$> mapM (browseModule opt) preBrowsedModules
|
||||
pre <- withGHCDummyFile $ concat <$> mapM (browseModule opt) preBrowsedModules
|
||||
return $ mods ++ langs ++ flags ++ pre
|
||||
cmd -> throw (NoSuchCommand cmd)
|
||||
putStr res
|
||||
@ -130,6 +130,7 @@ main = flip catches handlers $ do
|
||||
if exist
|
||||
then cmd file
|
||||
else throw (FileNotExist file)
|
||||
withGHCFile cmd = withFile (\f -> withGHC f (cmd f))
|
||||
xs !. idx
|
||||
| length xs <= idx = throw SafeList
|
||||
| otherwise = xs !! idx
|
||||
|
||||
Loading…
Reference in New Issue
Block a user