From a8f3a2d05a0201e631aa57ec32469b4d40ee0bbe Mon Sep 17 00:00:00 2001 From: Hugo Pacheco Date: Wed, 12 Sep 2018 16:53:01 +0100 Subject: [PATCH 1/7] updated for ghc 8.4.2; released source code as a library --- .gitignore | 1 + Parsing.hs | 75 --- SourceGraph.cabal | 72 ++- Analyse.hs => SourceGraph/Analyse.hs | 12 +- {Analyse => SourceGraph/Analyse}/Colors.hs | 2 +- .../Analyse}/Everything.hs | 10 +- {Analyse => SourceGraph/Analyse}/GraphRepr.hs | 8 +- {Analyse => SourceGraph/Analyse}/Imports.hs | 10 +- {Analyse => SourceGraph/Analyse}/Module.hs | 10 +- {Analyse => SourceGraph/Analyse}/Utils.hs | 2 +- {Analyse => SourceGraph/Analyse}/Visualise.hs | 10 +- CabalInfo.hs => SourceGraph/CabalInfo.hs | 30 +- Main.hs => SourceGraph/Main.hs | 113 +--- SourceGraph/Parsing.hs | 177 +++++++ .../Parsing}/ParseModule.hs | 497 ++++++++++-------- {Parsing => SourceGraph/Parsing}/State.hs | 4 +- {Parsing => SourceGraph/Parsing}/Types.hs | 2 +- 17 files changed, 572 insertions(+), 463 deletions(-) delete mode 100644 Parsing.hs rename Analyse.hs => SourceGraph/Analyse.hs (97%) rename {Analyse => SourceGraph/Analyse}/Colors.hs (97%) rename {Analyse => SourceGraph/Analyse}/Everything.hs (97%) rename {Analyse => SourceGraph/Analyse}/GraphRepr.hs (98%) rename {Analyse => SourceGraph/Analyse}/Imports.hs (96%) rename {Analyse => SourceGraph/Analyse}/Module.hs (97%) rename {Analyse => SourceGraph/Analyse}/Utils.hs (98%) rename {Analyse => SourceGraph/Analyse}/Visualise.hs (98%) rename CabalInfo.hs => SourceGraph/CabalInfo.hs (83%) rename Main.hs => SourceGraph/Main.hs (64%) create mode 100644 SourceGraph/Parsing.hs rename {Parsing => SourceGraph/Parsing}/ParseModule.hs (63%) rename {Parsing => SourceGraph/Parsing}/State.hs (97%) rename {Parsing => SourceGraph/Parsing}/Types.hs (99%) diff --git a/.gitignore b/.gitignore index 13a35bd..cf1dca9 100644 --- a/.gitignore +++ b/.gitignore @@ -10,3 +10,4 @@ cabal-dev cabal.sandbox.config cabal.config TAGS +*.DS_Store diff --git a/Parsing.hs b/Parsing.hs deleted file mode 100644 index 090cd69..0000000 --- a/Parsing.hs +++ /dev/null @@ -1,75 +0,0 @@ -{- -Copyright (C) 2009 Ivan Lazar Miljenovic - -This file is part of SourceGraph. - -SourceGraph is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3 of the License, or -(at your option) any later version. - -This program is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. - -You should have received a copy of the GNU General Public License -along with this program; if not, write to the Free Software -Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA --} - -{- | - Module : Parsing - Description : Parse the given Haskell modules. - Copyright : (c) Ivan Lazar Miljenovic 2009 - License : GPL-3 or later. - Maintainer : Ivan.Miljenovic@gmail.com - - Parse the given Haskell modules. - -} -module Parsing - ( FileContents - , ParsedModules - , ModName - , createModule - , parseHaskell - -- from Parsing.Types - , moduleSep - ) where - -import Parsing.Types -import Parsing.ParseModule - -import Language.Haskell.Exts(parseFileContentsWithMode) -import Language.Haskell.Exts.Parser( ParseMode(..) - , ParseResult(..) - , defaultParseMode) -import Language.Haskell.Exts.Syntax(Module) - -import Data.Either(partitionEithers) - -type FileContents = (FilePath,String) - --- | Parse all the files and return the map. --- This uses laziness to evaluate the 'HaskellModules' result --- whilst also using it to parse all the modules to create it. -parseHaskell :: [FileContents] -> ([FilePath],ParsedModules) -parseHaskell fc = (failed,hms) - where - (failed,ms) = parseFiles fc - hms = createModuleMap hss - hss = map (parseModule hms) ms - --- | Attempt to parse an individual file. -parseFile :: FileContents -> Either FilePath Module -parseFile (p,f) = case (parseFileContentsWithMode mode f) of - (ParseOk hs) -> Right hs - _ -> Left p - where - mode = defaultParseMode { parseFilename = p - , fixities = Nothing - } - --- | Parse all the files that you can. -parseFiles :: [FileContents] -> ([FilePath],[Module]) -parseFiles = partitionEithers . map parseFile diff --git a/SourceGraph.cabal b/SourceGraph.cabal index 290fad7..107af5e 100644 --- a/SourceGraph.cabal +++ b/SourceGraph.cabal @@ -1,5 +1,5 @@ Name: SourceGraph -Version: 0.7.0.7 +Version: 0.7.0.8 Synopsis: Static code analysis using graph-theoretic techniques. Description: { Statically analyse Haskell source code using graph-theoretic @@ -42,30 +42,58 @@ Build-Type: Simple Extra-Source-Files: TODO ChangeLog -Tested-With: GHC == 7.4.2, GHC == 7.6.3, GHC == 7.8.4, - GHC == 7.10.2, GHC == 7.11.* +Tested-With: GHC == 8.4.2 Source-Repository head Type: git Location: https://github.com/ivan-m/SourceGraph +Library + exposed-modules: + SourceGraph.Analyse.Colors + SourceGraph.Analyse.Everything + SourceGraph.Analyse.GraphRepr + SourceGraph.Analyse.Imports + SourceGraph.Analyse.Module + SourceGraph.Analyse.Utils + SourceGraph.Analyse.Visualise + SourceGraph.Parsing.ParseModule + SourceGraph.Parsing.State + SourceGraph.Parsing.Types + SourceGraph.Analyse + SourceGraph.Parsing + Hs-source-dirs: . + Other-Modules: + Paths_SourceGraph + Build-Depends: base == 4.*, + containers, + multiset, + filepath, + random, + directory, + mtl, + fgl == 5.6.*, + Graphalyze >= 0.15, + graphviz >= 2999.20 && < 2999.21, + Cabal == 2.2.*, + haskell-src-exts == 1.20.* Executable SourceGraph { - Main-Is: Main.hs - Other-Modules: CabalInfo, - Parsing, - Parsing.ParseModule, - Parsing.State, - Parsing.Types, - Analyse, - Analyse.Utils, - Analyse.Colors, - Analyse.GraphRepr, - Analyse.Visualise, - Analyse.Module, - Analyse.Imports, - Analyse.Everything, + Main-Is: SourceGraph/Main.hs + Other-Modules: SourceGraph.CabalInfo, + SourceGraph.Parsing, + SourceGraph.Parsing.ParseModule, + SourceGraph.Parsing.State, + SourceGraph.Parsing.Types, + SourceGraph.Analyse, + SourceGraph.Analyse.Utils, + SourceGraph.Analyse.Colors, + SourceGraph.Analyse.GraphRepr, + SourceGraph.Analyse.Visualise, + SourceGraph.Analyse.Module, + SourceGraph.Analyse.Imports, + SourceGraph.Analyse.Everything, Paths_SourceGraph Ghc-Options: -Wall Ghc-Prof-Options: -prof @@ -77,9 +105,9 @@ Executable SourceGraph { random, directory, mtl, - fgl == 5.5.*, - Graphalyze >= 0.14.1.0 && < 0.15, - graphviz >= 2999.15.0.0 && < 2999.19, - Cabal == 1.22.*, - haskell-src-exts == 1.16.* + fgl == 5.6.*, + Graphalyze >= 0.15, + graphviz >= 2999.20 && < 2999.21, + Cabal == 2.2.*, + haskell-src-exts == 1.20.* } diff --git a/Analyse.hs b/SourceGraph/Analyse.hs similarity index 97% rename from Analyse.hs rename to SourceGraph/Analyse.hs index 75e5c15..84e4c9b 100644 --- a/Analyse.hs +++ b/SourceGraph/Analyse.hs @@ -27,13 +27,13 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Analyse Haskell software -} -module Analyse(analyse, sgLegend) where +module SourceGraph.Analyse(analyse, sgLegend) where -import Analyse.Module -import Analyse.Imports -import Analyse.Everything -import Analyse.Colors -import Parsing.Types +import SourceGraph.Analyse.Module +import SourceGraph.Analyse.Imports +import SourceGraph.Analyse.Everything +import SourceGraph.Analyse.Colors +import SourceGraph.Parsing.Types import Data.Graph.Analysis hiding (Bold) import qualified Data.Graph.Analysis.Reporting as R (DocInline(Bold)) diff --git a/Analyse/Colors.hs b/SourceGraph/Analyse/Colors.hs similarity index 97% rename from Analyse/Colors.hs rename to SourceGraph/Analyse/Colors.hs index 2b94f04..7de3dab 100644 --- a/Analyse/Colors.hs +++ b/SourceGraph/Analyse/Colors.hs @@ -27,7 +27,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Utility functions and types for analysis. -} -module Analyse.Colors where +module SourceGraph.Analyse.Colors where import Data.GraphViz.Attributes diff --git a/Analyse/Everything.hs b/SourceGraph/Analyse/Everything.hs similarity index 97% rename from Analyse/Everything.hs rename to SourceGraph/Analyse/Everything.hs index d71934b..0697768 100644 --- a/Analyse/Everything.hs +++ b/SourceGraph/Analyse/Everything.hs @@ -27,12 +27,12 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Analysis of the entire overall piece of software. -} -module Analyse.Everything(analyseEverything) where +module SourceGraph.Analyse.Everything(analyseEverything) where -import Parsing.Types -import Analyse.Utils -import Analyse.GraphRepr -import Analyse.Visualise +import SourceGraph.Parsing.Types +import SourceGraph.Analyse.Utils +import SourceGraph.Analyse.GraphRepr +import SourceGraph.Analyse.Visualise import Data.Graph.Analysis diff --git a/Analyse/GraphRepr.hs b/SourceGraph/Analyse/GraphRepr.hs similarity index 98% rename from Analyse/GraphRepr.hs rename to SourceGraph/Analyse/GraphRepr.hs index e6da95e..17026e3 100644 --- a/Analyse/GraphRepr.hs +++ b/SourceGraph/Analyse/GraphRepr.hs @@ -29,7 +29,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Interacting with GraphData from Graphalyze. -} -module Analyse.GraphRepr +module SourceGraph.Analyse.GraphRepr ( -- * General stuff GData(..) , mapData @@ -62,9 +62,9 @@ module Analyse.GraphRepr , ModGraph ) where -import Analyse.Colors -import Analyse.Utils -import Parsing.Types +import SourceGraph.Analyse.Colors +import SourceGraph.Analyse.Utils +import SourceGraph.Parsing.Types import Data.Graph.Analysis import Data.Graph.Inductive diff --git a/Analyse/Imports.hs b/SourceGraph/Analyse/Imports.hs similarity index 96% rename from Analyse/Imports.hs rename to SourceGraph/Analyse/Imports.hs index 9997443..08a9b1c 100644 --- a/Analyse/Imports.hs +++ b/SourceGraph/Analyse/Imports.hs @@ -27,12 +27,12 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Analysis of Haskell module importing. -} -module Analyse.Imports (analyseImports) where +module SourceGraph.Analyse.Imports (analyseImports) where -import Parsing.Types -import Analyse.Utils -import Analyse.GraphRepr -import Analyse.Visualise +import SourceGraph.Parsing.Types +import SourceGraph.Analyse.Utils +import SourceGraph.Analyse.GraphRepr +import SourceGraph.Analyse.Visualise import Data.Graph.Analysis diff --git a/Analyse/Module.hs b/SourceGraph/Analyse/Module.hs similarity index 97% rename from Analyse/Module.hs rename to SourceGraph/Analyse/Module.hs index cf08ae3..da06d1f 100644 --- a/Analyse/Module.hs +++ b/SourceGraph/Analyse/Module.hs @@ -27,12 +27,12 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Analysis of Haskell modules. -} -module Analyse.Module(analyseModules) where +module SourceGraph.Analyse.Module(analyseModules) where -import Parsing.Types -import Analyse.Utils -import Analyse.GraphRepr -import Analyse.Visualise +import SourceGraph.Parsing.Types +import SourceGraph.Analyse.Utils +import SourceGraph.Analyse.GraphRepr +import SourceGraph.Analyse.Visualise import Data.Graph.Analysis diff --git a/Analyse/Utils.hs b/SourceGraph/Analyse/Utils.hs similarity index 98% rename from Analyse/Utils.hs rename to SourceGraph/Analyse/Utils.hs index fa050ad..2b67b7a 100644 --- a/Analyse/Utils.hs +++ b/SourceGraph/Analyse/Utils.hs @@ -27,7 +27,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Utility functions and types for analysis. -} -module Analyse.Utils where +module SourceGraph.Analyse.Utils where import Data.Graph.Analysis hiding (Bold) diff --git a/Analyse/Visualise.hs b/SourceGraph/Analyse/Visualise.hs similarity index 98% rename from Analyse/Visualise.hs rename to SourceGraph/Analyse/Visualise.hs index 825cd6e..8e04a3e 100644 --- a/Analyse/Visualise.hs +++ b/SourceGraph/Analyse/Visualise.hs @@ -27,12 +27,12 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Utility functions and types for analysis. -} -module Analyse.Visualise where +module SourceGraph.Analyse.Visualise where -import Analyse.Colors -import Analyse.GraphRepr -import Analyse.Utils -import Parsing.Types +import SourceGraph.Analyse.Colors +import SourceGraph.Analyse.GraphRepr +import SourceGraph.Analyse.Utils +import SourceGraph.Parsing.Types import Data.Graph.Analysis hiding (Bold) import Data.GraphViz diff --git a/CabalInfo.hs b/SourceGraph/CabalInfo.hs similarity index 83% rename from CabalInfo.hs rename to SourceGraph/CabalInfo.hs index f5b1dac..aa29aaf 100644 --- a/CabalInfo.hs +++ b/SourceGraph/CabalInfo.hs @@ -1,3 +1,8 @@ +{-# LANGUAGE CPP #-} +#if !defined(MIN_VERSION_Cabal) +# define MIN_VERSION_Cabal(a,b,c) 0 +#endif + {- Copyright (C) 2009 Ivan Lazar Miljenovic @@ -27,14 +32,18 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Used to parse and obtain information from the provided Cabal file. -} -module CabalInfo(parseCabal) where +module SourceGraph.CabalInfo(parseCabal) where import Distribution.Compiler (CompilerInfo) import Distribution.ModuleName (toFilePath) import Distribution.Package import Distribution.PackageDescription hiding (author) import Distribution.PackageDescription.Configuration +#if MIN_VERSION_Cabal(2,0,0) +import Distribution.PackageDescription.Parsec +#else import Distribution.PackageDescription.Parse +#endif import Distribution.Simple.Compiler (compilerInfo) import Distribution.Simple.GHC (configure) import Distribution.Simple.Program (defaultProgramConfiguration) @@ -49,6 +58,19 @@ import System.FilePath (dropExtension) -- ----------------------------------------------------------------------------- +emptyFlagAssignment :: FlagAssignment +#if MIN_VERSION_Cabal(2,0,0) +emptyFlagAssignment = mkFlagAssignment [] +#else +emptyFlagAssignment = [] +#endif + +#if MIN_VERSION_Cabal(2,0,0) +readDescription = readGenericPackageDescription +#else +readDescription = readPackageDescription +#endif + ghcID :: IO CompilerInfo ghcID = liftM (compilerInfo . getCompiler) $ configure silent Nothing Nothing defaultProgramConfiguration @@ -61,10 +83,10 @@ parseCabal fp = do cID <- ghcID where -- Need to specify the Exception type getDesc :: FilePath -> IO (Either SomeException GenericPackageDescription) - getDesc = try . readPackageDescription silent + getDesc = try . readDescription silent parseDesc cID = fmap parse . compactEithers . fmap (unGeneric cID) unGeneric cID = fmap fst - . finalizePackageDescription [] -- flags, use later + . finalizePackageDescription emptyFlagAssignment -- flags, use later (const True) -- ignore -- deps buildPlatform @@ -73,7 +95,7 @@ parseCabal fp = do cID <- ghcID parse pd = (nm, exps) where nm = pName . pkgName $ package pd - pName (PackageName nm') = nm' + pName nm' = unPackageName nm' exes = filter (buildable . buildInfo) $ executables pd lib = library pd moduleNames = map toFilePath diff --git a/Main.hs b/SourceGraph/Main.hs similarity index 64% rename from Main.hs rename to SourceGraph/Main.hs index 70246c9..91f6937 100644 --- a/Main.hs +++ b/SourceGraph/Main.hs @@ -30,33 +30,26 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} module Main where -import CabalInfo -import Parsing -import Parsing.Types(nameOfModule) -import Analyse +import SourceGraph.CabalInfo +import SourceGraph.Parsing +import SourceGraph.Parsing.Types(nameOfModule,ParsedModules,ModName(..)) +import SourceGraph.Analyse import Data.Graph.Analysis import Data.Graph.Analysis.Reporting.Pandoc import Data.GraphViz.Commands(quitWithoutGraphviz) -import Data.Char(toLower) -import Data.Maybe(catMaybes) import qualified Data.Map as M import System.IO(hPutStrLn, stderr) import System.Directory( getCurrentDirectory - , doesDirectoryExist - , doesFileExist - , getDirectoryContents) + , doesFileExist) import System.FilePath( dropFileName - , takeExtension - , isPathSeparator - , () - , (<.>)) + , ()) import System.Random(newStdGen) import System.Environment(getArgs) import Control.Arrow(second) import Control.Monad(liftM) -import Control.Exception(SomeException(..), try) +--import Control.Exception(SomeException(..), try) import Data.Version(showVersion) import qualified Paths_SourceGraph as Paths(version) @@ -121,99 +114,7 @@ parseMain fp = do (_,pms) <- parseHaskellFiles [fp] let mn = fst $ M.findMin pms return $ Just (nameOfModule mn, [mn]) --- | Determine if this is the path of a Haskell file. -isHaskellFile :: FilePath -> Bool -isHaskellFile fp = any (`hasExt` fp) haskellExtensions -hasExt :: String -> FilePath -> Bool -hasExt ext = (==) ext . drop 1 . takeExtension - -fpToModule :: FilePath -> ModName -fpToModule = createModule . map pSep - where - pSep c - | isPathSeparator c = moduleSep - | otherwise = c - --- ----------------------------------------------------------------------------- - --- | Recursively parse all files from this directory -parseFilesFrom :: FilePath -> IO ([FilePath],ParsedModules) -parseFilesFrom fp = parseHaskellFiles =<< getHaskellFilesFrom fp - -parseHaskellFiles :: [FilePath] -> IO ([FilePath],ParsedModules) -parseHaskellFiles = liftM parseHaskell . readFiles - --- ----------------------------------------------------------------------------- - --- Reading in the files. - --- | Recursively find all Haskell source files from the current directory. -getHaskellFilesFrom :: FilePath -> IO [FilePath] -getHaskellFilesFrom fp - = do isDir <- doesDirectoryExist fp -- Ensure it's a directory. - if isDir - then do r <- try getFilesIn -- Ensure we can read the directory. - case r of - (Right fs) -> return fs - (Left SomeException{}) -> return [] - else return [] - where - -- Filter out "." and ".." to stop infinite recursion. - nonTrivialContents :: IO [FilePath] - nonTrivialContents = do contents <- getDirectoryContents fp - let contents' = filter (not . isTrivial) contents - return $ map (fp ) contents' - getFilesIn :: IO [FilePath] - getFilesIn = do contents <- nonTrivialContents - (dirs,files) <- partitionM doesDirectoryExist contents - let hFiles = filter isHaskellFile files - recursiveFiles <- concatMapM getHaskellFilesFrom dirs - return (hFiles ++ recursiveFiles) - -haskellExtensions :: [FilePath] -haskellExtensions = ["hs","lhs"] - --- | Read in all the files that it can. -readFiles :: [FilePath] -> IO [FileContents] -readFiles = liftM catMaybes . mapM readFileContents - --- | Try to read the given file. -readFileContents :: FilePath -> IO (Maybe FileContents) -readFileContents f = do cnts <- try $ readFile f - case cnts of - (Right str) -> return $ Just (f,str) - (Left SomeException{}) -> return Nothing - --- | A version of 'concatMap' for use in monads. -concatMapM :: (Monad m) => (a -> m [b]) -> [a] -> m [b] -concatMapM f = liftM concat . mapM f - --- | A version of 'partition' for use in monads. -partitionM :: (Monad m) => (a -> m Bool) -> [a] -> m ([a], [a]) -partitionM _ [] = return ([],[]) -partitionM p (x:xs) = do ~(ts,fs) <- partitionM p xs - matches <- p x - if matches - then return (x:ts,fs) - else return (ts,x:fs) - --- | Trivial paths are the current directory, the parent directory and --- such directories -isTrivial :: FilePath -> Bool -isTrivial "." = True -isTrivial ".." = True -isTrivial "_darcs" = True -isTrivial "dist" = True -isTrivial "HLInt.hs" = True -isTrivial f | isSetup f = True -isTrivial _ = False - -lowerCase :: String -> String -lowerCase = map toLower - -isSetup :: String -> Bool -isSetup f = lowerCase f `elem` map ("setup" <.>) haskellExtensions -- ----------------------------------------------------------------------------- diff --git a/SourceGraph/Parsing.hs b/SourceGraph/Parsing.hs new file mode 100644 index 0000000..b100273 --- /dev/null +++ b/SourceGraph/Parsing.hs @@ -0,0 +1,177 @@ +{- +Copyright (C) 2009 Ivan Lazar Miljenovic + +This file is part of SourceGraph. + +SourceGraph is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 3 of the License, or +(at your option) any later version. + +This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with this program; if not, write to the Free Software +Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +-} + +{- | + Module : Parsing + Description : Parse the given Haskell modules. + Copyright : (c) Ivan Lazar Miljenovic 2009 + License : GPL-3 or later. + Maintainer : Ivan.Miljenovic@gmail.com + + Parse the given Haskell modules. + -} +module SourceGraph.Parsing where + +import SourceGraph.Parsing.Types +import SourceGraph.Parsing.ParseModule + +import Language.Haskell.Exts(parseFileContentsWithMode) +import Language.Haskell.Exts.Parser( ParseMode(..) + , ParseResult(..) + , defaultParseMode) +import Language.Haskell.Exts.Syntax(Module) +import Language.Haskell.Exts.SrcLoc + +import Data.Either(partitionEithers) + +import Control.Exception +import Control.Monad +import Data.Maybe +import Data.Char + +import System.Directory( getCurrentDirectory + , doesDirectoryExist + , doesFileExist + , getDirectoryContents) +import System.FilePath( dropFileName + , takeExtension + , isPathSeparator + , () + , (<.>)) + +type FileContents = (FilePath,String) + +-- | Parse all the files and return the map. +-- This uses laziness to evaluate the 'HaskellModules' result +-- whilst also using it to parse all the modules to create it. +parseHaskell :: [FileContents] -> ([FilePath],ParsedModules) +parseHaskell fc = (failed,hms) + where + (failed,ms) = parseFiles fc + hms = createModuleMap hss + hss = map (parseModule hms) ms + +-- | Attempt to parse an individual file. +parseFile :: FileContents -> Either FilePath (Module SrcSpanInfo) +parseFile (p,f) = case (parseFileContentsWithMode mode f) of + (ParseOk hs) -> Right hs + _ -> Left p + where + mode = defaultParseMode { parseFilename = p + , fixities = Nothing + } + +-- | Parse all the files that you can. +parseFiles :: [FileContents] -> ([FilePath],[Module SrcSpanInfo]) +parseFiles = partitionEithers . map parseFile + +-- | Read in all the files that it can. +readFiles :: [FilePath] -> IO [FileContents] +readFiles = liftM catMaybes . mapM readFileContents + +-- | Try to read the given file. +readFileContents :: FilePath -> IO (Maybe FileContents) +readFileContents f = do cnts <- try $ readFile f + case cnts of + (Right str) -> return $ Just (f,str) + (Left SomeException{}) -> return Nothing + +-- ----------------------------------------------------------------------------- + +-- | Recursively parse all files from this directory +parseFilesFrom :: FilePath -> IO ([FilePath],ParsedModules) +parseFilesFrom fp = parseHaskellFiles =<< getHaskellFilesFrom fp + +parseHaskellFiles :: [FilePath] -> IO ([FilePath],ParsedModules) +parseHaskellFiles = liftM parseHaskell . readFiles + +-- Reading in the files. + +-- | Recursively find all Haskell source files from the current directory. +getHaskellFilesFrom :: FilePath -> IO [FilePath] +getHaskellFilesFrom fp + = do isDir <- doesDirectoryExist fp -- Ensure it's a directory. + if isDir + then do r <- try getFilesIn -- Ensure we can read the directory. + case r of + (Right fs) -> return fs + (Left SomeException{}) -> return [] + else return [] + where + -- Filter out "." and ".." to stop infinite recursion. + nonTrivialContents :: IO [FilePath] + nonTrivialContents = do contents <- getDirectoryContents fp + let contents' = filter (not . isTrivial) contents + return $ map (fp ) contents' + getFilesIn :: IO [FilePath] + getFilesIn = do contents <- nonTrivialContents + (dirs,files) <- partitionM doesDirectoryExist contents + let hFiles = filter isHaskellFile files + recursiveFiles <- concatMapM getHaskellFilesFrom dirs + return (hFiles ++ recursiveFiles) + +-- | A version of 'concatMap' for use in monads. +concatMapM :: (Monad m) => (a -> m [b]) -> [a] -> m [b] +concatMapM f = liftM concat . mapM f + +-- | Determine if this is the path of a Haskell file. +isHaskellFile :: FilePath -> Bool +isHaskellFile fp = any (`hasExt` fp) haskellExtensions + +hasExt :: String -> FilePath -> Bool +hasExt ext = (==) ext . drop 1 . takeExtension + +fpToModule :: FilePath -> ModName +fpToModule = createModule . map pSep + where + pSep c + | isPathSeparator c = moduleSep + | otherwise = c + +-- ----------------------------------------------------------------------------- + +haskellExtensions :: [FilePath] +haskellExtensions = ["hs","lhs"] + +-- | A version of 'partition' for use in monads. +partitionM :: (Monad m) => (a -> m Bool) -> [a] -> m ([a], [a]) +partitionM _ [] = return ([],[]) +partitionM p (x:xs) = do ~(ts,fs) <- partitionM p xs + matches <- p x + if matches + then return (x:ts,fs) + else return (ts,x:fs) + +-- | Trivial paths are the current directory, the parent directory and +-- such directories +isTrivial :: FilePath -> Bool +isTrivial "." = True +isTrivial ".." = True +isTrivial "_darcs" = True +isTrivial "dist" = True +isTrivial "HLInt.hs" = True +isTrivial f | isSetup f = True +isTrivial _ = False + +lowerCase :: String -> String +lowerCase = map toLower + +isSetup :: String -> Bool +isSetup f = lowerCase f `elem` map ("setup" <.>) haskellExtensions \ No newline at end of file diff --git a/Parsing/ParseModule.hs b/SourceGraph/Parsing/ParseModule.hs similarity index 63% rename from Parsing/ParseModule.hs rename to SourceGraph/Parsing/ParseModule.hs index 1221827..d15bffc 100644 --- a/Parsing/ParseModule.hs +++ b/SourceGraph/Parsing/ParseModule.hs @@ -29,10 +29,10 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Parse a Haskell module. -} -module Parsing.ParseModule(parseModule) where +module SourceGraph.Parsing.ParseModule(parseModule) where -import Parsing.State -import Parsing.Types +import SourceGraph.Parsing.State +import SourceGraph.Parsing.Types import Language.Haskell.Exts.Pretty import Language.Haskell.Exts.Syntax @@ -50,7 +50,7 @@ import qualified Data.Set as S -- ----------------------------------------------------------------------------- -parseModule :: ParsedModules -> Module -> ParsedModule +parseModule :: ParsedModules -> Module l -> ParsedModule parseModule hms m = pm where mns = moduleNames hms @@ -67,19 +67,29 @@ instance (ModuleItem a) => ModuleItem [a] where -- ----------------------------------------------------------------------------- -- Overall Module -instance ModuleItem Module where - parseInfo (Module _ nm _ _ es is ds) - = do let mn = createModule' nm - pm <- get - put $ pm { moduleName = mn } - parseInfo es - parseInfo is - parseInfo ds +splitModuleHeadMaybe :: Maybe (ModuleHead l) -> (ModuleName l,Maybe [ExportSpec l]) +splitModuleHeadMaybe Nothing = (ModuleName (error "noloc") "Main",Nothing) +splitModuleHeadMaybe (Just h) = splitModuleHead h + +splitModuleHead :: ModuleHead l -> (ModuleName l,Maybe [ExportSpec l]) +splitModuleHead (ModuleHead _ n _ es) = (n,fmap exports es) + where + exports (ExportSpecList _ xs) = xs + +instance ModuleItem (Module l) where + parseInfo (Module _ h _ is ds) = do + let (nm,es) = splitModuleHeadMaybe h + let mn = createModule' nm + pm <- get + put $ pm { moduleName = mn } + parseInfo es + parseInfo is + parseInfo ds -- ----------------------------------------------------------------------------- -- Imports -instance ModuleItem ImportDecl where +instance ModuleItem (ImportDecl l) where parseInfo iDcl = do mns <- getModuleNames ms <- getModules @@ -99,14 +109,14 @@ instance ModuleItem ImportDecl where imported nm Nothing = case importSpecs iDcl of - Just (False,is) -> mkSet + Just (ImportSpecList _ False is) -> mkSet $ map (createEnt nm) is _ -> S.empty imported _ (Just ml) = case importSpecs iDcl of Nothing -> exprtd - Just (False,is) -> lstd is - Just (True, is) -> exprtd `S.difference` lstd is + Just (ImportSpecList _ False is) -> lstd is + Just (ImportSpecList _ True is) -> exprtd `S.difference` lstd is where exprtd = exports ml exLk = exportLookup ml @@ -114,9 +124,9 @@ instance ModuleItem ImportDecl where -- | Guesstimate the correct 'Entity' designation for those from -- external modules. -createEnt :: ModName -> ImportSpec -> [Entity] +createEnt :: ModName -> ImportSpec l -> [Entity] createEnt mn (IVar _ n) = [Ent mn (nameOf n) NormalEntity] -createEnt mn (IThingWith n cs) = map (\c -> Ent mn c (eT c)) cs' +createEnt mn (IThingWith _ n cs) = map (\c -> Ent mn c (eT c)) cs' where n' = nameOf n cs' = map nameOf cs @@ -130,14 +140,14 @@ createEnt _ _ = [] -- | Determine the correct 'Entity' designation for the listed import item. listedEnt :: ParsedModule -> EntityLookup - -> ImportSpec -> [Entity] + -> ImportSpec l -> [Entity] listedEnt _ el (IVar _ n) = [lookupEntity' el $ nameOf n] listedEnt _ _ IAbs{} = [] -listedEnt pm _ (IThingAll n) = esFrom dataDecls ++ esFrom classDecls +listedEnt pm _ (IThingAll _ n) = esFrom dataDecls ++ esFrom classDecls -- one will be empty where esFrom f = maybe [] M.elems $ M.lookup (nameOf n) (f pm) -listedEnt pm _ (IThingWith n cs) = esFrom dataDecls ++ esFrom classDecls +listedEnt pm _ (IThingWith _ n cs) = esFrom dataDecls ++ esFrom classDecls where el f = M.lookup (nameOf n) $ f pm esFrom = maybe [] (\lk -> map (lookupEntity' lk . nameOf) cs) . el @@ -148,7 +158,7 @@ listedEnt pm _ (IThingWith n cs) = esFrom dataDecls ++ esFrom classDecls -- If the export list is unspecified but there is a function called -- "main" defined, then it is defined as the export list (otherwise -- all top-level items are exported). -instance ModuleItem (Maybe [ExportSpec]) where +instance ModuleItem (Maybe [ExportSpec l]) where parseInfo Nothing = do pm <- get fpm <- getFutureParsedModule el <- getLookup @@ -163,23 +173,23 @@ instance ModuleItem (Maybe [ExportSpec]) where -- Doesn't work on re-exported Class/Data specs. listedExp :: ParsedModule -> EntityLookup - -> ExportSpec -> [Entity] + -> ExportSpec l -> [Entity] listedExp _ el (EVar _ qn) = maybe [] (return . lookupEntity el) $ qName qn listedExp _ _ EAbs{} = [] -listedExp pm _ (EThingAll qn) = esFrom dataDecls ++ esFrom classDecls - -- one will be empty - where - esFrom f = fromMaybe [] - $ do n <- liftM snd $ qName qn - el <- M.lookup n $ f pm - return $ M.elems el -listedExp pm _ (EThingWith qn cs) = esFrom dataDecls ++ esFrom classDecls +--listedExp pm _ (EThingAll qn) = esFrom dataDecls ++ esFrom classDecls +-- -- one will be empty +-- where +-- esFrom f = fromMaybe [] +-- $ do n <- liftM snd $ qName qn +-- el <- M.lookup n $ f pm +-- return $ M.elems el +listedExp pm _ (EThingWith _ _ qn cs) = esFrom dataDecls ++ esFrom classDecls where esFrom f = fromMaybe [] $ do mn <- fmap snd $ qName qn el <- M.lookup mn $ f pm return $ map (lookupEntity' el . nameOf) cs -listedExp pm _ (EModuleContents m) = fromMaybe [] +listedExp pm _ (EModuleContents _ m) = fromMaybe [] . fmap (S.toList . importedEnts) . M.lookup (createModule' m) $ imports pm @@ -187,27 +197,46 @@ listedExp pm _ (EModuleContents m) = fromMaybe [] -- ----------------------------------------------------------------------------- -- Main part of the module -instance ModuleItem Decl where +instRuleHead :: InstRule l -> InstHead l +instRuleHead (IParen _ r) = instRuleHead r +instRuleHead (IRule l _ _ h) = h + +splitInstHead :: InstHead l -> (QName l,[Type l]) +splitInstHead (IHCon _ n) = (n,[]) +splitInstHead (IHInfix _ t n) = (n,[t]) +splitInstHead (IHParen _ h) = splitInstHead h +splitInstHead (IHApp _ h t) = (n,ts++[t]) + where (n,ts) = splitInstHead h + +declHeadName :: DeclHead l -> Name l +declHeadName (DHead l n) = n +declHeadName (DHInfix l _ n) = n +declHeadName (DHParen _ h) = declHeadName h +declHeadName (DHApp _ h _) = declHeadName h + +instance ModuleItem (Decl l) where -- Type alias parseInfo TypeDecl{} = return () -- Type Families: don't seem to have any entities. parseInfo TypeFamDecl{} = return () -- Data or Newtype - parseInfo (DataDecl _ _ _ nm _ cs _) - = do let d = nameOf nm - els <- mapM (addConstructor d . unQConDecl) cs - pm <- get - let el = M.unions els - dds' = M.insert d el $ dataDecls pm - put $ pm { dataDecls = dds' } + parseInfo (DataDecl _ _ _ h cs _) = do + let nm = declHeadName h + let d = nameOf nm + els <- mapM (addConstructor d . unQConDecl) cs + pm <- get + let el = M.unions els + dds' = M.insert d el $ dataDecls pm + put $ pm { dataDecls = dds' } -- GADT-style Data or Newtype - parseInfo (GDataDecl _ _ _ n _ _ gds _) - = do m <- getModuleName - pm <- get - let d = nameOf n - el = addGConstructors m d gds - dds' = M.insert d el $ dataDecls pm - put $ pm { dataDecls = dds' } + parseInfo (GDataDecl _ _ _ h _ gds _) = do + let n = declHeadName h + m <- getModuleName + pm <- get + let d = nameOf n + el = addGConstructors m d gds + dds' = M.insert d el $ dataDecls pm + put $ pm { dataDecls = dds' } -- Data Families: don't seem to have any entities parseInfo DataFamDecl{} = return () -- Type families are basically aliases... @@ -220,18 +249,21 @@ instance ModuleItem Decl where -- todo parseInfo GDataInsDecl{} = return () -- Defining a new class - parseInfo (ClassDecl _ _ n _ _ cds) - = do let c = nameOf n - mels <- mapM (addClassDecl c) cds - pm <- get - let el = M.unions $ catMaybes mels - cl' = M.insert c el $ classDecls pm - put $ pm { classDecls = cl' } + parseInfo (ClassDecl _ _ h _ cds) = do + let n = declHeadName h + let c = nameOf n + mels <- mapM (addClassDecl c) $ maybe [] id cds + pm <- get + let el = M.unions $ catMaybes mels + cl' = M.insert c el $ classDecls pm + put $ pm { classDecls = cl' } -- Instance of a class - parseInfo (InstDecl _ _ _ _ n ts ids) - = do let c = snd . fromJust $ qName n - d = unwords $ map prettyPrint ts - mapM_ (addInstDecl c d) ids + parseInfo (InstDecl _ _ r ids) = do + let h = instRuleHead r + let (n,ts) = splitInstHead h + let c = snd . fromJust $ qName n + d = unwords $ map prettyPrint ts + mapM_ (addInstDecl c d) $ maybe [] id ids -- Stand-alone deriving parseInfo DerivDecl{} = return () -- Fixity of infix operators @@ -243,7 +275,7 @@ instance ModuleItem Decl where -- Type sigs... use the actual function parseInfo TypeSig{} = return () -- Actual Function - parseInfo (FunBind ms) = mapM_ addMatch ms + parseInfo (FunBind _ ms) = mapM_ addMatch ms -- Defining a variable, etc. parseInfo pb@PatBind{} = do mn <- getModuleName @@ -269,29 +301,33 @@ instance ModuleItem Decl where -- ----------------------------------------------------------------------------- -- Constructors -unQConDecl :: QualConDecl -> ConDecl +unQConDecl :: QualConDecl l -> ConDecl l unQConDecl (QualConDecl _ _ _ cd) = cd -addConstructor :: DataType -> ConDecl -> PState EntityLookup -addConstructor d (ConDecl n _) = do m <- getModuleName - let n' = nameOf n - e = Ent m n' (Constructor d) - return $ M.singleton (Nothing,n') e -addConstructor d (InfixConDecl _ n _) = do m <- getModuleName - let n' = nameOf n - e = Ent m n' (Constructor d) - return $ M.singleton (Nothing,n') e -addConstructor d (RecDecl n rbs) = do m <- getModuleName - pm <- get - let n' = nameOf n - ce = Ent m n' (Constructor d) - rs = map nameOf $ concatMap fst rbs - res = map (mkRe m) rs - es = ce : res - fcs = MS.fromList $ map (mkFc ce) res - put $ addFcs pm fcs - return $ mkEl es - where +addConstructor :: DataType -> ConDecl l -> PState EntityLookup +addConstructor d (ConDecl _ n _) = do + m <- getModuleName + let n' = nameOf n + e = Ent m n' (Constructor d) + return $ M.singleton (Nothing,n') e +addConstructor d (InfixConDecl _ _ n _) = do + m <- getModuleName + let n' = nameOf n + e = Ent m n' (Constructor d) + return $ M.singleton (Nothing,n') e +addConstructor d (RecDecl _ n fd) = do + let rbs = map (\(FieldDecl _ x y) -> (x,y)) fd + m <- getModuleName + pm <- get + let n' = nameOf n + ce = Ent m n' (Constructor d) + rs = map nameOf $ concatMap fst rbs + res = map (mkRe m) rs + es = ce : res + fcs = MS.fromList $ map (mkFc ce) res + put $ addFcs pm fcs + return $ mkEl es + where mkRe m r = Ent m r (RecordFunction d) mkFc c r = FC r c RecordConstructor addFcs pm fcs = pm { funcCalls = fcs `MS.union` funcCalls pm } @@ -299,7 +335,7 @@ addConstructor d (RecDecl n rbs) = do m <- getModuleName -- ----------------------------------------------------------------------------- -- GADT constructors -addGConstructors :: ModName -> DataType -> [GadtDecl] -> EntityLookup +addGConstructors :: ModName -> DataType -> [GadtDecl l] -> EntityLookup addGConstructors m d = mkEl . map addGConst where addGConst (GadtDecl _ n _ _) = Ent m (nameOf n) (Constructor d) @@ -307,18 +343,18 @@ addGConstructors m d = mkEl . map addGConst -- ----------------------------------------------------------------------------- -- Class declaration -addClassDecl :: ClassName -> ClassDecl +addClassDecl :: ClassName -> ClassDecl l -> PState (Maybe EntityLookup) -addClassDecl c (ClsDecl d) = addCDecl c d +addClassDecl c (ClsDecl _ d) = addCDecl c d addClassDecl _ _ = return Nothing -addCDecl :: ClassName -> Decl -> PState (Maybe EntityLookup) +addCDecl :: ClassName -> Decl l -> PState (Maybe EntityLookup) addCDecl c (TypeSig _ ns _) = do m <- getModuleName let ns' = map nameOf ns eTp = ClassMethod c es = map (\n -> Ent m n eTp) ns' return $ Just (mkEl es) -addCDecl c (FunBind ms) = mapM_ (addCMatch c) ms >> return Nothing +addCDecl c (FunBind _ ms) = mapM_ (addCMatch c) ms >> return Nothing addCDecl c pb@PatBind{} = do mn <- getModuleName el <- getLookup @@ -350,7 +386,7 @@ addCDecl c pb@PatBind{} = do mn <- getModuleName -- Can't have anything else in classes addCDecl _ _ = return Nothing -addCMatch :: ClassName -> Match -> PState () +addCMatch :: ClassName -> Match l -> PState () addCMatch c m = do el <- getLookup di <- addFuncCalls (DefaultInstance c) m pm <- get @@ -365,21 +401,22 @@ addCMatch c m = do el <- getLookup -- ----------------------------------------------------------------------------- -- Instance Declaration -addInstDecl :: ClassName -> DataType -> InstDecl -> PState () -addInstDecl c d (InsDecl decl) = do cs <- addIDecl c d decl - mn <- getModuleName - pm <- get - let fromThisMod = (==) mn . inModule - cs' = S.filter (not . fromThisMod) cs - pm' = pm { virtualEnts = virtualEnts pm - `S.union` - cs' - } - put pm' +addInstDecl :: ClassName -> DataType -> InstDecl l -> PState () +addInstDecl c d (InsDecl _ decl) = do + cs <- addIDecl c d decl + mn <- getModuleName + pm <- get + let fromThisMod = (==) mn . inModule + cs' = S.filter (not . fromThisMod) cs + pm' = pm { virtualEnts = virtualEnts pm + `S.union` + cs' + } + put pm' addInstDecl _ _ _ = return () -addIDecl :: ClassName -> DataType -> Decl -> PState (Set Entity) -addIDecl c d (FunBind ms) = liftM S.fromList $ mapM (addIMatch c d) ms +addIDecl :: ClassName -> DataType -> Decl l -> PState (Set Entity) +addIDecl c d (FunBind _ ms) = liftM S.fromList $ mapM (addIMatch c d) ms addIDecl c d pb@PatBind{} = do mn <- getModuleName el <- getLookup pm <- get @@ -410,7 +447,7 @@ addIDecl c d pb@PatBind{} = do mn <- getModuleName return $ S.map fst cis addIDecl _ _ _ = return S.empty -addIMatch :: ClassName -> DataType -> Match -> PState Entity +addIMatch :: ClassName -> DataType -> Match l -> PState Entity addIMatch c d m = do pmf <- getFutureParsedModule fi <- addFuncCalls (ClassInstance c d) m pm <- get @@ -445,7 +482,7 @@ classFuncLookup c pmf n = case inModule e of -- ----------------------------------------------------------------------------- -- For top-level functions -addMatch :: Match -> PState () +addMatch :: Match l -> PState () addMatch m = do e <- addFuncCalls NormalEntity m pm <- get put $ pm { topEnts = S.insert e $ topEnts pm } @@ -454,7 +491,7 @@ addMatch m = do e <- addFuncCalls NormalEntity m -- Add the appropriate 'FunctionCall' values and return the created -- 'Entity'. The 'FunctionCall's have @callType = NormalCall@. -addFuncCalls :: EntityType -> Match -> PState Entity +addFuncCalls :: EntityType -> Match l -> PState Entity addFuncCalls et m = do mn <- getModuleName el <- getLookup pm <- get @@ -483,64 +520,74 @@ type Defined = Set QEntityName type Called = MultiSet QEntityName type DefCalled = (Defined, Called) -getMatch :: Match -> PState DefCalled -getMatch (Match _ n ps _ rhs bs) = do (avs, afs) <- getPats ps - rcs <- getRHS rhs - (bds, bcs) <- getBindings bs - let vs = avs `S.union` bds - fs = MS.unions [afs, rcs, bcs] - cs = defElsewhere fs vs - return (S.singleton $ nameOf' n, cs) +getMatch :: Match l -> PState DefCalled +getMatch (Match _ n ps rhs bs) = do + (avs, afs) <- getPats ps + rcs <- getRHS rhs + (bds, bcs) <- getMaybeBindings bs + let vs = avs `S.union` bds + fs = MS.unions [afs, rcs, bcs] + cs = defElsewhere fs vs + return (S.singleton $ nameOf' n, cs) +getMatch (InfixMatch _ _ n ps rhs bs) = do + (avs, afs) <- getPats ps + rcs <- getRHS rhs + (bds, bcs) <- getMaybeBindings bs + let vs = avs `S.union` bds + fs = MS.unions [afs, rcs, bcs] + cs = defElsewhere fs vs + return (S.singleton $ nameOf' n, cs) -- In a pattern, all variables are ones that have just been defined to -- use in that function, etc. -getPat :: Pat -> PState DefCalled +getPat :: Pat l -> PState DefCalled -- Variable -getPat (PVar n) = return $ onlyVar n +getPat (PVar _ n) = return $ onlyVar n -- Literal value getPat PLit{} = return noEnts -- n + k pattern -getPat (PNPlusK n _) = return $ onlyVar n +getPat (PNPlusK _ n _) = return $ onlyVar n -- e.g. a : as -getPat (PInfixApp p1 c p2) = do (v1, c1) <- getPat p1 - (v2, c2) <- getPat p2 - return ( v1 `S.union` v2 - , insQName c $ c1 `MS.union` c2) +getPat (PInfixApp _ p1 c p2) = do + (v1, c1) <- getPat p1 + (v2, c2) <- getPat p2 + return ( v1 `S.union` v2, insQName c $ c1 `MS.union` c2) -- Data constructor + args -getPat (PApp qn ps) = liftM (second $ insQName qn) $ getPats ps +getPat (PApp _ qn ps) = liftM (second $ insQName qn) $ getPats ps -- Tuple -getPat (PTuple _ ps) = getPats ps +getPat (PTuple _ _ ps) = getPats ps -- Explicit list -getPat (PList ps) = getPats ps +getPat (PList _ ps) = getPats ps -- Parens around a Pat -getPat (PParen p) = getPat p +getPat (PParen _ p) = getPat p -- Record pattern -getPat (PRec q ps) = liftM (second (insQName q) . sMsUnions) +getPat (PRec _ q ps) = liftM (second (insQName q) . sMsUnions) $ mapM getPField ps -- @-pattern -getPat (PAsPat n p) = liftM (sMsMerge (onlyVar n)) $ getPat p +getPat (PAsPat _ n p) = liftM (sMsMerge (onlyVar n)) $ getPat p -- _ -getPat PWildCard = return noEnts +getPat (PWildCard _) = return noEnts -- ~pat -getPat (PIrrPat p) = getPat p +getPat (PIrrPat _ p) = getPat p -- pattern with explicit type-sig getPat (PatTypeSig _ p _) = getPat p -- View pattern (function -> constructor) [this avoids an explicit -- case statement] -getPat (PViewPat e p) = do ec <- getExp e - (pd,pc) <- getPat p - return (pd, ec `MS.union` pc) +getPat (PViewPat _ e p) = do + ec <- getExp e + (pd,pc) <- getPat p + return (pd, ec `MS.union` pc) -- HaRP... no idea now to deal with this getPat PRPat{} = return noEnts -- !foo -getPat (PBangPat p) = getPat p +getPat (PBangPat _ p) = getPat p -- The rest are XML and TH patterns getPat _ = return noEnts -getPats :: [Pat] -> PState DefCalled +getPats :: [Pat l] -> PState DefCalled getPats = liftM sMsUnions . mapM getPat -insQName :: QName -> Called -> Called +insQName :: QName l -> Called -> Called insQName qn sq = maybe sq (flip MS.insert sq) $ qName qn onlyVar :: (Named n) => n -> DefCalled @@ -548,97 +595,105 @@ onlyVar n = (S.singleton $ nameOf' n, MS.empty) -- Punned fields: not registered as variables -- Record wildcards: nothing returned -getPField :: PatField -> PState DefCalled -getPField (PFieldPat qn p) = liftM (second $ insQName qn) $ getPat p -getPField (PFieldPun n) = return (S.empty, MS.fromList . maybeToList $ qName n) -getPField PFieldWildcard = return noEnts +getPField :: PatField l -> PState DefCalled +getPField (PFieldPat _ qn p) = liftM (second $ insQName qn) $ getPat p +getPField (PFieldPun _ n) = return (S.empty, MS.fromList . maybeToList $ qName n) +getPField (PFieldWildcard _) = return noEnts -- Still have to take care of function calls here somewhere... -- Nope: trying to get the overall list of functions called here... -- and _then_ create function calls to them! -getBindings :: Binds -> PState DefCalled -getBindings (BDecls ds) = liftM sMsUnions $ mapM getDecl ds -getBindings (IPBinds is) = liftM sMsUnions $ mapM getIPBinds is +getMaybeBindings :: Maybe (Binds l) -> PState DefCalled +getMaybeBindings Nothing = return noEnts +getMaybeBindings (Just b) = getBindings b + +getBindings :: Binds l -> PState DefCalled +getBindings (BDecls _ ds) = liftM sMsUnions $ mapM getDecl ds +getBindings (IPBinds _ is) = liftM sMsUnions $ mapM getIPBinds is -getIPBinds :: IPBind -> PState DefCalled +getIPBinds :: IPBind l -> PState DefCalled getIPBinds (IPBind _ _ e) = liftM noDefs $ getExp e -getDecl :: Decl -> PState DefCalled -getDecl (FunBind ms) = liftM sMsUnions $ mapM getMatch ms +getDecl :: Decl l -> PState DefCalled +getDecl (FunBind _ ms) = liftM sMsUnions $ mapM getMatch ms getDecl (PatBind _ p r bs) = do (pd,pc) <- getPat p rc <- getRHS r - (bd,bc) <- getBindings bs + (bd,bc) <- getMaybeBindings bs let fs = MS.unions [pc, rc, bc] cs = defElsewhere fs bd return (pd, cs) getDecl _ = return noEnts -getRHS :: Rhs -> PState Called -getRHS (UnGuardedRhs e) = getExp e -getRHS (GuardedRhss grs) = liftM MS.unions $ mapM getGRhs grs +getRHS :: Rhs l -> PState Called +getRHS (UnGuardedRhs _ e) = getExp e +getRHS (GuardedRhss _ grs) = liftM MS.unions $ mapM getGRhs grs -getGRhs :: GuardedRhs -> PState Called +getGRhs :: GuardedRhs l -> PState Called getGRhs (GuardedRhs _ ss e) = do (sf,sc) <- getStmts ss ec <- getExp e return $ defElsewhere' sf (sc `MS.union` ec) -- Gah, this might be wrong... -getExp :: Exp -> PState Called -getExp (Var qn) = return $ maybeEnt qn +getExp :: Exp l -> PState Called +getExp (Var _ qn) = return $ maybeEnt qn getExp IPVar{} = return MS.empty -getExp (Con qn) = return $ maybeEnt qn +getExp (Con _ qn) = return $ maybeEnt qn getExp Lit{} = return MS.empty -getExp (InfixApp e1 o e2) = do e1' <- getExp e1 - e2' <- getExp e2 - let o' = maybeEnt o - return $ e1' `MS.union` e2' `MS.union` o' -getExp (App ef vf) = liftM2 MS.union (getExp ef) (getExp vf) -getExp (NegApp e) = getExp e +getExp (InfixApp _ e1 o e2) = do + e1' <- getExp e1 + e2' <- getExp e2 + let o' = maybeEnt o + return $ e1' `MS.union` e2' `MS.union` o' +getExp (App _ ef vf) = liftM2 MS.union (getExp ef) (getExp vf) +getExp (NegApp _ e) = getExp e getExp (Lambda _ ps e) = do (pd,pc) <- getPats ps e' <- getExp e return $ defElsewhere' pd $ MS.union pc e' -getExp (Let bs e) = do (bd,bc) <- getBindings bs - e' <- getExp e - return $ defElsewhere' bd (MS.union bc e') -getExp (If i t e) = getExps [i,t,e] -getExp (Case e as) = do e' <- getExp e - as' <- mapM getAlt as - return $ MS.unions (e':as') -getExp (Do ss) = chainedCalled $ map getStmt ss -getExp (MDo ss) = liftM (uncurry defElsewhere') $ getStmts ss -getExp (Tuple _ es) = getExps es -getExp (TupleSection _ mes) = getExps $ catMaybes mes -getExp (List es) = getExps es -getExp (Paren e) = getExp e -getExp (LeftSection e o) = liftM (MS.union (maybeEnt o)) $ getExp e -getExp (RightSection o e) = liftM (MS.union (maybeEnt o)) $ getExp e -getExp (RecConstr qn fus) = liftM (MS.union (maybeEnt qn)) $ getFUpdates fus -getExp (RecUpdate e fus) = liftM2 MS.union (getExp e) (getFUpdates fus) -getExp (EnumFrom e) = getExp e -getExp (EnumFromTo e1 e2) = liftM2 MS.union (getExp e1) (getExp e2) -getExp (EnumFromThen e1 e2) = liftM2 MS.union (getExp e1) (getExp e2) -getExp (EnumFromThenTo e1 e2 e3) = liftM2 MS.union (getExp e1) +getExp (Let _ bs e) = do + (bd,bc) <- getBindings bs + e' <- getExp e + return $ defElsewhere' bd (MS.union bc e') +getExp (If _ i t e) = getExps [i,t,e] +getExp (Case _ e as) = do + e' <- getExp e + as' <- mapM getAlt as + return $ MS.unions (e':as') +getExp (Do _ ss) = chainedCalled $ map getStmt ss +getExp (MDo _ ss) = liftM (uncurry defElsewhere') $ getStmts ss +getExp (Tuple _ _ es) = getExps es +getExp (TupleSection _ _ mes) = getExps $ catMaybes mes +getExp (List _ es) = getExps es +getExp (Paren _ e) = getExp e +getExp (LeftSection _ e o) = liftM (MS.union (maybeEnt o)) $ getExp e +getExp (RightSection _ o e) = liftM (MS.union (maybeEnt o)) $ getExp e +getExp (RecConstr _ qn fus) = liftM (MS.union (maybeEnt qn)) $ getFUpdates fus +getExp (RecUpdate _ e fus) = liftM2 MS.union (getExp e) (getFUpdates fus) +getExp (EnumFrom _ e) = getExp e +getExp (EnumFromTo _ e1 e2) = liftM2 MS.union (getExp e1) (getExp e2) +getExp (EnumFromThen _ e1 e2) = liftM2 MS.union (getExp e1) (getExp e2) +getExp (EnumFromThenTo _ e1 e2 e3) = liftM2 MS.union (getExp e1) $ liftM2 MS.union (getExp e2) (getExp e3) -getExp (ListComp e qss) = liftM2 MS.union (getExp e) $ getQStmts qss -getExp (ParComp e qsss) = liftM2 MS.union (getExp e) . liftM MS.unions +getExp (ListComp _ e qss) = liftM2 MS.union (getExp e) $ getQStmts qss +getExp (ParComp _ e qsss) = liftM2 MS.union (getExp e) . liftM MS.unions $ mapM getQStmts qsss getExp (ExpTypeSig _ e _) = getExp e -getExp (VarQuote qn) = return $ maybeEnt qn -getExp (Proc _ p e) = do (pd,pc) <- getPat p - c <- getExp e - return $ pc `MS.union` defElsewhere c pd -getExp (RightArrApp e1 e2) = liftM2 MS.union (getExp e1) (getExp e2) -getExp (LeftArrApp e1 e2) = liftM2 MS.union (getExp e1) (getExp e2) -getExp (RightArrHighApp e1 e2) = liftM2 MS.union (getExp e1) (getExp e2) -getExp (LeftArrHighApp e1 e2) = liftM2 MS.union (getExp e1) (getExp e2) +getExp (VarQuote _ qn) = return $ maybeEnt qn +getExp (Proc _ p e) = do + (pd,pc) <- getPat p + c <- getExp e + return $ pc `MS.union` defElsewhere c pd +getExp (RightArrApp _ e1 e2) = liftM2 MS.union (getExp e1) (getExp e2) +getExp (LeftArrApp _ e1 e2) = liftM2 MS.union (getExp e1) (getExp e2) +getExp (RightArrHighApp _ e1 e2) = liftM2 MS.union (getExp e1) (getExp e2) +getExp (LeftArrHighApp _ e1 e2) = liftM2 MS.union (getExp e1) (getExp e2) -- Everything else is TH, XML or Pragmas getExp _ = return MS.empty -getExps :: [Exp] -> PState Called +getExps :: [Exp l] -> PState Called getExps = liftM MS.unions . mapM getExp chainedCalled :: [PState DefCalled] -> PState Called @@ -647,43 +702,43 @@ chainedCalled = foldrM go MS.empty go s cs = liftM (rmVars cs) s rmVars cs (d,c) = defElsewhere cs d `MS.union` c -getQStmt :: QualStmt -> PState DefCalled -getQStmt (QualStmt s) = getStmt s -getQStmt (ThenTrans e) = liftM noDefs $ getExp e -getQStmt (ThenBy e1 e2) = liftM noDefs $ liftM2 MS.union (getExp e1) (getExp e2) -getQStmt (GroupBy e) = liftM noDefs $ getExp e -getQStmt (GroupUsing e) = liftM noDefs $ getExp e -getQStmt (GroupByUsing e1 e2) = liftM noDefs +getQStmt :: QualStmt l -> PState DefCalled +getQStmt (QualStmt _ s) = getStmt s +getQStmt (ThenTrans _ e) = liftM noDefs $ getExp e +getQStmt (ThenBy _ e1 e2) = liftM noDefs $ liftM2 MS.union (getExp e1) (getExp e2) +getQStmt (GroupBy _ e) = liftM noDefs $ getExp e +getQStmt (GroupUsing _ e) = liftM noDefs $ getExp e +getQStmt (GroupByUsing _ e1 e2) = liftM noDefs $ liftM2 MS.union (getExp e1) (getExp e2) -getQStmts :: [QualStmt] -> PState Called +getQStmts :: [QualStmt l] -> PState Called getQStmts = chainedCalled . map getQStmt -getFUpdates :: [FieldUpdate] -> PState Called +getFUpdates :: [FieldUpdate l] -> PState Called getFUpdates = liftM MS.unions . mapM getFUpdate -getFUpdate :: FieldUpdate -> PState Called -getFUpdate (FieldUpdate qn e) = liftM (MS.union (maybeEnt qn)) $ getExp e -getFUpdate (FieldPun n) = return . MS.fromList . maybeToList $ qName n +getFUpdate :: FieldUpdate l -> PState Called +getFUpdate (FieldUpdate _ qn e) = liftM (MS.union (maybeEnt qn)) $ getExp e +getFUpdate (FieldPun _ n) = return . MS.fromList . maybeToList $ qName n getFUpdate _ = return MS.empty -getAlt :: Alt -> PState Called +getAlt :: Alt l -> PState Called getAlt (Alt _ p gas bs) = do (pd,pc) <- getPat p gc <- getRHS gas - (bd,bc) <- getBindings bs + (bd,bc) <- getMaybeBindings bs let d = pd `S.union` bd c = pc `MS.union` gc `MS.union` bc return $ defElsewhere c d -getStmt :: Stmt -> PState DefCalled +getStmt :: Stmt l -> PState DefCalled getStmt (Generator _ p e) = do (pf,pc) <- getPat p ec <- getExp e return (pf, defElsewhere' pf (MS.union pc ec)) -getStmt (Qualifier e) = liftM noDefs $ getExp e -getStmt (LetStmt bs) = getBindings bs -getStmt (RecStmt ss) = getStmts ss +getStmt (Qualifier _ e) = liftM noDefs $ getExp e +getStmt (LetStmt _ bs) = getBindings bs +getStmt (RecStmt _ ss) = getStmts ss -getStmts :: [Stmt] -> PState DefCalled +getStmts :: [Stmt l] -> PState DefCalled getStmts = liftM sMsUnions . mapM getStmt noDefs :: Called -> DefCalled @@ -700,35 +755,35 @@ noEnts = (S.empty, MS.empty) class Named a where nameOf :: a -> String -instance Named Name where - nameOf (Ident n) = n - nameOf (Symbol n) = n +instance Named (Name l) where + nameOf (Ident _ n) = n + nameOf (Symbol _ n) = n nameOf' :: (Named n) => n -> QEntityName nameOf' = (,) Nothing . nameOf -instance Named CName where - nameOf (VarName n) = nameOf n - nameOf (ConName n) = nameOf n +instance Named (CName l) where + nameOf (VarName _ n) = nameOf n + nameOf (ConName _ n) = nameOf n -instance Named ModuleName where - nameOf (ModuleName m) = m +instance Named (ModuleName l) where + nameOf (ModuleName _ m) = m -- | Create the 'ModName'. -createModule' :: ModuleName -> ModName +createModule' :: ModuleName l -> ModName createModule' = createModule . nameOf class QNamed a where qName :: a -> Maybe QEntityName -instance QNamed QName where - qName (Qual m n) = Just (Just $ nameOf m, nameOf n) - qName (UnQual n) = Just (Nothing, nameOf n) +instance QNamed (QName l) where + qName (Qual _ m n) = Just (Just $ nameOf m, nameOf n) + qName (UnQual _ n) = Just (Nothing, nameOf n) qName Special{} = Nothing -instance QNamed QOp where - qName (QVarOp qn) = qName qn - qName (QConOp qn) = qName qn +instance QNamed (QOp l) where + qName (QVarOp _ qn) = qName qn + qName (QConOp _ qn) = qName qn sMsUnions :: (Ord a, Ord b) => [(Set a, MultiSet b)] -> (Set a, MultiSet b) sMsUnions = (S.unions *** MS.unions) . unzip diff --git a/Parsing/State.hs b/SourceGraph/Parsing/State.hs similarity index 97% rename from Parsing/State.hs rename to SourceGraph/Parsing/State.hs index 04d5648..bfa2769 100644 --- a/Parsing/State.hs +++ b/SourceGraph/Parsing/State.hs @@ -29,7 +29,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Customised State Monad for parsing Haskell code. -} -module Parsing.State +module SourceGraph.Parsing.State ( PState , runPState , get @@ -41,7 +41,7 @@ module Parsing.State , getModuleName ) where -import Parsing.Types +import SourceGraph.Parsing.Types import Control.Monad.RWS diff --git a/Parsing/Types.hs b/SourceGraph/Parsing/Types.hs similarity index 99% rename from Parsing/Types.hs rename to SourceGraph/Parsing/Types.hs index 07b4631..f58b692 100644 --- a/Parsing/Types.hs +++ b/SourceGraph/Parsing/Types.hs @@ -29,7 +29,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Types for parsing Haskell modules. -} -module Parsing.Types where +module SourceGraph.Parsing.Types where import Data.Graph.Analysis.Types( ClusterLabel(..) , Rel) From 3477040a841239405f0f6b955fbee753bb6e9566 Mon Sep 17 00:00:00 2001 From: Hugo Pacheco Date: Fri, 14 Sep 2018 17:28:20 +0100 Subject: [PATCH 2/7] better namespace --- .../Haskell/SourceGraph}/Analyse.hs | 12 ++-- .../Haskell/SourceGraph}/Analyse/Colors.hs | 2 +- .../SourceGraph}/Analyse/Everything.hs | 10 ++-- .../Haskell/SourceGraph}/Analyse/GraphRepr.hs | 8 +-- .../Haskell/SourceGraph}/Analyse/Imports.hs | 10 ++-- .../Haskell/SourceGraph}/Analyse/Module.hs | 10 ++-- .../Haskell/SourceGraph}/Analyse/Utils.hs | 2 +- .../Haskell/SourceGraph}/Analyse/Visualise.hs | 10 ++-- .../Haskell/SourceGraph}/CabalInfo.hs | 2 +- .../Haskell/SourceGraph}/Parsing.hs | 6 +- .../SourceGraph}/Parsing/ParseModule.hs | 6 +- .../Haskell/SourceGraph}/Parsing/State.hs | 4 +- .../Haskell/SourceGraph}/Parsing/Types.hs | 2 +- SourceGraph.cabal | 56 +++++++++---------- SourceGraph/Main.hs => SourceGraph.hs | 8 +-- 15 files changed, 73 insertions(+), 75 deletions(-) rename {SourceGraph => Language/Haskell/SourceGraph}/Analyse.hs (96%) rename {SourceGraph => Language/Haskell/SourceGraph}/Analyse/Colors.hs (96%) rename {SourceGraph => Language/Haskell/SourceGraph}/Analyse/Everything.hs (97%) rename {SourceGraph => Language/Haskell/SourceGraph}/Analyse/GraphRepr.hs (97%) rename {SourceGraph => Language/Haskell/SourceGraph}/Analyse/Imports.hs (95%) rename {SourceGraph => Language/Haskell/SourceGraph}/Analyse/Module.hs (96%) rename {SourceGraph => Language/Haskell/SourceGraph}/Analyse/Utils.hs (98%) rename {SourceGraph => Language/Haskell/SourceGraph}/Analyse/Visualise.hs (97%) rename {SourceGraph => Language/Haskell/SourceGraph}/CabalInfo.hs (98%) rename {SourceGraph => Language/Haskell/SourceGraph}/Parsing.hs (97%) rename {SourceGraph => Language/Haskell/SourceGraph}/Parsing/ParseModule.hs (99%) rename {SourceGraph => Language/Haskell/SourceGraph}/Parsing/State.hs (96%) rename {SourceGraph => Language/Haskell/SourceGraph}/Parsing/Types.hs (99%) rename SourceGraph/Main.hs => SourceGraph.hs (97%) diff --git a/SourceGraph/Analyse.hs b/Language/Haskell/SourceGraph/Analyse.hs similarity index 96% rename from SourceGraph/Analyse.hs rename to Language/Haskell/SourceGraph/Analyse.hs index 84e4c9b..138f61d 100644 --- a/SourceGraph/Analyse.hs +++ b/Language/Haskell/SourceGraph/Analyse.hs @@ -27,13 +27,13 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Analyse Haskell software -} -module SourceGraph.Analyse(analyse, sgLegend) where +module Language.Haskell.SourceGraph.Analyse(analyse, sgLegend) where -import SourceGraph.Analyse.Module -import SourceGraph.Analyse.Imports -import SourceGraph.Analyse.Everything -import SourceGraph.Analyse.Colors -import SourceGraph.Parsing.Types +import Language.Haskell.SourceGraph.Analyse.Module +import Language.Haskell.SourceGraph.Analyse.Imports +import Language.Haskell.SourceGraph.Analyse.Everything +import Language.Haskell.SourceGraph.Analyse.Colors +import Language.Haskell.SourceGraph.Parsing.Types import Data.Graph.Analysis hiding (Bold) import qualified Data.Graph.Analysis.Reporting as R (DocInline(Bold)) diff --git a/SourceGraph/Analyse/Colors.hs b/Language/Haskell/SourceGraph/Analyse/Colors.hs similarity index 96% rename from SourceGraph/Analyse/Colors.hs rename to Language/Haskell/SourceGraph/Analyse/Colors.hs index 7de3dab..2f4cc9b 100644 --- a/SourceGraph/Analyse/Colors.hs +++ b/Language/Haskell/SourceGraph/Analyse/Colors.hs @@ -27,7 +27,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Utility functions and types for analysis. -} -module SourceGraph.Analyse.Colors where +module Language.Haskell.SourceGraph.Analyse.Colors where import Data.GraphViz.Attributes diff --git a/SourceGraph/Analyse/Everything.hs b/Language/Haskell/SourceGraph/Analyse/Everything.hs similarity index 97% rename from SourceGraph/Analyse/Everything.hs rename to Language/Haskell/SourceGraph/Analyse/Everything.hs index 0697768..10efd08 100644 --- a/SourceGraph/Analyse/Everything.hs +++ b/Language/Haskell/SourceGraph/Analyse/Everything.hs @@ -27,12 +27,12 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Analysis of the entire overall piece of software. -} -module SourceGraph.Analyse.Everything(analyseEverything) where +module Language.Haskell.SourceGraph.Analyse.Everything(analyseEverything) where -import SourceGraph.Parsing.Types -import SourceGraph.Analyse.Utils -import SourceGraph.Analyse.GraphRepr -import SourceGraph.Analyse.Visualise +import Language.Haskell.SourceGraph.Parsing.Types +import Language.Haskell.SourceGraph.Analyse.Utils +import Language.Haskell.SourceGraph.Analyse.GraphRepr +import Language.Haskell.SourceGraph.Analyse.Visualise import Data.Graph.Analysis diff --git a/SourceGraph/Analyse/GraphRepr.hs b/Language/Haskell/SourceGraph/Analyse/GraphRepr.hs similarity index 97% rename from SourceGraph/Analyse/GraphRepr.hs rename to Language/Haskell/SourceGraph/Analyse/GraphRepr.hs index 17026e3..fecc463 100644 --- a/SourceGraph/Analyse/GraphRepr.hs +++ b/Language/Haskell/SourceGraph/Analyse/GraphRepr.hs @@ -29,7 +29,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Interacting with GraphData from Graphalyze. -} -module SourceGraph.Analyse.GraphRepr +module Language.Haskell.SourceGraph.Analyse.GraphRepr ( -- * General stuff GData(..) , mapData @@ -62,9 +62,9 @@ module SourceGraph.Analyse.GraphRepr , ModGraph ) where -import SourceGraph.Analyse.Colors -import SourceGraph.Analyse.Utils -import SourceGraph.Parsing.Types +import Language.Haskell.SourceGraph.Analyse.Colors +import Language.Haskell.SourceGraph.Analyse.Utils +import Language.Haskell.SourceGraph.Parsing.Types import Data.Graph.Analysis import Data.Graph.Inductive diff --git a/SourceGraph/Analyse/Imports.hs b/Language/Haskell/SourceGraph/Analyse/Imports.hs similarity index 95% rename from SourceGraph/Analyse/Imports.hs rename to Language/Haskell/SourceGraph/Analyse/Imports.hs index 08a9b1c..b0b43c7 100644 --- a/SourceGraph/Analyse/Imports.hs +++ b/Language/Haskell/SourceGraph/Analyse/Imports.hs @@ -27,12 +27,12 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Analysis of Haskell module importing. -} -module SourceGraph.Analyse.Imports (analyseImports) where +module Language.Haskell.SourceGraph.Analyse.Imports (analyseImports) where -import SourceGraph.Parsing.Types -import SourceGraph.Analyse.Utils -import SourceGraph.Analyse.GraphRepr -import SourceGraph.Analyse.Visualise +import Language.Haskell.SourceGraph.Parsing.Types +import Language.Haskell.SourceGraph.Analyse.Utils +import Language.Haskell.SourceGraph.Analyse.GraphRepr +import Language.Haskell.SourceGraph.Analyse.Visualise import Data.Graph.Analysis diff --git a/SourceGraph/Analyse/Module.hs b/Language/Haskell/SourceGraph/Analyse/Module.hs similarity index 96% rename from SourceGraph/Analyse/Module.hs rename to Language/Haskell/SourceGraph/Analyse/Module.hs index da06d1f..1ca12d7 100644 --- a/SourceGraph/Analyse/Module.hs +++ b/Language/Haskell/SourceGraph/Analyse/Module.hs @@ -27,12 +27,12 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Analysis of Haskell modules. -} -module SourceGraph.Analyse.Module(analyseModules) where +module Language.Haskell.SourceGraph.Analyse.Module(analyseModules) where -import SourceGraph.Parsing.Types -import SourceGraph.Analyse.Utils -import SourceGraph.Analyse.GraphRepr -import SourceGraph.Analyse.Visualise +import Language.Haskell.SourceGraph.Parsing.Types +import Language.Haskell.SourceGraph.Analyse.Utils +import Language.Haskell.SourceGraph.Analyse.GraphRepr +import Language.Haskell.SourceGraph.Analyse.Visualise import Data.Graph.Analysis diff --git a/SourceGraph/Analyse/Utils.hs b/Language/Haskell/SourceGraph/Analyse/Utils.hs similarity index 98% rename from SourceGraph/Analyse/Utils.hs rename to Language/Haskell/SourceGraph/Analyse/Utils.hs index 2b67b7a..793cc4c 100644 --- a/SourceGraph/Analyse/Utils.hs +++ b/Language/Haskell/SourceGraph/Analyse/Utils.hs @@ -27,7 +27,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Utility functions and types for analysis. -} -module SourceGraph.Analyse.Utils where +module Language.Haskell.SourceGraph.Analyse.Utils where import Data.Graph.Analysis hiding (Bold) diff --git a/SourceGraph/Analyse/Visualise.hs b/Language/Haskell/SourceGraph/Analyse/Visualise.hs similarity index 97% rename from SourceGraph/Analyse/Visualise.hs rename to Language/Haskell/SourceGraph/Analyse/Visualise.hs index 8e04a3e..e2c63cd 100644 --- a/SourceGraph/Analyse/Visualise.hs +++ b/Language/Haskell/SourceGraph/Analyse/Visualise.hs @@ -27,12 +27,12 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Utility functions and types for analysis. -} -module SourceGraph.Analyse.Visualise where +module Language.Haskell.SourceGraph.Analyse.Visualise where -import SourceGraph.Analyse.Colors -import SourceGraph.Analyse.GraphRepr -import SourceGraph.Analyse.Utils -import SourceGraph.Parsing.Types +import Language.Haskell.SourceGraph.Analyse.Colors +import Language.Haskell.SourceGraph.Analyse.GraphRepr +import Language.Haskell.SourceGraph.Analyse.Utils +import Language.Haskell.SourceGraph.Parsing.Types import Data.Graph.Analysis hiding (Bold) import Data.GraphViz diff --git a/SourceGraph/CabalInfo.hs b/Language/Haskell/SourceGraph/CabalInfo.hs similarity index 98% rename from SourceGraph/CabalInfo.hs rename to Language/Haskell/SourceGraph/CabalInfo.hs index aa29aaf..065b322 100644 --- a/SourceGraph/CabalInfo.hs +++ b/Language/Haskell/SourceGraph/CabalInfo.hs @@ -32,7 +32,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Used to parse and obtain information from the provided Cabal file. -} -module SourceGraph.CabalInfo(parseCabal) where +module Language.Haskell.SourceGraph.CabalInfo(parseCabal) where import Distribution.Compiler (CompilerInfo) import Distribution.ModuleName (toFilePath) diff --git a/SourceGraph/Parsing.hs b/Language/Haskell/SourceGraph/Parsing.hs similarity index 97% rename from SourceGraph/Parsing.hs rename to Language/Haskell/SourceGraph/Parsing.hs index b100273..28c740b 100644 --- a/SourceGraph/Parsing.hs +++ b/Language/Haskell/SourceGraph/Parsing.hs @@ -27,10 +27,10 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Parse the given Haskell modules. -} -module SourceGraph.Parsing where +module Language.Haskell.SourceGraph.Parsing where -import SourceGraph.Parsing.Types -import SourceGraph.Parsing.ParseModule +import Language.Haskell.SourceGraph.Parsing.Types +import Language.Haskell.SourceGraph.Parsing.ParseModule import Language.Haskell.Exts(parseFileContentsWithMode) import Language.Haskell.Exts.Parser( ParseMode(..) diff --git a/SourceGraph/Parsing/ParseModule.hs b/Language/Haskell/SourceGraph/Parsing/ParseModule.hs similarity index 99% rename from SourceGraph/Parsing/ParseModule.hs rename to Language/Haskell/SourceGraph/Parsing/ParseModule.hs index d15bffc..efa0d7c 100644 --- a/SourceGraph/Parsing/ParseModule.hs +++ b/Language/Haskell/SourceGraph/Parsing/ParseModule.hs @@ -29,10 +29,10 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Parse a Haskell module. -} -module SourceGraph.Parsing.ParseModule(parseModule) where +module Language.Haskell.SourceGraph.Parsing.ParseModule(parseModule) where -import SourceGraph.Parsing.State -import SourceGraph.Parsing.Types +import Language.Haskell.SourceGraph.Parsing.State +import Language.Haskell.SourceGraph.Parsing.Types import Language.Haskell.Exts.Pretty import Language.Haskell.Exts.Syntax diff --git a/SourceGraph/Parsing/State.hs b/Language/Haskell/SourceGraph/Parsing/State.hs similarity index 96% rename from SourceGraph/Parsing/State.hs rename to Language/Haskell/SourceGraph/Parsing/State.hs index bfa2769..469824c 100644 --- a/SourceGraph/Parsing/State.hs +++ b/Language/Haskell/SourceGraph/Parsing/State.hs @@ -29,7 +29,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Customised State Monad for parsing Haskell code. -} -module SourceGraph.Parsing.State +module Language.Haskell.SourceGraph.Parsing.State ( PState , runPState , get @@ -41,7 +41,7 @@ module SourceGraph.Parsing.State , getModuleName ) where -import SourceGraph.Parsing.Types +import Language.Haskell.SourceGraph.Parsing.Types import Control.Monad.RWS diff --git a/SourceGraph/Parsing/Types.hs b/Language/Haskell/SourceGraph/Parsing/Types.hs similarity index 99% rename from SourceGraph/Parsing/Types.hs rename to Language/Haskell/SourceGraph/Parsing/Types.hs index f58b692..8b93054 100644 --- a/SourceGraph/Parsing/Types.hs +++ b/Language/Haskell/SourceGraph/Parsing/Types.hs @@ -29,7 +29,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Types for parsing Haskell modules. -} -module SourceGraph.Parsing.Types where +module Language.Haskell.SourceGraph.Parsing.Types where import Data.Graph.Analysis.Types( ClusterLabel(..) , Rel) diff --git a/SourceGraph.cabal b/SourceGraph.cabal index 107af5e..270dc38 100644 --- a/SourceGraph.cabal +++ b/SourceGraph.cabal @@ -49,22 +49,20 @@ Source-Repository head Location: https://github.com/ivan-m/SourceGraph Library - exposed-modules: - SourceGraph.Analyse.Colors - SourceGraph.Analyse.Everything - SourceGraph.Analyse.GraphRepr - SourceGraph.Analyse.Imports - SourceGraph.Analyse.Module - SourceGraph.Analyse.Utils - SourceGraph.Analyse.Visualise - SourceGraph.Parsing.ParseModule - SourceGraph.Parsing.State - SourceGraph.Parsing.Types - SourceGraph.Analyse - SourceGraph.Parsing + exposed-modules: Language.Haskell.SourceGraph.Analyse.Colors, + Language.Haskell.SourceGraph.Analyse.Everything, + Language.Haskell.SourceGraph.Analyse.GraphRepr, + Language.Haskell.SourceGraph.Analyse.Imports, + Language.Haskell.SourceGraph.Analyse.Module, + Language.Haskell.SourceGraph.Analyse.Utils, + Language.Haskell.SourceGraph.Analyse.Visualise, + Language.Haskell.SourceGraph.Parsing.ParseModule, + Language.Haskell.SourceGraph.Parsing.State, + Language.Haskell.SourceGraph.Parsing.Types, + Language.Haskell.SourceGraph.Analyse, + Language.Haskell.SourceGraph.Parsing Hs-source-dirs: . - Other-Modules: - Paths_SourceGraph + Other-Modules: Paths_SourceGraph Build-Depends: base == 4.*, containers, multiset, @@ -80,20 +78,20 @@ Library Executable SourceGraph { - Main-Is: SourceGraph/Main.hs - Other-Modules: SourceGraph.CabalInfo, - SourceGraph.Parsing, - SourceGraph.Parsing.ParseModule, - SourceGraph.Parsing.State, - SourceGraph.Parsing.Types, - SourceGraph.Analyse, - SourceGraph.Analyse.Utils, - SourceGraph.Analyse.Colors, - SourceGraph.Analyse.GraphRepr, - SourceGraph.Analyse.Visualise, - SourceGraph.Analyse.Module, - SourceGraph.Analyse.Imports, - SourceGraph.Analyse.Everything, + Main-Is: SourceGraph.hs + Other-Modules: Language.Haskell.SourceGraph.CabalInfo, + Language.Haskell.SourceGraph.Parsing, + Language.Haskell.SourceGraph.Parsing.ParseModule, + Language.Haskell.SourceGraph.Parsing.State, + Language.Haskell.SourceGraph.Parsing.Types, + Language.Haskell.SourceGraph.Analyse, + Language.Haskell.SourceGraph.Analyse.Utils, + Language.Haskell.SourceGraph.Analyse.Colors, + Language.Haskell.SourceGraph.Analyse.GraphRepr, + Language.Haskell.SourceGraph.Analyse.Visualise, + Language.Haskell.SourceGraph.Analyse.Module, + Language.Haskell.SourceGraph.Analyse.Imports, + Language.Haskell.SourceGraph.Analyse.Everything, Paths_SourceGraph Ghc-Options: -Wall Ghc-Prof-Options: -prof diff --git a/SourceGraph/Main.hs b/SourceGraph.hs similarity index 97% rename from SourceGraph/Main.hs rename to SourceGraph.hs index 91f6937..ba93810 100644 --- a/SourceGraph/Main.hs +++ b/SourceGraph.hs @@ -30,10 +30,10 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} module Main where -import SourceGraph.CabalInfo -import SourceGraph.Parsing -import SourceGraph.Parsing.Types(nameOfModule,ParsedModules,ModName(..)) -import SourceGraph.Analyse +import Language.Haskell.SourceGraph.CabalInfo +import Language.Haskell.SourceGraph.Parsing +import Language.Haskell.SourceGraph.Parsing.Types(nameOfModule,ParsedModules,ModName(..)) +import Language.Haskell.SourceGraph.Analyse import Data.Graph.Analysis import Data.Graph.Analysis.Reporting.Pandoc From 9c84a82d471133923da3f8a6525a3dcf2f6a2c7d Mon Sep 17 00:00:00 2001 From: Hugo Pacheco Date: Fri, 14 Sep 2018 17:52:22 +0100 Subject: [PATCH 3/7] export codeToGraph --- Language/Haskell/SourceGraph/Analyse/Everything.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Language/Haskell/SourceGraph/Analyse/Everything.hs b/Language/Haskell/SourceGraph/Analyse/Everything.hs index 10efd08..694412b 100644 --- a/Language/Haskell/SourceGraph/Analyse/Everything.hs +++ b/Language/Haskell/SourceGraph/Analyse/Everything.hs @@ -27,7 +27,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Analysis of the entire overall piece of software. -} -module Language.Haskell.SourceGraph.Analyse.Everything(analyseEverything) where +module Language.Haskell.SourceGraph.Analyse.Everything(analyseEverything,codeToGraph) where import Language.Haskell.SourceGraph.Parsing.Types import Language.Haskell.SourceGraph.Analyse.Utils From d6a5ad2474c5962f75316421ec29e4f70ba02950 Mon Sep 17 00:00:00 2001 From: Hugo Pacheco Date: Fri, 14 Sep 2018 17:54:15 +0100 Subject: [PATCH 4/7] export moduleToGraph --- Language/Haskell/SourceGraph/Analyse/Module.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Language/Haskell/SourceGraph/Analyse/Module.hs b/Language/Haskell/SourceGraph/Analyse/Module.hs index 1ca12d7..337837f 100644 --- a/Language/Haskell/SourceGraph/Analyse/Module.hs +++ b/Language/Haskell/SourceGraph/Analyse/Module.hs @@ -27,7 +27,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Analysis of Haskell modules. -} -module Language.Haskell.SourceGraph.Analyse.Module(analyseModules) where +module Language.Haskell.SourceGraph.Analyse.Module(analyseModules,moduleToGraph) where import Language.Haskell.SourceGraph.Parsing.Types import Language.Haskell.SourceGraph.Analyse.Utils From a43c0157a1c91218849446b92d13e2cf43589f39 Mon Sep 17 00:00:00 2001 From: Hugo Pacheco Date: Fri, 4 Jan 2019 23:52:49 +0000 Subject: [PATCH 5/7] 8.6 --- SourceGraph.cabal | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/SourceGraph.cabal b/SourceGraph.cabal index 270dc38..2e0ec13 100644 --- a/SourceGraph.cabal +++ b/SourceGraph.cabal @@ -70,11 +70,11 @@ Library random, directory, mtl, - fgl == 5.6.*, + fgl >= 5.6, Graphalyze >= 0.15, - graphviz >= 2999.20 && < 2999.21, - Cabal == 2.2.*, - haskell-src-exts == 1.20.* + graphviz >= 2999.20 , + Cabal >= 2.2, + haskell-src-exts >= 1.20 Executable SourceGraph { @@ -103,9 +103,9 @@ Executable SourceGraph { random, directory, mtl, - fgl == 5.6.*, + fgl >= 5.6, Graphalyze >= 0.15, - graphviz >= 2999.20 && < 2999.21, - Cabal == 2.2.*, - haskell-src-exts == 1.20.* + graphviz >= 2999.20 , + Cabal >= 2.2, + haskell-src-exts >= 1.20 } From e61c466d1b6b53accf14d37ac43b2598319d0665 Mon Sep 17 00:00:00 2001 From: Hugo Pacheco Date: Wed, 11 Sep 2019 01:31:37 +0100 Subject: [PATCH 6/7] sg --- Language/Haskell/SourceGraph/Parsing/ParseModule.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Language/Haskell/SourceGraph/Parsing/ParseModule.hs b/Language/Haskell/SourceGraph/Parsing/ParseModule.hs index efa0d7c..aa3b793 100644 --- a/Language/Haskell/SourceGraph/Parsing/ParseModule.hs +++ b/Language/Haskell/SourceGraph/Parsing/ParseModule.hs @@ -338,7 +338,7 @@ addConstructor d (RecDecl _ n fd) = do addGConstructors :: ModName -> DataType -> [GadtDecl l] -> EntityLookup addGConstructors m d = mkEl . map addGConst where - addGConst (GadtDecl _ n _ _) = Ent m (nameOf n) (Constructor d) + addGConst (GadtDecl _ n _ _ _ _) = Ent m (nameOf n) (Constructor d) -- ----------------------------------------------------------------------------- -- Class declaration From 8e4bcb74fad45deb2aecb5a9a635ba12b9c1d0e8 Mon Sep 17 00:00:00 2001 From: Hugo Pacheco Date: Wed, 11 Sep 2019 15:28:03 +0100 Subject: [PATCH 7/7] versions --- SourceGraph.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/SourceGraph.cabal b/SourceGraph.cabal index 2e0ec13..931a924 100644 --- a/SourceGraph.cabal +++ b/SourceGraph.cabal @@ -74,7 +74,7 @@ Library Graphalyze >= 0.15, graphviz >= 2999.20 , Cabal >= 2.2, - haskell-src-exts >= 1.20 + haskell-src-exts >= 1.21 Executable SourceGraph {