liquidhaskell-cabal 0.1.1.0 → 0.2.0.0
raw patch · 2 files changed
+131/−114 lines, 2 filesdep ~Cabal
Dependency ranges changed: Cabal
Files
- liquidhaskell-cabal.cabal +6/−7
- src/LiquidHaskell/Cabal.hs +125/−107
liquidhaskell-cabal.cabal view
@@ -1,11 +1,11 @@ name: liquidhaskell-cabal-version: 0.1.1.0-synopsis: Liquid Haskell integration for Cabal and stack+version: 0.2.0.0+synopsis: Liquid Haskell integration for Cabal and Stack description: Provides support for checking projects using Cabal and/or stack with LiquidHaskell.- + Please see the- <https://github.com/spinda/liquidhaskell-cabal/blob/0.1.1.0/README.md README>+ <https://github.com/spinda/liquidhaskell-cabal/blob/0.2.0.0/README.md README> on GitHub for setup and usage instructions. homepage: https://github.com/spinda/liquidhaskell-cabal#readme bug-reports: https://github.com/spinda/liquidhaskell-cabal/issues@@ -13,7 +13,7 @@ license-file: LICENSE author: Michael Smith maintainer: Michael Smith <michael@spinda.net>-copyright: 2016 Michael Smith+copyright: 2016-2019 Michael Smith, 2017 Matt Chan, 2019 Ranjit Jhala category: Development build-type: Simple cabal-version: >=1.10@@ -22,11 +22,10 @@ hs-source-dirs: src exposed-modules: LiquidHaskell.Cabal build-depends: base >= 4.4 && < 5- , Cabal >= 1.18 && < 1.26+ , Cabal , filepath >= 1.3 && <1.5 default-language: Haskell2010 source-repository head type: git location: https://github.com/spinda/liquidhaskell-cabal-
src/LiquidHaskell/Cabal.hs view
@@ -1,25 +1,37 @@ -- | Please see the--- <https://github.com/spinda/liquidhaskell-cabal/blob/0.1.1.0/README.md README>+-- <https://github.com/spinda/liquidhaskell-cabal/blob/0.2.0.0/README.md README> -- for setup and usage instructions. {-# LANGUAGE CPP #-}+{-# LANGUAGE ScopedTypeVariables #-} -module LiquidHaskell.Cabal (- -- * Setup.hs Hooks Kit+module LiquidHaskell.Cabal+ ( -- defaults liquidHaskellMain+ , liquidHaskellMainHooks , liquidHaskellHooks++ -- transformers+ , simpleUserHooksLH+ , enableLiquid+ , runLiquidPostBuild+ , runLiquidPostTest++ -- raw hooks , liquidHaskellPostBuildHook+ , liquidHaskellPostTestHook ) where +import Control.Exception import Control.Monad import Data.List import Data.Maybe-import Data.Monoid +import Distribution.Types.UnqualComponentName import Distribution.ModuleName hiding (main) import Distribution.PackageDescription-import Distribution.PackageDescription.Parse+import Distribution.PackageDescription.Parsec import Distribution.ParseUtils import Distribution.Simple import Distribution.Simple.GHC@@ -27,12 +39,15 @@ import Distribution.Simple.Program import Distribution.Simple.Program.Db import Distribution.Simple.Program.GHC-import Distribution.Simple.Setup+import Distribution.Simple.Setup as DS import Distribution.Simple.Utils import Distribution.Verbosity+import Distribution.Utils.NubList import System.FilePath +import Debug.Trace+ -------------------------------------------------------------------------------- -- Setup.hs Hooks Kit ---------------------------------------------------------- --------------------------------------------------------------------------------@@ -47,6 +62,7 @@ -- > import Distribution.Simple -- > import LiquidHaskell.Cabal -- > main = defaultMainWithHooks liquidHaskellHooks+ liquidHaskellMain :: IO () liquidHaskellMain = defaultMainWithHooks liquidHaskellHooks @@ -55,7 +71,7 @@ -- -- > import Distribution.Simple -- > import LiquidHaskell.Cabal--- > main = defaultMainWithHooks liquidHaskellHooks+-- > main = liquidHaskellMainHooks -- -- This is equivalent to: --@@ -63,9 +79,37 @@ -- > import LiquidHaskell.Cabal -- > main = defaultMainWithHooks $ -- > simpleUserHooks { postBuild = liquidHaskellPostBuildHook }++liquidHaskellMainHooks :: IO ()+liquidHaskellMainHooks = defaultMainWithHooks $+ simpleUserHooks { postBuild = liquidHaskellPostBuildHook }+++ liquidHaskellHooks :: UserHooks-liquidHaskellHooks = simpleUserHooks { postBuild = liquidHaskellPostBuildHook }+liquidHaskellHooks = runLiquidPostBuild simpleUserHooksLH +simpleUserHooksLH :: UserHooks+simpleUserHooksLH = enableLiquid simpleUserHooks++enableLiquid :: UserHooks -> UserHooks+enableLiquid hooks = hooks { hookedPrograms = liquidProgram : hookedPrograms hooks }++runLiquidPostBuild :: UserHooks -> UserHooks+runLiquidPostBuild hooks = hooks { postBuild = liquidHaskellPostBuildHook+ , buildHook = quietWhenNoCode (buildHook hooks)+ }++runLiquidPostTest :: UserHooks -> UserHooks+runLiquidPostTest hooks = hooks { postTest = liquidHaskellPostTestHook+ }++liquidHaskellPostBuildHook :: Args -> BuildFlags-> PackageDescription -> LocalBuildInfo -> IO ()+liquidHaskellPostBuildHook args flags pd lbi = liquidHaskellHook args (buildVerbosity flags) pd lbi++liquidHaskellPostTestHook :: Args -> TestFlags-> PackageDescription -> LocalBuildInfo -> IO ()+liquidHaskellPostTestHook args flags pd lbi = liquidHaskellHook args (testVerbosity flags) pd lbi+ -- | The raw build hook, checking the @liquidhaskell@ flag and executing the -- LiquidHaskell binary with appropriate arguments when enabled. Can be hooked -- into a 'UserHooks' map or invoked from within your own custom 'postBuild'@@ -75,23 +119,44 @@ -- > import LiquidHaskell.Cabal -- > main = defaultMainWithHooks $ -- > simpleUserHooks { postBuild = liquidHaskellPostBuildHook }-liquidHaskellPostBuildHook :: Args -> BuildFlags -> PackageDescription- -> LocalBuildInfo -> IO ()-liquidHaskellPostBuildHook args flags pkg lbi = do+liquidHaskellHook :: Args -> DS.Flag Verbosity -> PackageDescription -> LocalBuildInfo -> IO ()+liquidHaskellHook args verbosityFlag pkg lbi = do enabled <- isFlagEnabled "liquidhaskell" lbi when enabled $ do- let verbosity = fromFlag $ buildVerbosity flags+ let verbosity = fromFlag verbosityFlag withAllComponentsInBuildOrder pkg lbi $ \component clbi -> case component of- CLib lib -> verifyComponent verbosity lbi clbi (libBuildInfo lib)- "library"- =<< findLibSources lib- CExe exe -> verifyComponent verbosity lbi clbi (buildInfo exe)- ("executable " ++ exeName exe)- =<< findExeSources exe+ CLib lib -> do+ srcs <- findLibSources lib+ verifyComponent verbosity lbi clbi (libBuildInfo lib)+ "library" srcs++ CExe exe -> do+ srcs <- findExeSources exe+ verifyComponent verbosity lbi clbi (buildInfo exe)+ ("executable " ++ unUnqualComponentName (exeName exe)) srcs _ -> return () ++liquidHaskellOptions :: String+liquidHaskellOptions = "x-liquidhaskell-options"+ --------------------------------------------------------------------------------+-- Build Process Tweaks --------------------------------------------------------+--------------------------------------------------------------------------------++type CabalBuildHook = PackageDescription -> LocalBuildInfo -> UserHooks -> BuildFlags -> IO ()++quietWhenNoCode :: CabalBuildHook -> CabalBuildHook+quietWhenNoCode hook pd lbi uh bf = do+ hook pd lbi uh bf `catch` continueWhenNoCode+ where+ noCode = any (== "-fno-code") (concatMap snd (buildProgramArgs bf))+ continueWhenNoCode+ | noCode = \(e :: SomeException) -> return ()+ | otherwise = throw++-------------------------------------------------------------------------------- -- Verify a Library or Executable Component ------------------------------------ -------------------------------------------------------------------------------- @@ -102,7 +167,7 @@ let ghcFlags = makeGhcFlags verbosity lbi clbi bi let args = concat [ ("--ghc-option=" ++) <$> ghcFlags- , ("--c-files=" ++) <$> (cSources bi)+ , ("--c-files=" ++) <$> cSources bi , userArgs , sources ]@@ -111,95 +176,48 @@ getUserArgs :: String -> BuildInfo -> IO [ProgArg] getUserArgs desc bi =- case lookup "x-liquidhaskell-options" (customFieldsBI bi) of- Nothing -> return []+ case lookup liquidHaskellOptions (customFieldsBI bi) of+ Nothing -> return [] Just cmd -> case parseCommandArgs cmd of Right args -> return args- Left err -> die $+ Left err -> dieNoVerbosity $ "failed to parse LiquidHaskell options for " ++ desc ++ ": " ++ err -------------------------------------------------------------------------------- -- Construct GHC Options ------------------------------------------------------- -------------------------------------------------------------------------------- -makeGhcFlags :: Verbosity -> LocalBuildInfo -> ComponentLocalBuildInfo- -> BuildInfo -> [String]+makeGhcFlags+ :: Verbosity+ -> LocalBuildInfo+ -> ComponentLocalBuildInfo+ -> BuildInfo+ -> [String] makeGhcFlags verbosity lbi clbi bi =- renderGhcOptions (compiler lbi) $- sanitizeGhcOptions $- componentGhcOptions verbosity lbi bi clbi $ buildDir lbi---- Whitelist which GHC options get passed along to LiquidHaskell.--- (see issue #2)-sanitizeGhcOptions :: GhcOptions -> GhcOptions-sanitizeGhcOptions opts = GhcOptions- { ghcOptMode = ghcOptMode opts- , ghcOptExtra = ghcOptExtra opts- , ghcOptExtraDefault = ghcOptExtraDefault opts- , ghcOptInputFiles = ghcOptInputFiles opts- , ghcOptInputModules = ghcOptInputModules opts- , ghcOptOutputFile = ghcOptOutputFile opts- , ghcOptOutputDynFile = ghcOptOutputDynFile opts- , ghcOptSourcePathClear = ghcOptSourcePathClear opts- , ghcOptSourcePath = ghcOptSourcePath opts-#if MIN_VERSION_Cabal(1,22,0)- , ghcOptPackageKey = ghcOptPackageKey opts+#if MIN_VERSION_Cabal(1,24,0)+ renderGhcOptions (compiler lbi) (hostPlatform lbi) #else- , ghcOptPackageName = ghcOptPackageName opts-#endif- , ghcOptPackageDBs = ghcOptPackageDBs opts- , ghcOptPackages = ghcOptPackages opts- , ghcOptHideAllPackages = ghcOptHideAllPackages opts- , ghcOptNoAutoLinkPackages = ghcOptNoAutoLinkPackages opts-#if MIN_VERSION_Cabal(1,22,0)- , ghcOptSigOf = ghcOptSigOf opts-#endif- , ghcOptLinkLibs = ghcOptLinkLibs opts- , ghcOptLinkLibPath = ghcOptLinkLibPath opts- , ghcOptLinkOptions = ghcOptLinkOptions opts- , ghcOptLinkFrameworks = ghcOptLinkFrameworks opts- , ghcOptNoLink = NoFlag -- LH uses LinkInMemory- , ghcOptLinkNoHsMain = ghcOptLinkNoHsMain opts- , ghcOptCcOptions = ghcOptCcOptions opts- , ghcOptCppOptions = ghcOptCppOptions opts- , ghcOptCppIncludePath = ghcOptCppIncludePath opts- , ghcOptCppIncludes = ghcOptCppIncludes opts- , ghcOptFfiIncludes = ghcOptFfiIncludes opts- , ghcOptLanguage = ghcOptLanguage opts- , ghcOptExtensions = ghcOptExtensions opts- , ghcOptExtensionMap = ghcOptExtensionMap opts- , ghcOptOptimisation = NoFlag -- conflicts with interactive mode GHC-#if MIN_VERSION_Cabal(1,22,0)- , ghcOptDebugInfo = ghcOptDebugInfo opts+ renderGhcOptions (compiler lbi) #endif- , ghcOptProfilingMode = NoFlag -- LH sets its own profiling mode- , ghcOptSplitObjs = ghcOptSplitObjs opts+ $ sanitizeGhcOptions+ $ componentGhcOptions verbosity lbi bi clbi (buildDir lbi)++-- Mute options that interfere with Liquid Haskell+sanitizeGhcOptions :: GhcOptions -> GhcOptions+sanitizeGhcOptions opts =+ opts { ghcOptNoLink = NoFlag -- LH uses LinkInMemory+ , ghcOptOptimisation = NoFlag -- conflicts with interactive mode GHC+ , ghcOptProfilingMode = NoFlag -- LH sets its own profiling mode #if MIN_VERSION_Cabal(1,20,0)- , ghcOptNumJobs = NoFlag -- not relevant for LH+ , ghcOptNumJobs = NoFlag -- not relevant for LH #endif #if MIN_VERSION_Cabal(1,22,0)- , ghcOptHPCDir = NoFlag -- not relevant for LH-#endif- , ghcOptGHCiScripts = mempty -- may interfere with interactive mode?- , ghcOptHiSuffix = ghcOptHiSuffix opts- , ghcOptObjSuffix = ghcOptObjSuffix opts- , ghcOptDynHiSuffix = ghcOptDynHiSuffix opts- , ghcOptDynObjSuffix = ghcOptDynObjSuffix opts- , ghcOptHiDir = ghcOptHiDir opts- , ghcOptObjDir = ghcOptObjDir opts- , ghcOptOutputDir = ghcOptOutputDir opts- , ghcOptStubDir = ghcOptStubDir opts- , ghcOptDynLinkMode = ghcOptDynLinkMode opts- , ghcOptShared = ghcOptShared opts- , ghcOptFPic = ghcOptFPic opts- , ghcOptDylibName = ghcOptDylibName opts-#if MIN_VERSION_Cabal(1,22,0)- , ghcOptRPaths = ghcOptRPaths opts+ , ghcOptHPCDir = NoFlag -- not relevant for LH #endif- , ghcOptVerbosity = ghcOptVerbosity opts- , ghcOptCabal = ghcOptCabal opts- }+ , ghcOptGHCiScripts = mempty -- may interfere with interactive mode?+ , ghcOptExtra = filter (not . isPrefixOf "-O") (ghcOptExtra opts)+ } -------------------------------------------------------------------------------- -- Find Component Haskell Sources ----------------------------------------------@@ -211,13 +229,13 @@ findExeSources :: Executable -> IO [FilePath] findExeSources exe = do moduleSrcs <- findModuleSources (buildInfo exe) []- mainSrc <- findFile (hsSourceDirs $ buildInfo exe) (modulePath exe)+ mainSrc <- findFile (hsSourceDirs (buildInfo exe)) (modulePath exe) return (mainSrc : moduleSrcs) findModuleSources :: BuildInfo -> [ModuleName] -> IO [FilePath] findModuleSources bi exposed = do let modules = exposed ++ otherModules bi- hsSources <- mapM (findModuleSource ["hs", "lhs"] bi) modules+ hsSources <- mapM (findModuleSource ["hs", "lhs"] bi) modules hsBootSources <- mapM (findModuleSource ["hs-boot", "lhs-boot"] bi) modules return $ catMaybes (hsSources ++ hsBootSources) @@ -226,7 +244,7 @@ findFileWithExtension suffixes (hsSourceDirs bi) (toFilePath mod) ----------------------------------------------------------------------------------- Located the LiquidHaskell Binary --------------------------------------------+-- Locating the LiquidHaskell Binary ------------------------------------------- -------------------------------------------------------------------------------- requireLiquidProgram :: Verbosity -> ProgramDb -> IO ConfiguredProgram@@ -243,19 +261,19 @@ isFlagEnabled :: String -> LocalBuildInfo -> IO Bool isFlagEnabled name lbi = case getOverriddenFlagValue name lbi of Just enabled -> return enabled- Nothing -> getDefaultFlagValue name lbi False+ Nothing -> getDefaultFlagValue name lbi False getOverriddenFlagValue :: String -> LocalBuildInfo -> Maybe Bool-getOverriddenFlagValue name lbi = lookup (FlagName name) overriddenFlags+getOverriddenFlagValue name lbi = lookupFlagAssignment (mkFlagName name) overriddenFlags where- overriddenFlags = configConfigurationsFlags $ configFlags lbi+ overriddenFlags = configConfigurationsFlags (configFlags lbi) getDefaultFlagValue :: String -> LocalBuildInfo -> Bool -> IO Bool getDefaultFlagValue name lbi def = case pkgDescrFile lbi of- Nothing -> return def+ Nothing -> return def Just cabalFile -> do- descr <- readPackageDescription silent cabalFile- let flag = find ((FlagName name ==) . flagName) $ genPackageFlags descr+ descr <- readGenericPackageDescription silent cabalFile+ let flag = find ((mkFlagName name ==) . flagName) $ genPackageFlags descr return $ maybe def flagDefault flag --------------------------------------------------------------------------------@@ -263,12 +281,12 @@ -------------------------------------------------------------------------------- parseCommandArgs :: String -> Either String [ProgArg]-parseCommandArgs cmd =- case fieldSet field 0 cmd [] of- ParseOk _ out -> Right $ concat $ map snd out+parseCommandArgs cmd = case fieldSet field 0 cmd [] of+ ParseOk _ out -> Right $ foldMap snd out ParseFailed err -> Left $ snd $ locatedErrorMsg err where- field = optsField "x-liquidhaskell-options"+ field = optsField liquidHaskellOptions (OtherCompiler "LiquidHaskell")- id (++)-+ id -- get :: opts -> opts+ (++) -- set :: opts -> opts -> opts+ -- where opts=[(CompilerFlavor,[String])]