├── .gitignore ├── LICENSE ├── Makefile ├── README.md ├── Setup.hs ├── cabal-rangefinder.cabal ├── src ├── CabalFile.hs ├── CabalFile │ ├── Parser.hs │ ├── Parser │ │ ├── Test.hs │ │ └── Types.hs │ ├── Printer.hs │ └── Types.hs ├── Main.hs ├── MaybeIO.hs ├── Search.hs ├── System │ └── IO │ │ └── Strict.hs ├── VersionFile.hs └── VersionFile │ ├── Parser.hs │ ├── Parser │ ├── Test.hs │ └── Types.hs │ └── Types.hs └── tests ├── capitalization ├── Hello.hs ├── cabal.expected └── cabal.in └── hello ├── Hello.hs ├── cabal.expected └── cabal.in /.gitignore: -------------------------------------------------------------------------------- 1 | /cabal-dev 2 | /dist 3 | /doc 4 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | This is free and unencumbered software released into the public domain. 2 | 3 | Anyone is free to copy, modify, publish, use, compile, sell, or 4 | distribute this software, either in source code form or as a compiled 5 | binary, for any purpose, commercial or non-commercial, and by any 6 | means. 7 | 8 | In jurisdictions that recognize copyright laws, the author or authors 9 | of this software dedicate any and all copyright interest in the 10 | software to the public domain. We make this dedication for the benefit 11 | of the public at large and to the detriment of our heirs and 12 | successors. We intend this dedication to be an overt act of 13 | relinquishment in perpetuity of all present and future rights to this 14 | software under copyright law. 15 | 16 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 17 | EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 18 | MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. 19 | IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR 20 | OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, 21 | ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR 22 | OTHER DEALINGS IN THE SOFTWARE. 23 | 24 | For more information, please refer to 25 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | # you can either build via "make build" or "cabal build". 2 | # however, to run the tests, you may only use "make test", not "cabal test". 3 | 4 | NAME="$(shell basename `pwd`)" 5 | 6 | .PHONY: all config build test small-tests big-tests clean clobber 7 | 8 | all: build test 9 | 10 | config: dist/setup-config 11 | 12 | dist/setup-config: 13 | cabal sandbox init 14 | cabal install --only-dependencies 15 | 16 | build: config 17 | cabal build 18 | 19 | 20 | test: small-tests big-tests 21 | 22 | small-tests: build 23 | cabal install QuickCheck 24 | find src -name '*.hs' | xargs doctest -package-db "$$(ls -d .cabal-sandbox/*-packages.conf.d)" 25 | 26 | 27 | big-tests: $(patsubst %,proofs/%.proof,$(shell ls tests)) 28 | -@echo '*** ALL TESTS OK ***' 29 | 30 | proofs/%.proof: proofs/%/cabal.out tests/%/cabal.expected 31 | diff $^ 32 | touch $@ 33 | 34 | proofs/%/cabal.out: tests/%/cabal.in build 35 | mkdir -p $(dir $@) 36 | cd $(dir $<); cat cabal.in > $(shell basename $(shell dirname $<)).cabal 37 | cd $(dir $<); ../../dist/build/$(NAME)/$(NAME) $(shell basename $(shell dirname $<)).cabal 38 | cat $(dir $<)/$(shell basename $(shell dirname $<)).cabal > $@ 39 | 40 | 41 | clean: 42 | rm -rf proofs 43 | 44 | clobber: clean 45 | rm -rf dist 46 | 47 | distclean: clobber 48 | rm -rf cabal.sandbox.config .cabal-sandbox 49 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | cabal-rangefinder 2 | ================= 3 | 4 | A tool to fill in the version ranges in a cabal file. 5 | 6 | purpose 7 | ------- 8 | 9 | Suppose you have a Haskell project which builds fine on your machine with `cabal install`. Will it also build fine on other machines? 10 | 11 | One common reason for build failures is unspecified version ranges. 12 | 13 | build-depends: base >= 4 && < 5, 14 | containers, 15 | mtl 16 | 17 | But how do you know which versions of each package your code is compatible with? Unless you are very familiar with the history of each package, your only choice is to test with many versions. Cabal-rangefinder automates the process. 18 | 19 | usage 20 | ----- 21 | 22 | Simply call `cabal-rangefinder myproject.cabal`, and wait while your program gets compiled with every version of every dependency. 23 | 24 | correctness 25 | ----------- 26 | 27 | We assume that the current cabal file already compiles fine with the latest version of everything. That is, you should use cabal-rangefinder to expand the lower end of your version ranges, not to find a version which works in the first place. 28 | 29 | We also assume that if versions X and Y both work, then so do all the versions in between. 30 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /cabal-rangefinder.cabal: -------------------------------------------------------------------------------- 1 | Name: cabal-rangefinder 2 | Version: 0.1 3 | 4 | -- A short (one-line) description of the package. 5 | Synopsis: A tool to fill in the version ranges in a cabal file. 6 | 7 | -- A longer description of the package. 8 | -- Description: 9 | 10 | Homepage: https://github.com/gelisam/cabal-rangefinder#readme 11 | License: PublicDomain 12 | License-file: LICENSE 13 | Author: Samuel Gélineau 14 | Maintainer: gelisam@gmail.com 15 | 16 | Category: Distribution 17 | 18 | Build-type: Simple 19 | Cabal-version: >=1.8 20 | 21 | Extra-source-files: README.md, 22 | Makefile 23 | 24 | executable cabal-rangefinder 25 | build-depends: base >= 4 && < 5, 26 | Cabal, 27 | directory, 28 | filepath, 29 | mtl, 30 | pretty, 31 | process, 32 | transformers 33 | main-is: Main.hs 34 | hs-source-dirs: src 35 | ghc-options: -Wall 36 | -------------------------------------------------------------------------------- /src/CabalFile.hs: -------------------------------------------------------------------------------- 1 | -- | Re-export the CabalFile.* submodules. 2 | module CabalFile 3 | ( Cabal 4 | , dependencies 5 | , packages 6 | , (//) 7 | 8 | , readCabal 9 | , writeCabal 10 | ) where 11 | 12 | import CabalFile.Types 13 | import CabalFile.Parser 14 | import CabalFile.Printer 15 | -------------------------------------------------------------------------------- /src/CabalFile/Parser.hs: -------------------------------------------------------------------------------- 1 | -- | To parse a "package-name.cabal" file. 2 | {-# LANGUAGE ScopedTypeVariables #-} 3 | module CabalFile.Parser 4 | ( parseCabal 5 | , readCabal 6 | ) where 7 | 8 | import Control.Applicative 9 | import Control.Monad.State 10 | import Control.Monad.Writer 11 | import Data.Maybe 12 | import Distribution.Text 13 | 14 | import CabalFile.Types 15 | import CabalFile.Parser.Test () 16 | import CabalFile.Parser.Types 17 | import System.IO.Strict 18 | 19 | -- $setup 20 | -- >>> import CabalFile.Parser.Test 21 | 22 | 23 | splitConsume :: (Functor m, Monad m) 24 | => (s -> (e, s)) 25 | -> (e -> m a) 26 | -> StateT s m a 27 | splitConsume split consume = do 28 | (e, s) <- split <$> get 29 | put s 30 | lift $ consume e 31 | 32 | splitXform :: forall a. (String -> (String, String)) -> (String -> a) -> ParseC a 33 | splitXform split f = splitConsume split go 34 | where 35 | go :: String -> WriterT Cabal Maybe a 36 | go s = do 37 | tell [Left s] 38 | return $ f s 39 | 40 | splitIgnore :: (String -> (String, String)) -> ParseC () 41 | splitIgnore = (`splitXform` const ()) 42 | 43 | splitWhitespace :: String -> (String, String) 44 | splitWhitespace = span (`elem` " \t") 45 | 46 | 47 | -- | Consume the string if it matches the head of the input stream. 48 | -- >>> testC "fool" $ stringC "foo" 49 | -- "foo" 50 | -- () 51 | -- "l" 52 | -- 53 | -- >>> testC "bard" $ stringC "foo" 54 | -- Nothing 55 | -- 56 | -- >>> testC "bard" $ stringC "foo" <|> stringC "bar" 57 | -- "bar" 58 | -- () 59 | -- "d" 60 | stringC :: String -> ParseC () 61 | stringC expected = splitConsume split check 62 | where 63 | split :: String -> (String, String) 64 | split = splitAt $ length expected 65 | 66 | check :: String -> WriterT Cabal Maybe () 67 | check actual = do 68 | guard $ actual == expected 69 | tell [Left actual] 70 | 71 | -- | Consume a dependency if it matches the head of the input stream. 72 | -- >>> testC "containers" dependencyC 73 | -- [containers -any] 74 | -- () 75 | -- 76 | -- >>> testC "containers, mtl" dependencyC 77 | -- [containers -any] 78 | -- () 79 | -- ", mtl" 80 | -- 81 | -- >>> testC "bogus text" dependencyC 82 | -- Nothing 83 | dependencyC :: ParseC () 84 | dependencyC = splitConsume split check 85 | where 86 | split :: String -> (String, String) 87 | split = break (`elem` ",\n") 88 | 89 | check :: String -> WriterT Cabal Maybe () 90 | check s = do 91 | d <- lift $ simpleParse s 92 | tell [Right d] 93 | 94 | 95 | -- | Only succeed if the file has been completely consumed. 96 | -- >>> testC "" eofC 97 | -- () 98 | -- 99 | -- >>> testC "more" eofC 100 | -- Nothing 101 | eofC :: ParseC () 102 | eofC = do 103 | s <- get 104 | guard $ null s 105 | 106 | -- | Only succeed if the line has been completely consumed. 107 | -- >>> testC "\n" eolC 108 | -- "\n" 109 | -- () 110 | -- 111 | -- >>> testC "more\n" eolC 112 | -- Nothing 113 | eolC :: ParseC () 114 | eolC = stringC "\n" 115 | 116 | 117 | -- | Consume and ignore whitespace. 118 | -- >>> testC " hello" whitespaceC 119 | -- " " 120 | -- () 121 | -- "hello" 122 | whitespaceC :: ParseC () 123 | whitespaceC = splitIgnore splitWhitespace 124 | 125 | -- | Consume and ignore the rest of the line. 126 | -- >>> testC "hello" lineC 127 | -- "hello" 128 | -- () 129 | -- 130 | -- >>> testC "hello\nworld\n" lineC 131 | -- "hello" 132 | -- "\n" 133 | -- () 134 | -- "world\n" 135 | lineC :: ParseC () 136 | lineC = do 137 | splitIgnore $ break (== '\n') 138 | stringC "\n" <|> return () 139 | 140 | -- | Consume and measure the indentation. 141 | -- >>> testC " hello" indentC 142 | -- " " 143 | -- 2 144 | -- "hello" 145 | indentC :: ParseC Int 146 | indentC = splitXform splitWhitespace length 147 | 148 | 149 | parseCabal :: String -> Cabal 150 | parseCabal = fromJust . execWriterT . execStateT cabal 151 | where 152 | cabal :: ParseC () 153 | cabal = eofC <|> ((build_depends <|> lineC) >> cabal) 154 | 155 | build_depends :: ParseC () 156 | build_depends = do 157 | i <- indentC 158 | stringC "build-depends" <|> stringC "Build-Depends" 159 | <|> stringC "Build-depends" 160 | whitespaceC 161 | stringC ":" 162 | dependency i 163 | 164 | dependency :: Int -> ParseC () 165 | dependency i = do 166 | spacing i 167 | dependencyC 168 | (spacing i >> stringC "," >> dependency i) <|> eolC 169 | 170 | -- whitespace, including newlines, but stay withing the block of 171 | -- data which is indented by more than i characters. 172 | spacing :: Int -> ParseC () 173 | spacing i = do 174 | whitespaceC 175 | go <|> return () 176 | where 177 | go :: ParseC () 178 | go = do 179 | eolC 180 | j <- indentC 181 | go <|> guard (j > i) 182 | 183 | readCabal :: FilePath -> IO Cabal 184 | readCabal = fmap parseCabal . readFile' 185 | -------------------------------------------------------------------------------- /src/CabalFile/Parser/Test.hs: -------------------------------------------------------------------------------- 1 | -- | Simplify doctests by pretty-printing results. 2 | {-# LANGUAGE ScopedTypeVariables #-} 3 | module CabalFile.Parser.Test where 4 | 5 | import Control.Monad.State 6 | import Control.Monad.Writer 7 | import Distribution.Text 8 | import Distribution.Package 9 | import Text.Printf 10 | 11 | import CabalFile.Parser.Types 12 | import CabalFile.Types 13 | 14 | 15 | -- | Print the parsed pieces, the result, and the remaining string. 16 | -- >>> testC "foo" (return 42) 17 | -- 42 18 | -- "foo" 19 | testC :: forall a. Show a => String -> ParseC a -> IO () 20 | testC doc = go . runWriterT . (`runStateT` doc) 21 | where 22 | go :: Maybe ((a, String), Cabal) -> IO () 23 | go Nothing = putStrLn "Nothing" 24 | go (Just ((x, s), ys)) = do 25 | mapM_ putStrLn $ map show' ys 26 | print x 27 | unless (null s) $ print s 28 | 29 | show' :: Either String Dependency -> String 30 | show' (Left s) = show s 31 | show' (Right d) = printf "[%s]" $ display d 32 | -------------------------------------------------------------------------------- /src/CabalFile/Parser/Types.hs: -------------------------------------------------------------------------------- 1 | -- | The monad in which parseCabal is most easily expressed. 2 | module CabalFile.Parser.Types where 3 | 4 | import Control.Monad.State 5 | import Control.Monad.Writer 6 | 7 | import CabalFile.Types 8 | 9 | 10 | -- | The string which remains to be parsed, the pieces which have already been 11 | -- parsed, and a result. Or, if unsuccessful, Nothing. 12 | type ParseC a = StateT String (WriterT Cabal Maybe) a 13 | -------------------------------------------------------------------------------- /src/CabalFile/Printer.hs: -------------------------------------------------------------------------------- 1 | module CabalFile.Printer where 2 | 3 | import Distribution.Text 4 | import System.IO 5 | 6 | import CabalFile.Types 7 | 8 | 9 | printCabal :: Handle -> Cabal -> IO () 10 | printCabal h cabal = mapM_ (hPutStr h) fragments 11 | where 12 | fragments :: [String] 13 | fragments = map (either id display) cabal 14 | 15 | writeCabal :: FilePath -> Cabal -> IO () 16 | writeCabal path = withFile path WriteMode . flip printCabal 17 | -------------------------------------------------------------------------------- /src/CabalFile/Types.hs: -------------------------------------------------------------------------------- 1 | -- | To represent a "package-name.cabal" file. 2 | -- We only care about the dependencies, but we also need to preserve 3 | -- everything else (including the whitespace!) because we will write the file 4 | -- back to disk and we don't want to obliterate the user's indentation style. 5 | module CabalFile.Types where 6 | 7 | import Data.Either 8 | import Distribution.Package 9 | import Distribution.Version 10 | 11 | 12 | -- The Cabal library already has the type Distribution.PackageDescription, and 13 | -- it already has a parser and a pretty-printer. However, we cannot use that 14 | -- representation because we need to keep the whitespace information intact. 15 | type Cabal = [Either String Dependency] 16 | 17 | dependencies :: Cabal -> [Dependency] 18 | dependencies = rights 19 | 20 | packages :: Cabal -> [PackageName] 21 | packages = map package . dependencies 22 | where 23 | package :: Dependency -> PackageName 24 | package (Dependency p _) = p 25 | 26 | -- Replace the given dependencies 27 | (//) :: Cabal -> [(PackageName, VersionRange)] -> Cabal 28 | [] // _ = [] 29 | (Left s:xs) // ds = Left s : (xs // ds) 30 | (Right (Dependency p v):xs) // ds = case lookup p ds of 31 | Nothing -> Right (Dependency p v) : (xs // ds) 32 | Just v' -> Right (Dependency p v') : (xs // ds) 33 | -------------------------------------------------------------------------------- /src/Main.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ImplicitParams #-} 2 | module Main where 3 | 4 | import Control.Arrow 5 | import Control.Monad 6 | import Control.Monad.Trans 7 | import Control.Monad.Trans.Maybe 8 | import Distribution.Package 9 | import Distribution.Text 10 | import Distribution.Version 11 | import System.Environment 12 | import Text.Printf 13 | 14 | import CabalFile 15 | import VersionFile 16 | 17 | import MaybeIO 18 | import Search 19 | 20 | 21 | -- | Some packages are "pinned" to a particular version by the system, and no 22 | -- other versions may be installed. So don't try. 23 | pinned_packages :: [String] 24 | pinned_packages = [ "Cabal" 25 | , "array" 26 | , "base" 27 | , "bin-package-db" 28 | , "binary" 29 | , "bytestring" 30 | , "containers" 31 | , "deepseq" 32 | , "directory" 33 | , "filepath" 34 | , "ghc" 35 | , "ghc-prim" 36 | , "haskell2010" 37 | , "haskell98" 38 | , "hoopl" 39 | , "hpc" 40 | , "integer-gmp" 41 | , "old-locale" 42 | , "old-time" 43 | , "pretty" 44 | , "process" 45 | , "rts" 46 | , "template-haskell" 47 | , "time" 48 | , "unix" 49 | ] 50 | 51 | is_pinned :: PackageName -> Bool 52 | is_pinned (PackageName name) = (name `elem` pinned_packages) 53 | 54 | 55 | -- | With the given Cabal file, does the project build? 56 | build_with_cabal :: (?cabal_file :: FilePath) => Cabal -> MaybeIO 57 | build_with_cabal cabal = do 58 | lift $ writeCabal ?cabal_file cabal 59 | run "rm -rf dist cabal.sandbox.config .cabal-sandbox" 60 | run "cabal -v0 sandbox init" 61 | run "cabal -v0 install --only-dependencies" 62 | run "cabal -v0 build" 63 | lift $ putStrLn "cabal-rangefinder: OK" 64 | 65 | -- | How about with the default Cabal plus a specific version constrain? 66 | build_with_version :: (?cabal_file :: FilePath, ?cabal :: Cabal) 67 | => PackageName -> Version 68 | -> MaybeIO 69 | build_with_version p v = do 70 | lift header 71 | build_with_cabal cabal' 72 | where 73 | header :: IO () 74 | header = printf "cabal-rangefinder: trying %s %s\n" (display p) (display v) 75 | 76 | cabal' :: Cabal 77 | cabal' = ?cabal // [(p, thisVersion v)] 78 | 79 | -- | Same, but with the type expected by binary_search. 80 | builds_with_version :: (?cabal_file :: FilePath, ?cabal :: Cabal) 81 | => PackageName -> Version 82 | -> IO (Maybe [(PackageName, VersionRange)]) 83 | builds_with_version p v = runMaybeT 84 | $ fmap (const [(p, orLaterVersion v)]) 85 | $ build_with_version p v 86 | 87 | -- | Assuming the latest version works, how old can we go back? 88 | find_first_version :: (?cabal_file :: FilePath, ?cabal :: Cabal) 89 | => PackageName -> [Version] 90 | -> IO [(PackageName, VersionRange)] 91 | find_first_version p = binary_search [] 92 | . map (builds_with_version p) 93 | 94 | 95 | getCabalPath :: IO FilePath 96 | getCabalPath = do 97 | [cabal_file] <- getArgs 98 | return cabal_file 99 | 100 | main :: IO () 101 | main = do 102 | cabal_file <- getCabalPath 103 | cabal <- readCabal cabal_file 104 | -- mapM_ print cabal 105 | 106 | let ?cabal_file = cabal_file 107 | let ?cabal = cabal 108 | 109 | putStrLn "cabal-rangefinder: trying original .cabal file" 110 | untouchedOk <- succeeds $ build_with_cabal cabal 111 | when (not untouchedOk) $ do 112 | error "You should at least start with a working .cabal file." 113 | 114 | versionMap <- readVersionMap 115 | -- mapM_ print versionMap 116 | 117 | let all_packages = packages cabal 118 | let our_packages = filter (not . is_pinned) all_packages 119 | -- mapM_ print our_packages 120 | 121 | let our_versions = versionMap `restricted_to` our_packages 122 | mapM_ print $ map (display *** map display) our_versions 123 | 124 | assignmentss <- forM our_versions $ \(p, vs) -> do 125 | printf "cabal-rangefinder: exploring %s\n" (display p) :: IO () 126 | assignment <- find_first_version p vs 127 | when (null assignment) $ do 128 | printf "cabal-rangefinder: no good version for %s!\n" (display p) :: IO () 129 | forM_ assignment $ \(p', v) -> 130 | printf "cabal-rangefinder: picked %s %s\n" (display p') (display v) :: IO () 131 | return assignment 132 | print assignmentss 133 | let assignments = concat assignmentss 134 | -- assignments <- msum $ map (uncurry find_first_version) our_versions 135 | print assignments 136 | 137 | let final_cabal = cabal // assignments 138 | finalOk <- succeeds $ build_with_cabal final_cabal 139 | when (not finalOk) $ do 140 | error "I spent all this time building the perfect .cabal file, and it doesn't even run :(" 141 | -------------------------------------------------------------------------------- /src/MaybeIO.hs: -------------------------------------------------------------------------------- 1 | -- | IO computations which can fail without crashing the program. 2 | module MaybeIO where 3 | 4 | import Control.Monad 5 | import Control.Monad.Trans 6 | import Control.Monad.Trans.Maybe 7 | import Data.Maybe 8 | import System.Exit 9 | import System.Process 10 | 11 | 12 | type MaybeIO = MaybeT IO () 13 | 14 | -- | Does the given computation run until the end? 15 | succeeds :: MaybeIO -> IO Bool 16 | succeeds = fmap isJust . runMaybeT 17 | 18 | -- | Does the given command-line program succeed? 19 | run :: String -> MaybeIO 20 | run cmd = do 21 | exitCode <- lift $ system cmd 22 | when (exitCode /= ExitSuccess) $ do 23 | fail "command failed" 24 | -------------------------------------------------------------------------------- /src/Search.hs: -------------------------------------------------------------------------------- 1 | -- | A monad-based version of binary_search, 2 | -- because we need to run the build each time we want to test a version. 3 | module Search where 4 | 5 | 6 | -- | The first action which succeeds, assuming all later action also do. 7 | -- >>> binary_search 4 [[Nothing], [Nothing], [Just 2], [Just 3]] 8 | -- [2] 9 | -- 10 | -- >>> binary_search 4 [[Nothing], [Nothing], [Nothing], [Nothing]] 11 | -- [4] 12 | -- 13 | -- prop> let n = x1 `mod` 10; k = if n > 0 then x2 `mod` n else 0; xs = [[Nothing] | x <- [0..k-1]] ++ [[Just x] | x <- [k..n-1]] in binary_search n xs == [k] 14 | binary_search :: Monad m => a -> [m (Maybe a)] -> m a 15 | binary_search d [] = return d 16 | binary_search d mxs = do 17 | r <- mx 18 | case r of 19 | Nothing -> binary_search d mxs2 20 | Just x -> binary_search x mxs1 21 | where 22 | i = length mxs `div` 2 23 | (mxs1, mx:mxs2) = splitAt i mxs 24 | -------------------------------------------------------------------------------- /src/System/IO/Strict.hs: -------------------------------------------------------------------------------- 1 | -- | Lazy I/O isn't that bad, but we need to re-write the "package-name.cabal" 2 | -- file, and for this we cannot allow the runtime to start writing before we 3 | -- are done reading the old contents. 4 | module System.IO.Strict where 5 | 6 | 7 | -- like readFile, but without the lazy IO 8 | readFile' :: FilePath -> IO String 9 | readFile' f = do 10 | s <- readFile f 11 | length s `seq` return s 12 | -------------------------------------------------------------------------------- /src/VersionFile.hs: -------------------------------------------------------------------------------- 1 | -- | Re-export the VersionFile.* submodules. 2 | module VersionFile 3 | ( VersionMap 4 | , restricted_to 5 | 6 | , readVersionMap 7 | ) where 8 | 9 | import VersionFile.Types 10 | import VersionFile.Parser 11 | -------------------------------------------------------------------------------- /src/VersionFile/Parser.hs: -------------------------------------------------------------------------------- 1 | -- | To parse the version map data hidden in cabal's local cache file, 2 | -- located at "~/.cabal/packages/hackage.haskell.org/00-index.cache". 3 | -- It looks like this, but much longer: 4 | -- 5 | -- pref-ver: imagemagick >=0.0.2 6 | -- pkg: imagemagick 0.0.1 b# 123041 7 | -- pkg: imagemagick 0.0.2 b# 123078 8 | -- pkg: imagemagick 0.0.3 b# 123116 9 | -- pkg: imagemagick 0.0.3.1 b# 123154 10 | -- pkg: mtl 1.0 b# 143620 11 | -- pkg: mtl 1.1.0.0 b# 143623 12 | -- pkg: mtl 1.1.0.1 b# 143627 13 | -- pkg: mtl 1.1.0.2 b# 143631 14 | -- pkg: mtl 1.1.1.0 b# 143635 15 | -- pkg: mtl 1.1.1.1 b# 143639 16 | -- pkg: mtl 2.0.0.0 b# 143643 17 | -- pkg: mtl 2.0.1.0 b# 143647 18 | -- pkg: mtl 2.1 b# 143651 19 | -- pkg: mtl 2.1.1 b# 143655 20 | -- pkg: mtl 2.1.2 b# 143659 21 | -- 22 | -- I assume that the "pref-ver" part remembers the version ranges which were 23 | -- requested by the user on the command-line, while the "pkg" part remembers 24 | -- which versions of each package are available. This mapping between each 25 | -- package name and its available versions is what we call a version map. 26 | -- 27 | -- I don't know what the "b# 123456" part means. We ignore it. 28 | module VersionFile.Parser 29 | ( getVersionPath 30 | , readVersionMap 31 | , parseVersionMap 32 | ) where 33 | 34 | import Control.Applicative 35 | import Control.Arrow 36 | import Data.Function 37 | import Data.List 38 | import Data.Maybe 39 | import Distribution.Package (PackageName) 40 | import Distribution.Text 41 | import Distribution.Version (Version) 42 | import System.Directory 43 | import System.FilePath 44 | 45 | import VersionFile.Types 46 | import VersionFile.Parser.Test () 47 | import VersionFile.Parser.Types 48 | 49 | -- $setup 50 | -- >>> import VersionFile.Parser.Test 51 | 52 | 53 | getVersionPath :: IO FilePath 54 | getVersionPath = do 55 | home <- getHomeDirectory 56 | return $ home ".cabal/packages/hackage.haskell.org/00-index.cache" 57 | 58 | 59 | -- | 60 | -- >>> testV id (packageName "xturtle") 61 | -- PackageName {unPackageName = "xturtle"} 62 | packageName :: ParseV PackageName 63 | packageName = simpleParse 64 | 65 | -- | 66 | -- >>> testV display (version "1.0.7") 67 | -- "1.0.7" 68 | version :: ParseV Version 69 | version = simpleParse 70 | 71 | -- | 72 | -- >>> testV (display *** display) (pkg "pkg: xturtle 0.0.7 b# 211609") 73 | -- ("xturtle","0.0.7") 74 | pkg :: ParseV (PackageName, Version) 75 | pkg s = do 76 | "pkg:":p:v:_ <- return $ words s 77 | p' <- packageName p 78 | v' <- version v 79 | return (p', v') 80 | 81 | -- | 82 | -- >>> testVs (display *** display) (pkgs "pref-ver: HSlippyMap 0.1.0.0\npkg: xtest 0.2 b# 211591\npkg: xturtle 0.0.1 b# 211594\npkg: xturtle 0.0.2 b# 211597\n") 83 | -- ("xtest","0.2") 84 | -- ("xturtle","0.0.1") 85 | -- ("xturtle","0.0.2") 86 | pkgs :: ParseV [(PackageName, Version)] 87 | pkgs = Just . mapMaybe pkg . lines 88 | 89 | -- | 90 | -- -- >>> testVs (display *** map display) (pkgs "pref-ver: HSlippyMap 0.1.0.0\npkg: xtest 0.2 b# 211591\npkg: xturtle 0.0.1 b# 211594\npkg: xturtle 0.0.2 b# 211597\n") 91 | -- -- ("xtest",["0.2"]) 92 | -- -- ("xturtle",["0.0.1","0.0.2"]) 93 | -- 94 | versionMap :: ParseV VersionMap 95 | versionMap = fmap merge . pkgs 96 | where 97 | merge :: [(PackageName, Version)] -> [(PackageName, [Version])] 98 | merge = map (package &&& versions) . groupBy same_package 99 | 100 | same_package :: (PackageName, Version) -> (PackageName, Version) -> Bool 101 | same_package = (==) `on` fst 102 | 103 | package :: [(PackageName, Version)] -> PackageName 104 | package = fst . head 105 | 106 | versions :: [(PackageName, Version)] -> [Version] 107 | versions = map snd 108 | 109 | 110 | parseVersionMap :: String -> VersionMap 111 | parseVersionMap = fromJust . versionMap 112 | 113 | readVersionMap :: IO VersionMap 114 | readVersionMap = do 115 | path <- getVersionPath 116 | parseVersionMap <$> readFile path 117 | -------------------------------------------------------------------------------- /src/VersionFile/Parser/Test.hs: -------------------------------------------------------------------------------- 1 | -- | Simplify doctests by pretty-printing results. 2 | module VersionFile.Parser.Test where 3 | 4 | 5 | -- | Print the result if there is one. 6 | -- >>> testV id $ return 4 7 | -- 4 8 | testV :: Show s => (a -> s) -> Maybe a -> IO () 9 | testV _ Nothing = putStrLn "Nothing" 10 | testV show' (Just x) = print (show' x) 11 | 12 | -- | Print each result on a separate line. 13 | -- >>> testVs id $ return [1, 2, 3] 14 | -- 1 15 | -- 2 16 | -- 3 17 | testVs :: Show s => (a -> s) -> Maybe [a] -> IO () 18 | testVs _ Nothing = putStrLn "Nothing" 19 | testVs show' (Just xs) = mapM_ (print . show') xs 20 | -------------------------------------------------------------------------------- /src/VersionFile/Parser/Types.hs: -------------------------------------------------------------------------------- 1 | -- | The monad in which parseVersionMap is most easily expressed. 2 | module VersionFile.Parser.Types where 3 | 4 | 5 | -- A much simpler monad stack than for CabalFile.Parser :) 6 | type ParseV a = String -> Maybe a 7 | -------------------------------------------------------------------------------- /src/VersionFile/Types.hs: -------------------------------------------------------------------------------- 1 | -- | To represent a version map, 2 | -- that is, which version numbers exist for each package. 3 | module VersionFile.Types where 4 | 5 | import Distribution.Package (PackageName) 6 | import Distribution.Version (Version) 7 | 8 | 9 | -- A simple association list. Profile before you optimize :) 10 | type VersionMap = [(PackageName, [Version])] 11 | 12 | restricted_to :: VersionMap -> [PackageName] -> VersionMap 13 | restricted_to v packages = filter (go . fst) v 14 | where 15 | go :: PackageName -> Bool 16 | go = (`elem` packages) 17 | -------------------------------------------------------------------------------- /tests/capitalization/Hello.hs: -------------------------------------------------------------------------------- 1 | module Hello where 2 | 3 | hello :: IO () 4 | hello = putStrLn "hello" 5 | -------------------------------------------------------------------------------- /tests/capitalization/cabal.expected: -------------------------------------------------------------------------------- 1 | Name: capitalization 2 | Version: 0.1.0.0 3 | Build-Type: Simple 4 | Cabal-Version: >=1.10 5 | 6 | Library 7 | Build-Depends: base >=4.6, 8 | containers -any, 9 | 10 | mtl >=2.2 11 | Exposed-Modules: Hello 12 | -------------------------------------------------------------------------------- /tests/capitalization/cabal.in: -------------------------------------------------------------------------------- 1 | Name: capitalization 2 | Version: 0.1.0.0 3 | Build-Type: Simple 4 | Cabal-Version: >=1.10 5 | 6 | Library 7 | Build-Depends: base >= 4.6, 8 | containers -any, 9 | 10 | mtl 11 | Exposed-Modules: Hello 12 | -------------------------------------------------------------------------------- /tests/hello/Hello.hs: -------------------------------------------------------------------------------- 1 | module Hello where 2 | 3 | hello :: IO () 4 | hello = putStrLn "hello" 5 | -------------------------------------------------------------------------------- /tests/hello/cabal.expected: -------------------------------------------------------------------------------- 1 | name: hello 2 | version: 0.1.0.0 3 | build-type: Simple 4 | cabal-version: >=1.10 5 | 6 | library 7 | build-depends: base >=4.6, 8 | containers -any, 9 | 10 | mtl >=2.2 11 | exposed-modules: Hello 12 | -------------------------------------------------------------------------------- /tests/hello/cabal.in: -------------------------------------------------------------------------------- 1 | name: hello 2 | version: 0.1.0.0 3 | build-type: Simple 4 | cabal-version: >=1.10 5 | 6 | library 7 | build-depends: base >= 4.6, 8 | containers -any, 9 | 10 | mtl 11 | exposed-modules: Hello 12 | --------------------------------------------------------------------------------