From f53b960b8894beebfe8a339a0679491c020f3a07 Mon Sep 17 00:00:00 2001 From: James Michael DuPont Date: Sat, 9 Dec 2017 16:26:06 -0500 Subject: [PATCH] broken but working somehow --- Main.hs | 51 +++++++++++++++++++++++++++++++++++++++++----- hackage-diff.cabal | 6 +++--- stack.yaml | 3 ++- 3 files changed, 51 insertions(+), 9 deletions(-) diff --git a/Main.hs b/Main.hs index 8cf826c..753710c 100644 --- a/Main.hs +++ b/Main.hs @@ -569,7 +569,7 @@ computeDiffParseHaskell ComputeParams { .. } = do return $ comparePackageModules mListA mListB -- Parse a Haskell module interface using haskell-src-exts and cpphs -parseModule :: FilePath -> IO (Either String Module) +--parseModule :: FilePath -> IO (Either String ) parseModule modPath = runExceptT $ do (liftIO $ doesFileExist modPath) >>= flip unless (throwError $ "Can't open source file '" ++ modPath ++ "'") @@ -590,10 +590,50 @@ parseModule modPath = runExceptT $ do Right (E.ParseOk parsedModule) -> return parsedModule -type PackageModuleList = [(String, Maybe Module)] +--PackageModuleList :: [(String, Maybe (Module SrcSpanInfo))] -> PackageModuleList l + +newtype PackageModuleList l = PackageModuleList [(String, Maybe (Module SrcSpanInfo ))] +-- Maybe ( +-- ModuleHead ( +-- ModuleName(l String), +-- Maybe (WarningText), +-- Maybe (ExportSpecList), +-- ModuleHead) +-- ), +-- [ModulePragma ], +-- [ImportDecl ], +-- [Decl ], +-- Module +-- ) )) ]) +--type PackageModuleList = [(String, Maybe (Module )) ] + +moduleExports :: Module SrcSpanInfo -> [SrcSpan] +moduleExports x = + case x of + Module mh _ _ _ _ -> --exportSpec + case mh of + SrcSpanInfo i j -> j + --the type of SrcSpanInfo is : + -- SrcSpanInfo :: SrcSpan -> [SrcSpan] -> SrcSpanInfo + -- SrcSpan :: String -> Int -> Int -> Int -> Int -> SrcSpan + + -- ModuleHead _ _ _ foo -> + -- case foo of + -- Just x -> + -- case x of + -- ExportSpecList a exportSpec -> exportSpec + + +--Module SrcSpanInfo a -> +-- a +-- moduleExports (Module (ModuleHead _ _ _ (Just (ExportSpecList _ exportSpec)) ) _ _ _ _ ) = exportSpec +-- moduleExports _ = [] -- Compare two packages made up of readily parsed Haskell modules -comparePackageModules :: PackageModuleList -> PackageModuleList -> Diff +--comparePackageModules :: PackageModuleList -> PackageModuleList -> Diff +--modulesAdded verB verA = allANotInBBy ((==) `on` fst) verB verA + +comparePackageModules :: Eq a => [(a, Maybe (Module SrcSpanInfo))] -> [(a, Maybe (Module SrcSpanInfo))] -> [(ModuleCmp, a)] comparePackageModules verA verB = do let -- Compare lists of modules modulesAdded = allANotInBBy ((==) `on` fst) verB verA @@ -633,8 +673,9 @@ comparePackageModules verA verB = do expUnmodified = intersectBy (==) (moduleExports modA) (moduleExports modB) -- TODO: If the module does not have an export spec, we assume it exports nothing - moduleExports (Module _ _ _ _ (Just exportSpec) _ _) = exportSpec - moduleExports _ = [] + -- 1 2 3 4 + -- Module ModuleHead ModulePragma ImportDecl Decl + -- (Num [Decl l], Num [ImportDecl l], Num [ModulePragma l], Num (Maybe (ModuleHead l)), Num l) => findModule mlist mname = maybe Nothing snd $ find ((== mname) . fst) mlist in resAdded ++ resRemoved ++ resKept diff --git a/hackage-diff.cabal b/hackage-diff.cabal index fa293a6..3cafd48 100644 --- a/hackage-diff.cabal +++ b/hackage-diff.cabal @@ -84,13 +84,13 @@ executable hackage-diff -- other-extensions: build-depends: base >=4.8 && <5.0, Cabal >=1.20.0 && < 2.0, - haskell-src-exts >=1.15.0 && < 1.18, + haskell-src-exts >=1.15.0 && < 1.19, ansi-terminal >=0.6.1 && < 0.7, directory >=1.2.0 && < 1.4, filepath >=1.3.0 && < 1.5, process >=1.2.0 && < 1.5, - attoparsec >=0.12.1 && < 0.13, - cpphs >=1.18.5 && < 1.19, + attoparsec >=0.12.1 && < 0.13.2, + cpphs >=1.18.5 && < 1.21, mtl >=2.2.1 && < 2.3, text >=1.1.1 && < 1.3, HTTP >=4000.2.17 && < 4000.4, diff --git a/stack.yaml b/stack.yaml index 1b08145..0f4ce28 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,7 +1,8 @@ # For more information, see: https://github.com/commercialhaskell/stack/blob/release/doc/yaml_configuration.md # Specifies the GHC version and set of packages available (e.g., lts-3.5, nightly-2015-09-21, ghc-7.10.2) -resolver: lts-4.0 +# resolver: lts-4.0 +resolver: lts-9.17 # Local packages, usually specified by relative directory name packages: