@@ -1,68 +1,38 @@
11{-# LANGUAGE Rank2Types #-}
22
3−module Main where
3+module Main ( main ) where
44
5−import Control.DeepSeq
5+import Cabal2Nix.Generate
6+import Cabal2Nix.Name
7+import Cabal2Nix.Package
68import Control.Monad.IfElse
79import Control.Monad.Reader
810import Control.Monad.State.Strict hiding ( State )
9−import Data.Char
10−import Data.List ( intercalate )
1111import qualified Data.Map as Map
12−import Data.Maybe
1312import Data.Monoid
14−import qualified Distribution.Compat.ReadP as Parse
15−import Distribution.Compiler
13+import qualified Data.Set as Set
1614import Distribution.Hackage.DB
17−import Distribution.PackageDescription.Configuration
18−import Distribution.System
15+import Distribution.NixOS.Derivation.Cabal
16+import Distribution.NixOS.PrettyPrinting hiding ( (<>) )
1917import Distribution.Text
20−import Distribution.Version
2118import Options.Applicative
2219import System.IO
23−import Text.PrettyPrint ( text )
2420
2521data Options = Options
2622 { verbose :: Bool
27− , overlay :: [FilePath]
28− , compiler :: CompilerId
2923 }
3024 deriving (Show)
3125
3226data Config = Config
3327 { _verbose :: Bool
3428 , _hackage :: Hackage
35− , _recursionDepth :: Int
36− , _compiler :: CompilerId
3729 }
3830 deriving (Show)
3931
40−newtype Nixpkg = Nixpkg String
41− deriving (Eq, Ord, Read, Show)
42−
43−instance Text Nixpkg where
44− disp (Nixpkg name) = text name
45− parse = do
46− ns <- Parse.sepBy1 component (Parse.char '-')
47− return (Nixpkg (intercalate "-" ns))
48− where
49− -- Each component must contain an alphabetic character, to avoid
50− -- ambiguity in identifiers like foo-1 (the 1 is the version number).
51− component :: Parse.ReadP r String
52− component = do
53− cs <- Parse.munch1 isAlphaNum
54− if all isDigit cs then Parse.pfail else return cs
55−
56−data State = State (Map PackageName Version)
57− deriving (Show)
58−
59−type Compile a = MonadIO m => StateT State (ReaderT Config m) a
32+type Compile a = MonadIO m => StateT () (ReaderT Config m) a
6033
6134yell :: String -> Compile ()
62−yell msg = do
63− d <- asks _recursionDepth
64− let prefix = replicate d ' '
65− liftIO (hPutStrLn stderr (prefix ++ msg))
35+yell = liftIO . hPutStrLn stderr
6636
6737msgInfo, msgNote, msgWarn :: String -> Compile ()
6838msgInfo = whenM (asks _verbose) . yell . showString "INFO: "
@@ -75,41 +45,22 @@ runCompiler f opts = do
7545 let cfg = Config
7646 { _verbose = verbose opts
7747 , _hackage = db
78− , _recursionDepth = 0
79− , _compiler = compiler opts
8048 }
81− st = State Map.empty
49+ st = ()
8250 f' = msgInfo (showString "options = " (show opts)) >> f
8351 runReaderT (evalStateT f' st) cfg
8452
85−incDepth :: Compile a -> Compile a
86−incDepth f = local (\cfg -> cfg { _recursionDepth = 1 + _recursionDepth cfg }) f
87−
8853-- | A convenience variant of 'runCompiler' that's probably good enough
8954-- for quick-fire testing in ghci.
9055run :: Compile a -> IO a
91−run f = runCompiler f Options
92− { verbose = True, overlay = []
93− , compiler = CompilerId GHC Version {versionBranch = [7,8,2], versionTags = []}
94− }
56+run f = runCompiler f Options { verbose = True }
9557
9658main :: IO ()
9759main = execParser mainOptions >>= runCompiler buildPackageSet
9860 where
99− parseCompilerId :: Parser CompilerId
100− parseCompilerId = option (eitherReader (\s -> maybe (Left (show s ++ " is no valid compiler id")) Right (simpleParse s)))
101− ( long "compiler"
102− <> help "identifier of the compiler"
103− <> metavar "COMPILER-ID"
104− <> value (fromJust (simpleParse "ghc-7.8.3"))
105− <> showDefaultWith display
106− )
107−
10861 parseOptions :: Parser Options
10962 parseOptions = Options
11063 <$> switch (long "verbose" <> help "enable detailed progress diagnostics")
111− <*> many (strOption (long "overlay" <> help "path(s) to local Hackage overlay" <> metavar "PATH"))
112− <*> parseCompilerId
11364
11465 mainOptions :: ParserInfo Options
11566 mainOptions = info (helper <*> parseOptions)
@@ -117,112 +68,16 @@ main = execParser mainOptions >>= runCompiler buildPackageSet
11768 <> header "hackage2nix -- convert the Hackage database into Nix build instructions"
11869 )
11970
120−resolveName :: PackageName -> Compile (Map Version GenericPackageDescription)
121−resolveName (PackageName name) = do
122− versions <- asks (Distribution.Hackage.DB.lookup name . _hackage)
123− maybe (fail $ "resolve: unknown package " ++ show name) return versions
124−
125−resolve :: Dependency -> Compile (Map Version GenericPackageDescription)
126−resolve dep@(Dependency pkgname@(PackageName name) versionRange) = do
127− vdb <- resolveName pkgname
128− msgInfo $ "resolve: " ++ name ++ " has versions: " ++ displayList (keys vdb)
129− let matches = Distribution.Hackage.DB.filterWithKey (\k _ -> k `withinRange` versionRange) vdb
130− if Distribution.Hackage.DB.null matches
131− then fail $ "resolve: cannot satisfy " ++ display dep ++ " from versions " ++ displayList (keys vdb)
132− else do msgInfo $ "resolve: " ++ display dep ++ " matches versions: " ++ displayList (keys matches)
133− return matches
134−
135−addPackage :: Dependency -> Compile ()
136−addPackage dep@(Dependency name _) = do
137− msgInfo $ "try to register " ++ display dep
138− known <- gets $ \(State pkgDb) -> dep `isKnownPackage` pkgDb
139− unless known $ do
140− vdb <- resolve dep
141− r <- compile (last (elems vdb))
142− case r of
143− Left missingDeps -> incDepth $ do mapM_ addPackage (Prelude.filter (\(Dependency n _) -> n /= name) missingDeps)
144− addPackage dep
145− Right (pdesc, _) -> registerPackage (packageId pdesc)
146−
147−isKnownPackage :: Dependency -> Map PackageName Version -> Bool
148−isKnownPackage (Dependency name versionRange) pkgDb =
149− case Map.lookup name pkgDb of
150− Nothing -> False
151− Just v -> v `withinRange` versionRange
152−
153−compile :: GenericPackageDescription -> Compile (Either [Dependency] (PackageDescription, FlagAssignment))
154−compile gpdesc = do
155− let PackageIdentifier name vers = packageId gpdesc
156− knownPackages <- gets (\(State pkgDb) -> force $ Map.insert name vers pkgDb)
157− let platformId = Platform X86_64 Linux
158− compilerId <- asks _compiler
159− return $ finalizePackageDescription
160− ([] :: FlagAssignment)
161− (`isKnownPackage` knownPackages)
162− platformId
163− compilerId
164− [] -- [ thisPackageVersion (PackageIdentifier n v) | (n,v) <- Map.toList knownPackages ]
165− gpdesc
166−
167−registerPackage :: PackageIdentifier -> Compile ()
168−registerPackage pkgid@(PackageIdentifier name vers) = do
169− msgNote $ "add " ++ display pkgid
170− modify' $ \(State db) -> State (Map.insert name vers db)
71+nixAttr :: String -> Version -> String
72+nixAttr name ver = toNixName name ++ "_" ++ [ if c == '.' then '_' else c | c <- display ver ]
17173
17274buildPackageSet :: Compile ()
17375buildPackageSet = do
174− mapM_ registerPackage corePackages
175− mapM_ (addPackage . fromJust . simpleParse)
176− [
177− -- commit te specific packages
178− -- here comes the actual payload
179− "hledger"
180− , "hledger-web"
181− , "Agda"
182− -- , "git-annex"
183− ]
184−
185− State pkgDb <- get
186− mapM_ (liftIO . putStrLn . display . uncurry PackageIdentifier) (Map.toList pkgDb)
187−
188−displayList :: Text a => [a] -> String
189−displayList = intercalate ", " . Prelude.map display
190−
191−corePackages :: [PackageIdentifier]
192−corePackages = Prelude.map (fromJust . simpleParse)
193− [ "array-0.5.0.0"
194− , "base-4.7.0.1"
195− , "binary-0.7.1.0"
196− , "bin-package-db-0.0.0.0"
197− , "bytestring-0.10.4.0"
198− , "Cabal-1.18.1.3"
199− , "containers-0.5.5.1"
200− , "deepseq-1.3.0.2"
201− , "directory-1.2.1.0"
202− , "filepath-1.3.0.2"
203− , "ghc-7.8.3"
204− , "ghc-prim-0.3.1.0"
205− , "haskeline-0.7.1.2"
206− , "haskell2010-1.1.2.0"
207− , "haskell98-2.0.0.3"
208− , "hoopl-3.10.0.1"
209− , "hpc-0.6.0.1"
210− , "integer-gmp-0.5.1.0"
211− , "old-locale-1.0.0.6"
212− , "old-time-1.1.0.2"
213− , "pretty-1.1.1.1"
214− , "process-1.2.0.0"
215− , "rts-1.0"
216− , "template-haskell-2.9.0.0"
217− , "terminfo-0.4.0.0"
218− , "time-1.4.2"
219− , "transformers-0.3.0.0"
220− , "unix-2.7.0.1"
221− , "xhtml-3000.2.1"
222− ]
223−
224−instance NFData State where
225− rnf (State db) = rnf db
226−
227−modify' :: (State -> State) -> Compile ()
228−modify' f = get >>= \st -> put $!! f st
76+ db <- asks _hackage
77+ forM_ (Map.toList db) $ \(name, versions) -> do
78+ let latestVersion = Set.findMax (Map.keysSet versions)
79+ pkgDescription = (Map.!) versions latestVersion
80+ srcSpec <- liftIO $ sourceFromHackage Nothing (name ++ "-" ++ display latestVersion)
81+ let nixExpr = (cabal2nix pkgDescription) { src = srcSpec }
82+ liftIO $ print $ hang (text (nixAttr name latestVersion) <+> equals) 2 (disp nixExpr) <> semi
83+ fail "yo"