liquidhaskell-cabal 0.2.0.0 → 0.2.1.0
raw patch · 2 files changed
+123/−20 lines, 2 filesdep +directoryPVP ok
version bump matches the API change (PVP)
Dependencies added: directory
API changes (from Hackage documentation)
Files
- liquidhaskell-cabal.cabal +3/−2
- src/LiquidHaskell/Cabal.hs +120/−18
liquidhaskell-cabal.cabal view
@@ -1,11 +1,11 @@ name: liquidhaskell-cabal-version: 0.2.0.0+version: 0.2.1.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.2.0.0/README.md README>+ <https://github.com/spinda/liquidhaskell-cabal/blob/0.2.1.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@@ -24,6 +24,7 @@ build-depends: base >= 4.4 && < 5 , Cabal , filepath >= 1.3 && <1.5+ , directory default-language: Haskell2010 source-repository head
src/LiquidHaskell/Cabal.hs view
@@ -1,9 +1,10 @@ -- | Please see the--- <https://github.com/spinda/liquidhaskell-cabal/blob/0.2.0.0/README.md README>+-- <https://github.com/spinda/liquidhaskell-cabal/blob/0.2.1.0/README.md README> -- for setup and usage instructions. {-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TupleSections #-} module LiquidHaskell.Cabal ( -- defaults@@ -22,9 +23,12 @@ , liquidHaskellPostTestHook ) where +import Control.Applicative import Control.Exception import Control.Monad +import Data.Either+import Data.Foldable import Data.List import Data.Maybe @@ -44,6 +48,7 @@ import Distribution.Verbosity import Distribution.Utils.NubList +import System.Directory (canonicalizePath, doesDirectoryExist, doesFileExist) import System.FilePath import Debug.Trace@@ -127,20 +132,27 @@ withAllComponentsInBuildOrder pkg lbi $ \component clbi -> case component of CLib lib -> do- srcs <- findLibSources lib- verifyComponent verbosity lbi clbi (libBuildInfo lib)- "library" srcs+ let desc = "library"+ let buildInfo' = libBuildInfo lib+ sourceFilter <- makeSourceFilter desc buildInfo'+ srcs <- filterSources desc sourceFilter =<< findLibSources lib+ verifyComponent verbosity lbi clbi buildInfo' desc srcs CExe exe -> do- srcs <- findExeSources exe- verifyComponent verbosity lbi clbi (buildInfo exe)- ("executable " ++ unUnqualComponentName (exeName exe)) srcs+ let desc = "executable " ++ unUnqualComponentName (exeName exe)+ let buildInfo' = buildInfo exe+ sourceFilter <- makeSourceFilter desc buildInfo'+ srcs <- filterSources desc sourceFilter =<< findExeSources exe+ verifyComponent verbosity lbi clbi buildInfo' desc srcs _ -> return () -liquidHaskellOptions :: String-liquidHaskellOptions = "x-liquidhaskell-options"+liquidHaskellOptionsField :: String+liquidHaskellOptionsField = "x-liquidhaskell-options" +liquidHaskellVerifyField :: String+liquidHaskellVerifyField = "x-liquidhaskell-verify"+ -------------------------------------------------------------------------------- -- Build Process Tweaks -------------------------------------------------------- --------------------------------------------------------------------------------@@ -175,16 +187,98 @@ runProgram verbosity liquid args getUserArgs :: String -> BuildInfo -> IO [ProgArg]-getUserArgs desc bi =- case lookup liquidHaskellOptions (customFieldsBI bi) of- Nothing -> return []- Just cmd ->- case parseCommandArgs cmd of- Right args -> return args- Left err -> dieNoVerbosity $- "failed to parse LiquidHaskell options for " ++ desc ++ ": " ++ err+getUserArgs desc =+ (concat <$>) . mapM (getUserArgs' desc) . getAllCustomFieldValues liquidHaskellOptionsField +getUserArgs' :: String -> String -> IO [ProgArg]+getUserArgs' desc cmd = case parseCommandArgs cmd of+ Right args -> return args+ Left err -> dieNoVerbosity $+ "failed to parse LiquidHaskell options for " ++ desc ++ ": " ++ err+ --------------------------------------------------------------------------------+-- Filter Input Sources --------------------------------------------------------+--------------------------------------------------------------------------------++type SourcePattern = Either FilePattern DirectoryPattern++data FilePattern = FilePattern+ { filePatternSource :: !FilePath+ , filePatternCompiled :: !FilePath+ }++data DirectoryPattern = DirectoryPattern+ { directoryPatternSource :: !FilePath+ , directoryPatternCompiled :: ![FilePath]+ }++data SourceFilter =+ All+ | Whitelist [FilePattern] [DirectoryPattern]++makeSourceFilter :: String -> BuildInfo -> IO SourceFilter+makeSourceFilter desc bi+ | null paths = return All+ | otherwise = uncurry Whitelist . partitionEithers <$> mapM (makeSourcePattern desc) paths+ where+ paths = getAllCustomFieldValues liquidHaskellVerifyField bi++makeSourcePattern :: String -> FilePath -> IO SourcePattern+makeSourcePattern desc = tryFilePattern+ where+ tryFilePattern path = do+ fileExists <- doesFileExist path+ if fileExists+ then Left . FilePattern path <$> canonicalizePath path+ else tryDirectoryPattern path+ tryDirectoryPattern path = do+ directoryExists <- doesDirectoryExist path+ if directoryExists+ then Right . DirectoryPattern path . splitDirectories <$> canonicalizePath path+ else dieWithError path+ dieWithError path = dieNoVerbosity $+ "Path passed to " ++ liquidHaskellVerifyField +++ " for " ++ desc +++ " does not exist: " ++ path++filterSources :: String -> SourceFilter -> [FilePath] -> IO [FilePath]+filterSources _ All paths = return paths+filterSources desc (Whitelist filePatterns directoryPatterns) paths = do+ results <- catMaybes <$> mapM (matchSourcePath filePatterns directoryPatterns) paths++ let consumedPatterns = snd <$> results+ let (consumedFilePatterns, consumedDirectoryPatterns) = partitionEithers consumedPatterns++ let unconsumedFilePaths = (\\) (filePatternSource <$> filePatterns)+ (filePatternSource <$> consumedFilePatterns)+ let unconsumedDirectoryPaths = (\\) (directoryPatternSource <$> directoryPatterns)+ (directoryPatternSource <$> consumedDirectoryPatterns)+ let unconsumedPaths = unconsumedFilePaths ++ unconsumedDirectoryPaths++ unless (null unconsumedPaths) $ dieNoVerbosity $+ "Paths passed to " ++ liquidHaskellVerifyField +++ " for " ++ desc +++ " do not match any source files in the component:\n" +++ unlines (("- " ++) <$> unconsumedPaths)++ return $ fst <$> results++matchSourcePath+ :: [FilePattern]+ -> [DirectoryPattern]+ -> FilePath+ -> IO (Maybe (FilePath, SourcePattern))+matchSourcePath filePatterns directoryPatterns path = do+ path' <- canonicalizePath path+ return $ (path, ) <$> (tryFilePatterns path' <|> tryDirectoryPatterns path')+ where+ tryFilePatterns path =+ Left <$> find ((== path) . filePatternCompiled) filePatterns+ tryDirectoryPatterns path =+ let pathPieces = splitDirectories path+ in Right <$> find ((`isPrefixOf` pathPieces) . directoryPatternCompiled) directoryPatterns++-------------------------------------------------------------------------------- -- Construct GHC Options ------------------------------------------------------- -------------------------------------------------------------------------------- @@ -277,6 +371,14 @@ return $ maybe def flagDefault flag --------------------------------------------------------------------------------+-- Cabal Field Handling --------------------------------------------------------+--------------------------------------------------------------------------------++getAllCustomFieldValues :: String -> BuildInfo -> [String]+getAllCustomFieldValues field =+ map snd . filter ((== field) . fst) . customFieldsBI++-------------------------------------------------------------------------------- -- Splitting Command Line Arguments -------------------------------------------- -------------------------------------------------------------------------------- @@ -285,7 +387,7 @@ ParseOk _ out -> Right $ foldMap snd out ParseFailed err -> Left $ snd $ locatedErrorMsg err where- field = optsField liquidHaskellOptions+ field = optsField liquidHaskellOptionsField (OtherCompiler "LiquidHaskell") id -- get :: opts -> opts (++) -- set :: opts -> opts -> opts