From 7b6eb55b11b5813a30077482d09366c0ec4563b6 Mon Sep 17 00:00:00 2001 From: Sergey Vinokurov Date: Mon, 1 Jun 2015 18:10:37 +0300 Subject: [PATCH] Transform ModuleString and Expression type synonyms into newtypes --- Language/Haskell/GhcMod.hs | 2 +- Language/Haskell/GhcMod/Browse.hs | 2 +- Language/Haskell/GhcMod/Convert.hs | 4 ++++ Language/Haskell/GhcMod/FillSig.hs | 2 +- Language/Haskell/GhcMod/Find.hs | 5 +++-- Language/Haskell/GhcMod/Gap.hs | 6 ++++-- Language/Haskell/GhcMod/Types.hs | 6 ++++-- src/GHCMod.hs | 10 +++++----- test/FindSpec.hs | 2 +- test/InfoSpec.hs | 6 +++--- 10 files changed, 27 insertions(+), 18 deletions(-) diff --git a/Language/Haskell/GhcMod.hs b/Language/Haskell/GhcMod.hs index 0b358a6..763384e 100644 --- a/Language/Haskell/GhcMod.hs +++ b/Language/Haskell/GhcMod.hs @@ -17,7 +17,7 @@ module Language.Haskell.GhcMod ( , gmLog -- * Types , ModuleString - , Expression + , Expression(..) , GhcPkgDb , Symbol , SymbolDb diff --git a/Language/Haskell/GhcMod/Browse.hs b/Language/Haskell/GhcMod/Browse.hs index f691464..19a4b02 100644 --- a/Language/Haskell/GhcMod/Browse.hs +++ b/Language/Haskell/GhcMod/Browse.hs @@ -27,7 +27,7 @@ import Exception (ExceptionMonad, ghandle) -- If 'detailed' is 'True', their types are also obtained. -- If 'operators' is 'True', operators are also returned. browse :: forall m. IOish m - => ModuleString -- ^ A module name. (e.g. \"Data.List\") + => String -- ^ A module name. (e.g. \"Data.List\", "base:Prelude") -> GhcModT m String browse pkgmdl = do convert' . sort =<< go diff --git a/Language/Haskell/GhcMod/Convert.hs b/Language/Haskell/GhcMod/Convert.hs index 39bb426..a679aa0 100644 --- a/Language/Haskell/GhcMod/Convert.hs +++ b/Language/Haskell/GhcMod/Convert.hs @@ -64,6 +64,10 @@ instance ToString [String] where toLisp opt = toSexp1 opt toPlain opt = inter '\n' . map (toPlain opt) +instance ToString [ModuleString] where + toLisp opt = toLisp opt . map getModuleString + toPlain opt = toPlain opt . map getModuleString + -- | -- -- >>> let inp = [((1,2,3,4),"foo"),((5,6,7,8),"bar")] :: [((Int,Int,Int,Int),String)] diff --git a/Language/Haskell/GhcMod/FillSig.hs b/Language/Haskell/GhcMod/FillSig.hs index ecfc93d..b1700eb 100644 --- a/Language/Haskell/GhcMod/FillSig.hs +++ b/Language/Haskell/GhcMod/FillSig.hs @@ -336,7 +336,7 @@ refine :: IOish m -> Int -- ^ Column number. -> Expression -- ^ A Haskell expression. -> GhcModT m String -refine file lineNo colNo expr = +refine file lineNo colNo (Expression expr) = ghandle handler $ runGmlT' [Left file] deferErrors $ do opt <- options diff --git a/Language/Haskell/GhcMod/Find.hs b/Language/Haskell/GhcMod/Find.hs index d361f20..aee450c 100644 --- a/Language/Haskell/GhcMod/Find.hs +++ b/Language/Haskell/GhcMod/Find.hs @@ -133,9 +133,10 @@ extractBindings :: (Maybe G.ModuleInfo, G.Module) -> [(Symbol, ModuleString)] extractBindings (Nothing, _) = [] extractBindings (Just inf, mdl) = - map (\name -> (getOccString name, moduleNameString $ moduleName mdl)) names + map (\name -> (getOccString name, modStr)) names where - names = G.modInfoExports inf + names = G.modInfoExports inf + modStr = ModuleString $ moduleNameString $ moduleName mdl collectModules :: [(Symbol, ModuleString)] -> [(Symbol, [ModuleString])] diff --git a/Language/Haskell/GhcMod/Gap.hs b/Language/Haskell/GhcMod/Gap.hs index f76c7ce..4719185 100644 --- a/Language/Haskell/GhcMod/Gap.hs +++ b/Language/Haskell/GhcMod/Gap.hs @@ -103,6 +103,8 @@ import Parser import SrcLoc import Packages +import Language.Haskell.GhcMod.Types (Expression(..)) + ---------------------------------------------------------------- ---------------------------------------------------------------- -- @@ -325,8 +327,8 @@ filterOutChildren get_thing xs where implicits = mkNameSet [getName t | x <- xs, t <- implicitTyThings (get_thing x)] -infoThing :: GhcMonad m => String -> m SDoc -infoThing str = do +infoThing :: GhcMonad m => Expression -> m SDoc +infoThing (Expression str) = do names <- parseName str #if __GLASGOW_HASKELL__ >= 708 mb_stuffs <- mapM (getInfo False) names diff --git a/Language/Haskell/GhcMod/Types.hs b/Language/Haskell/GhcMod/Types.hs index e431806..b33c01a 100644 --- a/Language/Haskell/GhcMod/Types.hs +++ b/Language/Haskell/GhcMod/Types.hs @@ -154,10 +154,12 @@ showPkgId :: Package -> String showPkgId (n, v, i) = intercalate "-" [n, v, i] -- | Haskell expression. -type Expression = String +newtype Expression = Expression { getExpression :: String } + deriving (Show, Eq, Ord) -- | Module name. -type ModuleString = String +newtype ModuleString = ModuleString { getModuleString :: String } + deriving (Show, Read, Eq, Ord) data GmLogLevel = GmSilent diff --git a/src/GHCMod.hs b/src/GHCMod.hs index 49e4099..b029036 100644 --- a/src/GHCMod.hs +++ b/src/GHCMod.hs @@ -517,8 +517,8 @@ autoCmd = withParseCmd [] $ locAction "auto" auto refineCmd = withParseCmd [] $ locAction' "refine" refine infoCmd = withParseCmd [] $ action - where action [file,_,expr] = info file expr - action [file,expr] = info file expr + where action [file,_,expr] = info file $ Expression expr + action [file,expr] = info file $ Expression expr action _ = throw $ InvalidCommandLine (Left "info") legacyInteractiveCmd = withParseCmd [] $ \[] -> legacyInteractive >> return "" @@ -532,9 +532,9 @@ locAction _ action [file,_,line,col] = action file (read line) (read col) locAction _ action [file, line,col] = action file (read line) (read col) locAction cmd _ _ = throw $ InvalidCommandLine (Left cmd) -locAction' :: String -> (String -> Int -> Int -> String -> a) -> [String] -> a -locAction' _ action [f,_,line,col,expr] = action f (read line) (read col) expr -locAction' _ action [f, line,col,expr] = action f (read line) (read col) expr +locAction' :: String -> (String -> Int -> Int -> Expression -> a) -> [String] -> a +locAction' _ action [f,_,line,col,expr] = action f (read line) (read col) (Expression expr) +locAction' _ action [f, line,col,expr] = action f (read line) (read col) (Expression expr) locAction' cmd _ _ = throw $ InvalidCommandLine (Left cmd) diff --git a/test/FindSpec.hs b/test/FindSpec.hs index 3560997..55e84df 100644 --- a/test/FindSpec.hs +++ b/test/FindSpec.hs @@ -9,4 +9,4 @@ spec = do describe "db <- loadSymbolDb" $ do it "lookupSymbol' db \"head\" contains at least `Data.List'" $ do db <- runD loadSymbolDb - lookupSym "head" db `shouldContain` ["Data.List"] + lookupSym "head" db `shouldContain` [ModuleString "Data.List"] diff --git a/test/InfoSpec.hs b/test/InfoSpec.hs index 091bbae..6a5296c 100644 --- a/test/InfoSpec.hs +++ b/test/InfoSpec.hs @@ -34,17 +34,17 @@ spec = do describe "info" $ do it "works for non exported functions" $ do let tdir = "test/data/non-exported" - res <- runD' tdir $ info "Fib.hs" "fib" + res <- runD' tdir $ info "Fib.hs" $ Expression "fib" res `shouldSatisfy` ("fib :: Int -> Int" `isPrefixOf`) it "works with a module using TemplateHaskell" $ do let tdir = "test/data/template-haskell" - res <- runD' tdir $ info "Bar.hs" "foo" + res <- runD' tdir $ info "Bar.hs" $ Expression "foo" res `shouldSatisfy` ("foo :: ExpQ" `isPrefixOf`) it "works with a module that imports another module using TemplateHaskell" $ do let tdir = "test/data/template-haskell" - res <- runD' tdir $ info "ImportsTH.hs" "bar" + res <- runD' tdir $ info "ImportsTH.hs" $ Expression "bar" res `shouldSatisfy` ("bar :: [Char]" `isPrefixOf`) getDistDir :: IO FilePath