git.iko.soy/typeable/cabal2nix
on master help sign in
hackage2nix.hs: fix GHC and hlint warnings
a4ad9d1Peter Simons
src/hackage2nix.hs+22−24
compare with master
unifiedsplit
@@ -2,26 +2,25 @@
2
2
3module Main where
3module Main where
4
4
5+import Control.DeepSeq
5import Control.Monad.IfElse
6import Control.Monad.IfElse
6import Control.Monad.Reader
7import Control.Monad.Reader
7import Control.Monad.State.Strict hiding ( State )
8import Control.Monad.State.Strict hiding ( State )
9+import Data.Char
10+import Data.List ( intercalate )
11+import qualified Data.Map as Map
8import Data.Maybe
12import Data.Maybe
9−import qualified Data.Set as Set
10import Data.Monoid
13import Data.Monoid
11−import Distribution.Version
14+import qualified Distribution.Compat.ReadP as Parse
12import Distribution.Compiler
15import Distribution.Compiler
13import Distribution.Hackage.DB
16import Distribution.Hackage.DB
14import Distribution.PackageDescription.Configuration
17import Distribution.PackageDescription.Configuration
15import Distribution.System
18import Distribution.System
16import Distribution.Text
19import Distribution.Text
20+import Distribution.Version
17import Options.Applicative
21import Options.Applicative
18import System.IO
22import System.IO
19−import Data.List ( reverse, intercalate )
20import Text.PrettyPrint ( text )
23import Text.PrettyPrint ( text )
21−import qualified Distribution.Compat.ReadP as Parse
22−import Data.Char
23−import qualified Data.Map as Map
24−import Control.DeepSeq
25
24
26data Options = Options
25data Options = Options
27 { verbose :: Bool
26 { verbose :: Bool
@@ -91,7 +90,7 @@ incDepth f = local (\cfg -> cfg { _recursionDepth = 1 + _recursionDepth cfg }) f
91run :: Compile a -> IO a
90run :: Compile a -> IO a
92run f = runCompiler f Options
91run f = runCompiler f Options
93 { verbose = True, overlay = []
92 { verbose = True, overlay = []
94− , compiler = CompilerId GHC (Version {versionBranch = [7,8,2], versionTags = []})
93+ , compiler = CompilerId GHC Version {versionBranch = [7,8,2], versionTags = []}
95 }
94 }
96
95
97main :: IO ()
96main :: IO ()
@@ -129,24 +128,22 @@ resolve dep@(Dependency pkgname@(PackageName name) versionRange) = do
129 vdb <- resolveName pkgname
128 vdb <- resolveName pkgname
130 msgInfo $ "resolve: " ++ name ++ " has versions: " ++ displayList (keys vdb)
129 msgInfo $ "resolve: " ++ name ++ " has versions: " ++ displayList (keys vdb)
131 let matches = Distribution.Hackage.DB.filterWithKey (\k _ -> k `withinRange` versionRange) vdb
130 let matches = Distribution.Hackage.DB.filterWithKey (\k _ -> k `withinRange` versionRange) vdb
132− case Distribution.Hackage.DB.null matches of
131+ if Distribution.Hackage.DB.null matches
133− True -> fail $ "resolve: cannot satisfy " ++ display dep ++ " from versions " ++ displayList (keys vdb)
132+ then fail $ "resolve: cannot satisfy " ++ display dep ++ " from versions " ++ displayList (keys vdb)
134− False -> do msgInfo $ "resolve: " ++ display dep ++ " matches versions: " ++ displayList (keys matches)
133+ else do msgInfo $ "resolve: " ++ display dep ++ " matches versions: " ++ displayList (keys matches)
135− return matches
134+ return matches
136
135
137addPackage :: Dependency -> Compile ()
136addPackage :: Dependency -> Compile ()
138−addPackage dep@(Dependency name vers) = do
137+addPackage dep@(Dependency name _) = do
139 msgInfo $ "try to register " ++ display dep
138 msgInfo $ "try to register " ++ display dep
140 known <- gets $ \(State pkgDb) -> dep `isKnownPackage` pkgDb
139 known <- gets $ \(State pkgDb) -> dep `isKnownPackage` pkgDb
141− case known of
140+ unless known $ do
142− True -> return ()
143− False -> do
144− vdb <- resolve dep
141+ vdb <- resolve dep
145− r <- compile (last (elems vdb))
142+ r <- compile (last (elems vdb))
146− case r of
143+ case r of
147− Left missingDeps -> incDepth $ do mapM_ addPackage (Prelude.filter (\(Dependency n _) -> n /= name) missingDeps)
144+ Left missingDeps -> incDepth $ do mapM_ addPackage (Prelude.filter (\(Dependency n _) -> n /= name) missingDeps)
148− addPackage dep
145+ addPackage dep
149− Right (pdesc, _) -> do registerPackage (packageId pdesc)
146+ Right (pdesc, _) -> registerPackage (packageId pdesc)
150
147
151isKnownPackage :: Dependency -> Map PackageName Version -> Bool
148isKnownPackage :: Dependency -> Map PackageName Version -> Bool
152isKnownPackage (Dependency name versionRange) pkgDb =
149isKnownPackage (Dependency name versionRange) pkgDb =
@@ -158,7 +155,7 @@ compile :: GenericPackageDescription -> Compile (Either [Dependency] (PackageDes
158compile gpdesc = do
155compile gpdesc = do
159 let PackageIdentifier name vers = packageId gpdesc
156 let PackageIdentifier name vers = packageId gpdesc
160 knownPackages <- gets (\(State pkgDb) -> force $ Map.insert name vers pkgDb)
157 knownPackages <- gets (\(State pkgDb) -> force $ Map.insert name vers pkgDb)
161− platformId <- return (Platform X86_64 Linux)
158+ let platformId = Platform X86_64 Linux
162 compilerId <- asks _compiler
159 compilerId <- asks _compiler
163 return $ finalizePackageDescription
160 return $ finalizePackageDescription
164 ([] :: FlagAssignment)
161 ([] :: FlagAssignment)
@@ -171,7 +168,7 @@ compile gpdesc = do
171registerPackage :: PackageIdentifier -> Compile ()
168registerPackage :: PackageIdentifier -> Compile ()
172registerPackage pkgid@(PackageIdentifier name vers) = do
169registerPackage pkgid@(PackageIdentifier name vers) = do
173 msgNote $ "add " ++ display pkgid
170 msgNote $ "add " ++ display pkgid
174− modify' $ \(State db) -> State $!! (Map.insert name vers db)
171+ modify' $ \(State db) -> State (Map.insert name vers db)
175
172
176buildPackageSet :: Compile ()
173buildPackageSet :: Compile ()
177buildPackageSet = do
174buildPackageSet = do
@@ -227,4 +224,5 @@ corePackages = Prelude.map (fromJust . simpleParse)
227instance NFData State where
224instance NFData State where
228 rnf (State db) = rnf db
225 rnf (State db) = rnf db
229
226
227+modify' :: (State -> State) -> Compile ()
230modify' f = get >>= \st -> put $!! f st
228modify' f = get >>= \st -> put $!! f st