diff --git a/liquidhaskell-cabal.cabal b/liquidhaskell-cabal.cabal --- a/liquidhaskell-cabal.cabal +++ b/liquidhaskell-cabal.cabal @@ -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 - + 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 -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 - diff --git a/src/LiquidHaskell/Cabal.hs b/src/LiquidHaskell/Cabal.hs --- a/src/LiquidHaskell/Cabal.hs +++ b/src/LiquidHaskell/Cabal.hs @@ -1,25 +1,37 @@ -- | Please see the --- +-- -- 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])]