Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

broken but working somehow #12

Open
wants to merge 1 commit into
base: master
Choose a base branch
from
Open
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
51 changes: 46 additions & 5 deletions Main.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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 ++ "'")
Expand All @@ -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
Expand Down Expand Up @@ -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

6 changes: 3 additions & 3 deletions hackage-diff.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -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,
Expand Down
3 changes: 2 additions & 1 deletion stack.yaml
Original file line number Diff line number Diff line change
@@ -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:
Expand Down