nix-tools (empty) → 0.1.0.0
raw patch · 26 files changed
+2316/−0 lines, 26 filesdep +Cabaldep +aesondep +basesetup-changed
Dependencies added: Cabal, aeson, base, base16-bytestring, bytestring, containers, cryptohash-sha256, data-fix, deepseq, directory, extra, filepath, hackage-db, hnix, hpack, http-client, http-client-tls, http-types, microlens, microlens-aeson, nix-tools, optparse-applicative, prettyprinter, process, tar, text, time, transformers, unordered-containers, vector, yaml, zlib
Files
- ChangeLog.md +5/−0
- LICENSE +30/−0
- Setup.hs +2/−0
- cabal2nix/Main.hs +117/−0
- hackage2nix/Main.hs +123/−0
- hashes2nix/Main.hs +49/−0
- lib/Cabal2Nix.hs +426/−0
- lib/Cabal2Nix/Plan.hs +56/−0
- lib/Cabal2Nix/Util.hs +37/−0
- lib/Distribution/Nixpkgs/Fetch.hs +155/−0
- lts2nix/Main.hs +59/−0
- nix-tools.cabal +184/−0
- plan2nix/Main.hs +6/−0
- plan2nix/Plan2Nix.hs +255/−0
- plan2nix/Plan2Nix/CLI.hs +34/−0
- plan2nix/Plan2Nix/Cache.hs +36/−0
- plan2nix/Plan2Nix/Plan.hs +47/−0
- plan2nix/Plan2Nix/Project.hs +34/−0
- stack2nix/Main.hs +7/−0
- stack2nix/Stack2nix.hs +208/−0
- stack2nix/Stack2nix/CLI.hs +40/−0
- stack2nix/Stack2nix/Cache.hs +35/−0
- stack2nix/Stack2nix/External/Resolve.hs +48/−0
- stack2nix/Stack2nix/Project.hs +39/−0
- stack2nix/Stack2nix/Stack.hs +221/−0
- truncate-index/Main.hs +63/−0
+ ChangeLog.md view
@@ -0,0 +1,5 @@+# Revision history for cabal2nixe++## 0.1.0.0 -- YYYY-mm-dd++* First version. Released on an unsuspecting world.
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2018, Moritz Angermann++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Moritz Angermann nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ cabal2nix/Main.hs view
@@ -0,0 +1,117 @@+{-# LANGUAGE LambdaCase, RecordWildCards #-}++module Main where++import System.Environment (getArgs)++import System.Directory+import System.FilePath+import Control.Monad++import Nix.Pretty (prettyNix)+import Nix.Expr++import Data.String (fromString)++import Cabal2Nix+import Cabal2Nix.Util++import Data.Text.Prettyprint.Doc (Doc)+import Data.Text.Prettyprint.Doc.Render.Text (hPutDoc)+import System.IO+import Distribution.Nixpkgs.Fetch+import Control.Monad.IO.Class+import Control.Monad.Trans.Maybe+import Data.ByteString (ByteString)++import Data.List (isPrefixOf, isSuffixOf)++import qualified Hpack+import qualified Hpack.Config as Hpack+import qualified Hpack.Render as Hpack+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+++writeDoc :: FilePath -> Doc ann -> IO ()+writeDoc file doc =+ do handle <- openFile file WriteMode+ hPutDoc handle doc+ hClose handle++main :: IO ()+main = getArgs >>= \case+ [url,hash] | "http" `isPrefixOf` url ->+ let subdir = "." in+ fetch (\dir -> cabalFromPath url hash subdir $ dir </> subdir)+ (Source url mempty UnknownHash subdir) >>= \case+ (Just (DerivationSource{..}, genBindings)) -> genBindings derivHash+ _ -> return ()+ [path,file] -> doesDirectoryExist file >>= \case+ False -> print . prettyNix =<< cabal2nix False MinimalDetails (Just (Path path)) (OnDisk file)+ True -> print . prettyNix =<< cabalexprs file+ [file] -> doesDirectoryExist file >>= \case+ False -> print . prettyNix =<< cabal2nix False MinimalDetails (Just (Path ".")) (OnDisk file)+ True -> print . prettyNix =<< cabalexprs file+ _ -> putStrLn "call with cabalfile (Cabal2Nix file.cabal)."++cabalFromPath+ :: String -- URL+ -> String -- Revision+ -> FilePath -- Subdir+ -> FilePath -- Local Directory+ -> MaybeT IO (String -> IO ())+cabalFromPath url rev subdir path = do+ d <- liftIO $ doesDirectoryExist path+ unless d $ fail ("not a directory: " ++ path)+ cabalFiles <- liftIO $ findCabalFiles path+ when (length cabalFiles > 1) $ fail ("multiple cabal files detected: " ++ show cabalFiles)+ return $ \sha256 ->+ void . forM cabalFiles $ \cabalFile -> do+ let pkg = cabalFilePkgName cabalFile+ subdir' = if subdir == "." then Nothing+ else Just subdir+ src = Just $ Git url rev (Just sha256) subdir'+ print . prettyNix =<< cabal2nix False MinimalDetails src cabalFile++findCabalFiles :: FilePath -> IO [CabalFile]+findCabalFiles path = doesFileExist (path </> Hpack.packageConfig) >>= \case+ False -> fmap (OnDisk . (path </>)) . filter (isSuffixOf ".cabal") <$> listDirectory path+ True -> do+ mbPkg <- Hpack.readPackageConfig Hpack.defaultDecodeOptions {Hpack.decodeOptionsTarget = path </> Hpack.packageConfig}+ case mbPkg of+ Left e -> error e+ Right r ->+ return $ [InMemory (Just Hpack)+ (Hpack.decodeResultCabalFile r)+ (encodeUtf8 $ Hpack.renderPackage [] (Hpack.decodeResultPackage r))]++ where encodeUtf8 :: String -> ByteString+ encodeUtf8 = T.encodeUtf8 . T.pack+++expr :: FilePath -> String -> String -> IO (Binding NExpr)+expr p pkg version = do+ let cabal = OnDisk $ p </> pkg </> version </> pkg <.> "cabal"+ -- prefix packages by the truncated sha256+ -- over their name to prevent case insensitivity+ -- issues. We truncate just to be in line with+ -- how the /nix/store path's look.+ pkg' = (take 32 $ sha256 pkg) ++ "-" ++ pkg+ nix = pkg' </> version <.> "nix"+ version' = fromString . quoted $ version+ doesFileExist (cabalFilePath cabal) >>= \case+ True ->+ do createDirectoryIfMissing True pkg'+ writeDoc nix =<< prettyNix <$> cabal2nix False MinimalDetails Nothing cabal+ pure $ version' $= mkRelPath nix+ False -> pure $ version' $= mkNull++cabalexprs :: FilePath -> IO NExpr+cabalexprs p =+ do pkgs <- listDirectories p+ fmap mkNonRecSet . forM pkgs $ \pkg ->+ do versions <- listDirectories (p </> pkg)+ let pkg' = fromString . quoted $ pkg+ fmap (bindTo pkg' . mkNonRecSet) . forM versions $ \version ->+ expr p pkg version
+ hackage2nix/Main.hs view
@@ -0,0 +1,123 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE NamedFieldPuns #-}++module Main where++import Cabal2Nix+import Cabal2Nix.Util ( quoted )+import Control.Applicative ( liftA2 )+import Control.Monad.Trans.State.Strict+import Crypto.Hash.SHA256 ( hashlazy )+import qualified Data.ByteString.Base16 as Base16+import qualified Data.ByteString.Char8 as BS+import qualified Data.ByteString.Lazy as BL+import Data.Foldable ( toList+ , for_+ )+import Data.List ( intersperse )+import Data.Map ( Map )+import qualified Data.Map as Map+import Data.Semigroup as Sem+import Data.Sequence ( Seq )+import qualified Data.Sequence as Seq+import Data.String ( IsString(fromString)+ )+import Data.Text ( Text )+import Data.Text.Encoding ( decodeUtf8 )+import Distribution.Hackage.DB ( hackageTarball )+import qualified Distribution.Hackage.DB.Parsed+ as P+import qualified Distribution.Hackage.DB.Unparsed+ as U+import Distribution.Pretty ( prettyShow+ , Pretty+ )+import Distribution.Types.PackageName ( PackageName )+import Distribution.Types.Version ( Version )+import Nix.Expr+import Nix.Pretty ( prettyNix )+import System.Directory ( createDirectoryIfMissing+ )+import System.Environment ( getArgs )+import System.FilePath ( (</>)+ , (<.>)+ )++main :: IO ()+main = do+ [out] <- getArgs+ db <- U.readTarball Nothing =<< hackageTarball++ let (defaultNix, cabalFiles) =+ runState (fmap seqToSet $ foldMapWithKeyA package2nix db) mempty++ createDirectoryIfMissing False out+ writeFile (out </> "default.nix") $ show $ prettyNix defaultNix+ createDirectoryIfMissing False (out </> "hackage")++ for_ cabalFiles $ \(cabalFile, pname, path) -> do+ gpd <- cabal2nix False MinimalDetails Nothing $ InMemory Nothing pname $ BL.toStrict cabalFile+ writeFile (out </> path) $ show $ prettyNix gpd++type GPDWriter = State (Seq (BL.ByteString, String, FilePath))++newtype ApplicativeMonoid f a = ApplicativeMonoid { unApplicativeMonoid :: f a }+instance (Applicative f, Semigroup a) => Sem.Semigroup (ApplicativeMonoid f a) where+ ApplicativeMonoid a <> ApplicativeMonoid b = ApplicativeMonoid $ liftA2 (Sem.<>) a b+instance (Applicative f, Monoid a) => Monoid (ApplicativeMonoid f a) where+ mempty = ApplicativeMonoid $ pure mempty+ mappend = (Sem.<>)++foldMapWithKeyA+ :: (Applicative f, Monoid b) => (k -> a -> f b) -> Map k a -> f b+foldMapWithKeyA f =+ unApplicativeMonoid . Map.foldMapWithKey (\k -> ApplicativeMonoid . f k)++seqToSet :: Seq (Binding NExpr) -> NExpr+seqToSet = mkNonRecSet . toList++fromPretty :: (Pretty a, IsString b) => a -> b+fromPretty = fromString . prettyShow++package2nix :: PackageName -> U.PackageData -> GPDWriter (Seq (Binding NExpr))+package2nix pname (U.PackageData { U.versions }) = do+ versionBindings <- foldMapWithKeyA (version2nix pname) versions+ return $ Seq.singleton $ quoted (fromPretty pname) $= seqToSet versionBindings++version2nix+ :: PackageName -> Version -> U.VersionData -> GPDWriter (Seq (Binding NExpr))+version2nix pname vnum (U.VersionData { U.cabalFileRevisions, U.metaFile }) =+ do+ revisionBindings <- sequenceA+ $ zipWith (revBinding pname vnum) cabalFileRevisions [0 ..]+ return $ Seq.singleton $ quoted (fromPretty vnum) $= mkRecSet+ [ "sha256" $= mkStr+ (fromString $ P.parseMetaData pname vnum metaFile Map.! "sha256")+ , "revisions" $= mkNonRecSet+ ( fmap (uncurry ($=)) revisionBindings+ ++ ["default" $= (mkSym "revisions" @. fst (last revisionBindings))]+ )+ ]++revBinding+ :: PackageName+ -> Version+ -> BL.ByteString+ -> Integer+ -> GPDWriter (Text, NExpr)+revBinding pname vnum cabalFile revNum = do+ let qualifiedName = mconcat $ intersperse+ "-"+ [prettyPname, fromPretty vnum, revName, BS.unpack cabalHash]+ revName :: (Semigroup a, IsString a) => a+ revName = "r" <> fromString (show revNum)+ revPath = "." </> "hackage" </> qualifiedName <.> "nix"+ prettyPname = fromPretty pname+ cabalHash = Base16.encode $ hashlazy cabalFile+ modify' $ mappend $ Seq.singleton+ (cabalFile, prettyPname ++ ".cabal", revPath)+ return $ (,) revName $ mkNonRecSet+ [ "outPath" $= mkRelPath revPath+ , "revNum" $= mkInt revNum+ , "sha256" $= mkStr (decodeUtf8 cabalHash)+ ]
+ hashes2nix/Main.hs view
@@ -0,0 +1,49 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+module Main where++import System.Environment (getArgs)+import System.Directory+import System.FilePath+import Control.Monad++import Nix.Pretty (prettyNix)+import Nix.Expr++import Data.Aeson+import Lens.Micro+import Lens.Micro.Aeson++import Data.String (fromString)++import Cabal2Nix.Util++main :: IO ()+main = getArgs >>= \case+ [path] -> do+ print . prettyNix =<< hashes path+ _ -> putStrLn "call with /path/to/all-cabal-hashes (Hashes2Nix /path/to/all-cabal-hashes)"++hash :: FilePath -> String -> String -> IO (Binding NExpr)+hash p pkg version = do+ let json = p </> pkg </> version </> pkg <.> "json"+ version' = fromString . quoted $ version+ doesFileExist json >>= \case+ True -> decodeValue json >>= \case+ Just obj -> case obj ^? key "package-hashes" . key "SHA256" . _String of+ Just hash -> pure $ version' $= mkStr hash+ Nothing -> pure $ version' $= mkNull+ Nothing -> pure $ version' $= mkNull+ False -> pure $ version' $= mkNull+ where decodeValue :: FilePath -> IO (Maybe Value)+ decodeValue = decodeFileStrict'++hashes :: FilePath -> IO NExpr+hashes p =+ do pkgs <- listDirectories p+ fmap mkNonRecSet . forM pkgs $ \pkg ->+ do versions <- listDirectories (p </> pkg)+ let pkg' = fromString . quoted $ pkg+ fmap (bindTo pkg' . mkNonRecSet) . forM versions $ \version ->+ hash p pkg version+
+ lib/Cabal2Nix.hs view
@@ -0,0 +1,426 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE FlexibleInstances #-}++module Cabal2Nix (cabal2nix, gpd2nix, Src(..), CabalFile(..), CabalFileGenerator(..), cabalFilePath, cabalFilePkgName, CabalDetailLevel(..)) where++import Distribution.PackageDescription.Parsec (readGenericPackageDescription, parseGenericPackageDescription, runParseResult)+import Distribution.Verbosity (normal)+import Distribution.Text (disp)+import Distribution.Pretty (pretty)+import Data.Char (toUpper)+import System.FilePath+import Data.ByteString (ByteString)+import Data.Maybe (catMaybes, maybeToList)++import Distribution.Types.CondTree+import Distribution.Types.Library+import Distribution.Types.ForeignLib+import Distribution.PackageDescription hiding (Git)+import Distribution.Types.Dependency+import Distribution.Types.ExeDependency+import Distribution.Types.LegacyExeDependency+import Distribution.Types.PkgconfigDependency+import Distribution.Types.PkgconfigName+import Distribution.Types.VersionRange+import Distribution.Compiler+import Distribution.Types.PackageName (PackageName, mkPackageName)+import Distribution.Simple.BuildToolDepends (desugarBuildTool)+import Distribution.ModuleName (ModuleName)+import qualified Distribution.ModuleName as ModuleName++import Data.String (fromString, IsString)++-- import Distribution.Types.GenericPackageDescription+-- import Distribution.Types.PackageDescription+import Distribution.Types.PackageId+--import Distribution.Types.Condition+import Distribution.Types.UnqualComponentName+import Nix.Expr+import Data.Fix(Fix(..))+import Data.Text (Text)++import Cabal2Nix.Util (quoted, selectOr, mkThrow)++data Src+ = Path FilePath+ | Git String String (Maybe String) (Maybe String)+ deriving Show++pkgs, hsPkgs, pkgconfPkgs, flags :: Text+pkgs = "pkgs"+hsPkgs = "hsPkgs"+pkgconfPkgs = "pkgconfPkgs"+flags = "flags"++buildDepError, sysDepError, pkgConfDepError, exeDepError, legacyExeDepError, buildToolDepError :: Text+buildDepError = "buildDepError"+sysDepError = "sysDepError"+pkgConfDepError = "pkgConfDepError"+exeDepError = "exeDepError"+legacyExeDepError = "legacyExeDepError"+buildToolDepError = "buildToolDepError"++($//?) :: NExpr -> Maybe NExpr -> NExpr+lhs $//? (Just e) = lhs $// e+lhs $//? Nothing = lhs++data CabalFileGenerator+ = Hpack+ deriving Show++data CabalFile+ = OnDisk FilePath+ | InMemory (Maybe CabalFileGenerator) FilePath ByteString+ deriving Show+++cabalFilePath :: CabalFile -> String+cabalFilePath (OnDisk fp) = fp+cabalFilePath (InMemory _ fp _) = fp++cabalFilePkgName :: CabalFile -> String+cabalFilePkgName = dropExtension . takeFileName . cabalFilePath++genExtra :: CabalFileGenerator -> NExpr+genExtra Hpack = mkNonRecSet [ "cabal-generator" $= mkStr "hpack" ]++data CabalDetailLevel = MinimalDetails | FullDetails deriving (Show, Eq)++cabal2nix :: Bool -> CabalDetailLevel -> Maybe Src -> CabalFile -> IO NExpr+cabal2nix isLocal fileDetails src = \case+ (OnDisk path) -> gpd2nix isLocal fileDetails src Nothing+ <$> readGenericPackageDescription normal path+ (InMemory gen _ body) -> gpd2nix isLocal fileDetails src (genExtra <$> gen)+ <$> case runParseResult (parseGenericPackageDescription body) of+ (_, Left (_, err)) -> error ("Failed to parse in-memory cabal file: " ++ show err)+ (_, Right desc) -> pure desc++gpd2nix :: Bool -> CabalDetailLevel -> Maybe Src -> Maybe NExpr -> GenericPackageDescription -> NExpr+gpd2nix isLocal fileDetails src extra gpd = mkLets errorFunctions $ mkFunction args $ toNixGenericPackageDescription isLocal fileDetails gpd $//? (toNix <$> src) $//? extra+ where args :: Params NExpr+ args = mkParamset [ ("system", Nothing)+ , ("compiler", Nothing)+ , ("flags", Nothing)+ , (pkgs, Nothing)+ , (hsPkgs, Nothing)+ , (pkgconfPkgs, Nothing)]+ True++errorFunctions :: [Binding NExpr]+errorFunctions =+ [ buildDepError $= mkFunction "pkg" (mkThrow $+ Fix $ NStr $ Indented 0+ [ Plain "The Haskell package set does not contain the package: "+ , Antiquoted "pkg"+ , Plain " (build dependency).\n\n"+ , Plain haskellUpdateSnippet+ ])+ , sysDepError $= mkFunction "pkg" (mkThrow $+ Fix $ NStr $ Indented 0+ [ Plain "The Nixpkgs package set does not contain the package: "+ , Antiquoted "pkg"+ , Plain " (system dependency).\n\n"+ , Plain systemUpdateSnippet+ ])+ , pkgConfDepError $= mkFunction "pkg" (mkThrow $+ Fix $ NStr $ Indented 0+ [ Plain "The pkg-conf packages does not contain the package: "+ , Antiquoted "pkg"+ , Plain " (pkg-conf dependency).\n\n"+ , Plain "You may need to augment the pkg-conf package mapping in haskell.nix so that it can be found."+ ])+ , exeDepError $= mkFunction "pkg" (mkThrow $+ Fix $ NStr $ Indented 0+ [ Plain "The local executable components do not include the component: "+ , Antiquoted "pkg"+ , Plain " (executable dependency)."+ ])+ , legacyExeDepError $= mkFunction "pkg" (mkThrow $+ Fix $ NStr $ Indented 0+ [ Plain "The Haskell package set does not contain the package: "+ , Antiquoted "pkg"+ , Plain " (executable dependency).\n\n"+ , Plain haskellUpdateSnippet+ ])+ , buildToolDepError $= mkFunction "pkg" (mkThrow $+ Fix $ NStr $ Indented 0+ [ Plain "Neither the Haskell package set or the Nixpkgs package set contain the package: "+ , Antiquoted "pkg"+ , Plain " (build tool dependency).\n\n"+ , Plain "If this is a system dependency:\n"+ , Plain systemUpdateSnippet+ , Plain "\n\n"+ , Plain "If this is a Haskell dependency:\n"+ , Plain haskellUpdateSnippet+ ])+ ]+ where+ systemUpdateSnippet = "You may need to augment the system package mapping in haskell.nix so that it can be found."+ haskellUpdateSnippet = "If you are using Stackage, make sure that you are using a snapshot that contains the package. Otherwise you may need to update the Hackage snapshot you are using, usually by updating haskell.nix."++class IsComponent a where+ getBuildInfo :: a -> BuildInfo+ getMainPath :: a -> Maybe FilePath+ getMainPath _ = Nothing+ modules :: a -> [ModuleName]+ modules = otherModules . getBuildInfo++instance IsComponent Library where+ getBuildInfo = libBuildInfo+ modules a = otherModules (getBuildInfo a)+ <> exposedModules a+ <> signatures a++instance IsComponent ForeignLib where+ getBuildInfo = foreignLibBuildInfo++instance IsComponent Executable where+ getBuildInfo = buildInfo+ getMainPath Executable {modulePath = p} = Just p++instance IsComponent TestSuite where+ getBuildInfo = testBuildInfo+ getMainPath TestSuite {testInterface = (TestSuiteExeV10 _ p)} = Just p+ getMainPath _ = Nothing++instance IsComponent Benchmark where+ getBuildInfo = benchmarkBuildInfo++--- Clean the Tree from empty nodes+-- CondBranch is empty if the true and false branch are empty.+shakeTree :: (Foldable t, Foldable f) => CondTree v (t c) (f a) -> Maybe (CondTree v (t c) (f a))+shakeTree (CondNode d c bs) = case (null d, null bs') of+ (True, True) -> Nothing+ _ -> Just (CondNode d c bs')+ where bs' = catMaybes (shakeBranch <$> bs)++shakeBranch :: (Foldable t, Foldable f) => CondBranch v (t c) (f a) -> Maybe (CondBranch v (t c) (f a))+shakeBranch (CondBranch c t f) = case (shakeTree t, f >>= shakeTree) of+ (Nothing, Nothing) -> Nothing+ (Nothing, Just f') -> shakeBranch (CondBranch (CNot c) f' Nothing)+ (Just t', f') -> Just (CondBranch c t' f')++--- String helper+transformFst :: (Char -> Char) -> String -> String+transformFst _ [] = []+transformFst f (x:xs) = f x : xs+capitalize :: String -> String+capitalize = transformFst toUpper++--- Turn something into a NExpr++class ToNixExpr a where+ toNix :: a -> NExpr++class ToNixBinding a where+ toNixBinding :: a -> Binding NExpr++instance ToNixExpr Src where+ toNix (Path p) = mkRecSet [ "src" $= applyMkDefault (mkRelPath p) ]+ toNix (Git url rev mbSha256 mbPath)+ = mkNonRecSet $+ [ "src" $= applyMkDefault (mkSym pkgs @. "fetchgit" @@ mkNonRecSet+ [ "url" $= mkStr (fromString url)+ , "rev" $= mkStr (fromString rev)+ , "sha256" $= case mbSha256 of+ Just sha256 -> mkStr (fromString sha256)+ Nothing -> mkNull+ ])+ ] <>+ [ "postUnpack"+ $= mkStr (fromString $ "sourceRoot+=/" <> root <> "; echo source root reset to $sourceRoot")+ | Just root <- [mbPath] ]++applyMkDefault :: NExpr -> NExpr+applyMkDefault expr = mkSym pkgs @. "lib" @. "mkDefault" @@ expr++instance ToNixExpr PackageIdentifier where+ toNix ident = mkNonRecSet [ "name" $= mkStr (fromString (show (disp (pkgName ident))))+ , "version" $= mkStr (fromString (show (disp (pkgVersion ident))))]++toNixPackageDescription :: Bool -> CabalDetailLevel -> PackageDescription -> NExpr+toNixPackageDescription isLocal detailLevel pd = mkNonRecSet $+ [ "specVersion" $= mkStr (fromString (show (disp (specVersion pd))))+ , "identifier" $= toNix (package pd)+ , "license" $= mkStr (fromString (show (pretty (license pd))))++ , "copyright" $= mkStr (fromString (copyright pd))+ , "maintainer" $= mkStr (fromString (maintainer pd))+ , "author" $= mkStr (fromString (author pd))++ , "homepage" $= mkStr (fromString (homepage pd))+ , "url" $= mkStr (fromString (pkgUrl pd))++ , "synopsis" $= mkStr (fromString (synopsis pd))+ , "description" $= mkStr (fromString (description pd))++ , "buildType" $= mkStr (fromString (show (pretty (buildType pd))))+ ] +++ [ "isLocal" $= mkBool True | isLocal+ ] +++ [ "setup-depends" $= toNix (BuildToolDependency . depPkgName <$> deps) | Just deps <- [setupDepends <$> setupBuildInfo pd ]] +++ if detailLevel == MinimalDetails+ then []+ else+ [ "detailLevel" $= mkStr (fromString (show detailLevel))+ , "licenseFiles" $= toNix (licenseFiles pd)+ , "dataDir" $= mkStr (fromString (dataDir pd))+ , "dataFiles" $= toNix (dataFiles pd)+ , "extraSrcFiles" $= toNix (extraSrcFiles pd)+ , "extraTmpFiles" $= toNix (extraTmpFiles pd)+ , "extraDocFiles" $= toNix (extraDocFiles pd)+ ]++newtype SysDependency = SysDependency { unSysDependency :: String } deriving (Show, Eq, Ord)+newtype BuildToolDependency = BuildToolDependency { unBuildToolDependency :: PackageName } deriving (Show, Eq, Ord)++mkSysDep :: String -> SysDependency+mkSysDep = SysDependency++toNixGenericPackageDescription :: Bool -> CabalDetailLevel -> GenericPackageDescription -> NExpr+toNixGenericPackageDescription isLocal detailLevel gpd = mkNonRecSet+ [ "flags" $= (mkNonRecSet . fmap toNixBinding $ genPackageFlags gpd)+ , "package" $= toNixPackageDescription isLocal detailLevel (packageDescription gpd)+ , "components" $= components ]+ where _packageName :: IsString a => a+ _packageName = fromString . show . disp . pkgName . package . packageDescription $ gpd+ component :: IsComponent comp => UnqualComponentName -> CondTree ConfVar [Dependency] comp -> Binding NExpr+ component unQualName comp+ = quoted name $=+ mkNonRecSet (+ [ "depends" $= toNix deps | Just deps <- [shakeTree . fmap ( targetBuildDepends . getBuildInfo) $ comp ] ] +++ [ "libs" $= toNix deps | Just deps <- [shakeTree . fmap ( fmap mkSysDep . extraLibs . getBuildInfo) $ comp ] ] +++ [ "frameworks" $= toNix deps | Just deps <- [shakeTree . fmap ( fmap mkSysDep . frameworks . getBuildInfo) $ comp ] ] +++ [ "pkgconfig" $= toNix deps | Just deps <- [shakeTree . fmap ( pkgconfigDepends . getBuildInfo) $ comp ] ] +++ [ "build-tools" $= toNix deps | Just deps <- [shakeTree . fmap ( toolDeps . getBuildInfo) $ comp ] ] +++ [ "buildable" $= boolTreeToNix (and <$> b) | Just b <- [shakeTree . fmap ((:[]) . buildable . getBuildInfo) $ comp ] ] +++ if detailLevel == MinimalDetails+ then []+ else+ [ "modules" $= toNix mods | Just mods <- [shakeTree . fmap (fmap ModuleName.toFilePath . modules) $ comp ] ] +++ [ "asmSources" $= toNix src | Just src <- [shakeTree . fmap (asmSources . getBuildInfo) $ comp ] ] +++ [ "cmmSources" $= toNix src | Just src <- [shakeTree . fmap (cmmSources . getBuildInfo) $ comp ] ] +++ [ "cSources" $= toNix src | Just src <- [shakeTree . fmap (cSources . getBuildInfo) $ comp ] ] +++ [ "cxxSources" $= toNix src | Just src <- [shakeTree . fmap (cxxSources . getBuildInfo) $ comp ] ] +++ [ "jsSources" $= toNix src | Just src <- [shakeTree . fmap (jsSources . getBuildInfo) $ comp ] ] +++ [ "hsSourceDirs" $= toNix dir | Just dir <- [shakeTree . fmap (hsSourceDirs . getBuildInfo) $ comp ] ] +++ [ "includeDirs" $= toNix dir | Just dir <- [shakeTree . fmap (includeDirs . getBuildInfo) $ comp] ] +++ [ "includes" $= toNix dir | Just dir <- [shakeTree . fmap (includes . getBuildInfo) $ comp] ] +++ [ "mainPath" $= toNix p | Just p <- [shakeTree . fmap (maybeToList . getMainPath) $ comp] ])+ where name = fromString $ unUnqualComponentName unQualName+ toolDeps = getToolDependencies (packageDescription gpd)+ toBuildToolDep (ExeDependency pkg _ _) = BuildToolDependency pkg+ getToolDependencies pkg bi =+ map toBuildToolDep (buildToolDepends bi)+ <> map (\led -> maybe (guess led) toBuildToolDep $ desugarBuildTool pkg led) (buildTools bi)+ guess (LegacyExeDependency n _) = BuildToolDependency (mkPackageName n)+ components = mkNonRecSet $+ [ component "library" lib | Just lib <- [condLibrary gpd] ] +++ (bindTo "sublibs" . mkNonRecSet <$> filter (not . null) [ uncurry component <$> condSubLibraries gpd ]) +++ (bindTo "foreignlibs" . mkNonRecSet <$> filter (not . null) [ uncurry component <$> condForeignLibs gpd ]) +++ (bindTo "exes" . mkNonRecSet <$> filter (not . null) [ uncurry component <$> condExecutables gpd ]) +++ (bindTo "tests" . mkNonRecSet <$> filter (not . null) [ uncurry component <$> condTestSuites gpd ]) +++ (bindTo "benchmarks" . mkNonRecSet <$> filter (not . null) [ uncurry component <$> condBenchmarks gpd ])++-- WARNING: these use functions bound at he top level in the GPD expression, they won't work outside it++instance ToNixExpr Dependency where+ toNix d = selectOr (mkSym hsPkgs) (mkSelector $ quoted pkg) (mkSym buildDepError @@ mkStr pkg)+ where+ pkg = fromString . show . pretty . depPkgName $ d++instance ToNixExpr SysDependency where+ toNix d = selectOr (mkSym pkgs) (mkSelector $ quoted pkg) (mkSym sysDepError @@ mkStr pkg)+ where+ pkg = fromString . unSysDependency $ d++instance ToNixExpr PkgconfigDependency where+ toNix (PkgconfigDependency name _versionRange) = selectOr (mkSym pkgconfPkgs) (mkSelector $ quoted pkg) (mkSym pkgConfDepError @@ mkStr pkg)+ where+ pkg = fromString . unPkgconfigName $ name++instance ToNixExpr ExeDependency where+ toNix (ExeDependency pkgName' _unqualCompName _versionRange) = selectOr (mkSym "exes") (mkSelector $ pkg) (mkSym exeDepError @@ mkStr pkg)+ where+ pkg = fromString . show . pretty $ pkgName'++instance ToNixExpr BuildToolDependency where+ toNix (BuildToolDependency pkgName') =+ -- TODO once https://github.com/haskell-nix/hnix/issues/52+ -- is reolved use something like:+ -- [nix| hsPkgs.buildPackages.$((pkgName)) or pkgs.buildPackages.$((pkgName)) ]+ selectOr (mkSym hsPkgs) buildPackagesDotName+ (selectOr (mkSym pkgs) buildPackagesDotName (mkSym buildToolDepError @@ mkStr pkg))+ where+ pkg = fromString . show . pretty $ pkgName'+ buildPackagesDotName = mkSelector "buildPackages" <> mkSelector pkg++instance ToNixExpr LegacyExeDependency where+ toNix (LegacyExeDependency name _versionRange) = selectOr (mkSym hsPkgs) (mkSelector $ quoted pkg) (mkSym legacyExeDepError @@ mkStr pkg)+ where+ pkg = fromString name++instance {-# OVERLAPPABLE #-} ToNixExpr String where+ toNix = mkStr . fromString++instance {-# OVERLAPS #-} ToNixExpr a => ToNixExpr [a] where+ toNix = mkList . fmap toNix++instance ToNixExpr ConfVar where+ toNix (OS os) = mkSym "system" @. (fromString . ("is" ++) . capitalize . show . pretty $ os)+ toNix (Arch arch) = mkSym "system" @. (fromString . ("is" ++) . capitalize . show . pretty $ arch)+ toNix (Flag flag) = mkSym flags @. (fromString . show . pretty $ flag)+ toNix (Impl flavour range) = toNix flavour $&& toNix (projectVersionRange range)++instance ToNixExpr CompilerFlavor where+ toNix flavour = mkSym "compiler" @. (fromString . ("is" ++) . capitalize . show . pretty $ flavour)++instance ToNixExpr (VersionRangeF VersionRange) where+ toNix AnyVersionF = mkBool True+ toNix (ThisVersionF ver) = mkSym "compiler" @. "version" @. "eq" @@ mkStr (fromString (show (disp ver)))+ toNix (LaterVersionF ver) = mkSym "compiler" @. "version" @. "gt" @@ mkStr (fromString (show (disp ver)))+ toNix (OrLaterVersionF ver) = mkSym "compiler" @. "version" @. "ge" @@ mkStr (fromString (show (disp ver)))+ toNix (EarlierVersionF ver) = mkSym "compiler" @. "version" @. "lt" @@ mkStr (fromString (show (disp ver)))+ toNix (OrEarlierVersionF ver) = mkSym "compiler" @. "version" @. "le" @@ mkStr (fromString (show (disp ver)))+ toNix (WildcardVersionF _ver) = mkBool False+-- toNix (MajorBoundVersionF ver) = mkSym "compiler" @. "version" @. "eq" @@ mkStr (fromString (show (disp ver)))+ toNix (IntersectVersionRangesF v1 v2) = toNix (projectVersionRange v1) $&& toNix (projectVersionRange v2)+ toNix x = error $ "ToNixExpr VersionRange for `" ++ show x ++ "` not implemented!"++instance ToNixExpr a => ToNixExpr (Condition a) where+ toNix (Var a) = toNix a+ toNix (Lit b) = mkBool b+ toNix (CNot c) = mkNot (toNix c)+ toNix (COr l r) = toNix l $|| toNix r+ toNix (CAnd l r) = toNix l $&& toNix r++instance (Foldable t, ToNixExpr (t a), ToNixExpr v, ToNixExpr c) => ToNixExpr (CondBranch v c (t a)) where+ toNix (CondBranch c t Nothing) = case toNix t of+ (Fix (NList [e])) -> mkSym pkgs @. "lib" @. "optional" @@ toNix c @@ e+ e -> mkSym pkgs @. "lib" @. "optionals" @@ toNix c @@ e+ toNix (CondBranch _c t (Just f)) | toNix t == toNix f = toNix t+ toNix (CondBranch c t (Just f)) = mkIf (toNix c) (toNix t) (toNix f)++instance (Foldable t, ToNixExpr (t a), ToNixExpr v, ToNixExpr c) => ToNixExpr (CondTree v c (t a)) where+ toNix (CondNode d _c []) = toNix d+ toNix (CondNode d _c bs) | null d = foldl1 ($++) (fmap toNix bs)+ | otherwise = foldl ($++) (toNix d) (fmap toNix bs)++boolBranchToNix :: (ToNixExpr v, ToNixExpr c) => CondBranch v c Bool -> NExpr+boolBranchToNix (CondBranch _c t Nothing) | boolTreeToNix t == mkBool True = mkBool True+boolBranchToNix (CondBranch c t Nothing) = mkIf (toNix c) (boolTreeToNix t) (mkBool True)+boolBranchToNix (CondBranch _c t (Just f)) | boolTreeToNix t == boolTreeToNix f = boolTreeToNix t+boolBranchToNix (CondBranch c t (Just f)) = mkIf (toNix c) (boolTreeToNix t) (boolTreeToNix f)++boolTreeToNix :: (ToNixExpr v, ToNixExpr c) => CondTree v c Bool -> NExpr+boolTreeToNix (CondNode False _c _bs) = mkBool False+boolTreeToNix (CondNode True _c bs) =+ case filter (/= mkBool True) (fmap boolBranchToNix bs) of+ [] -> mkBool True+ bs' -> foldl1 ($&&) bs'++instance ToNixBinding Flag where+ toNixBinding (MkFlag name _desc def _manual) = (fromString . show . pretty $ name) $= mkBool def++
+ lib/Cabal2Nix/Plan.hs view
@@ -0,0 +1,56 @@+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-}++module Cabal2Nix.Plan+where++import Cabal2Nix.Util ( quoted+ , bindPath+ )+import Data.HashMap.Strict ( HashMap )+import qualified Data.HashMap.Strict as Map+import Data.List.NonEmpty ( NonEmpty (..) )+import Data.Text ( Text )+import qualified Data.Text as Text+import Nix.Expr++type Version = Text+type Revision = Text -- Can be: rNUM, cabal file sha256, or "default"++data Plan = Plan+ { packages :: HashMap Text (Maybe Package)+ , compilerVersion :: Text+ , compilerPackages :: HashMap Text (Maybe Version)+ }++data Package = Package+ { packageVersion :: Version+ , packageRevision :: Maybe Revision+ , packageFlags :: HashMap Text Bool+ }++plan2nix :: Plan -> NExpr+plan2nix (Plan { packages, compilerVersion, compilerPackages }) =+ mkFunction "hackage"+ . mkNonRecSet+ $ [ "packages" $= (mkNonRecSet $ uncurry bind =<< Map.toList quotedPackages)+ , "compiler" $= mkNonRecSet+ [ "version" $= mkStr compilerVersion+ , "nix-name" $= mkStr ("ghc" <> Text.filter (/= '.') compilerVersion)+ , "packages" $= mkNonRecSet (fmap (uncurry bind') $ Map.toList $ mapKeys quoted compilerPackages)+ ]+ ]+ where+ quotedPackages = mapKeys quoted packages+ bind pkg (Just (Package { packageVersion, packageRevision, packageFlags })) =+ let verExpr = mkSym "hackage" @. pkg @. quoted packageVersion+ revExpr = verExpr @. "revisions" @. maybe "default" quoted packageRevision+ flagBindings = Map.foldrWithKey+ (\fname val acc -> bindPath (pkg :| ["flags", fname]) (mkBool val) : acc)+ []+ packageFlags+ in revBinding pkg revExpr : flagBindings+ bind pkg Nothing = [revBinding pkg mkNull]+ revBinding pkg revExpr = bindPath (pkg :| ["revision"]) revExpr+ bind' pkg ver = pkg $= maybe mkNull mkStr ver+ mapKeys f = Map.fromList . fmap (\(k, v) -> (f k, v)) . Map.toList
+ lib/Cabal2Nix/Util.hs view
@@ -0,0 +1,37 @@+{-# LANGUAGE OverloadedStrings #-}+module Cabal2Nix.Util where++import System.Directory+import System.FilePath++import Control.Monad+import Data.String (IsString)++import Data.ByteString.Char8 (pack, unpack)+import Data.Text (Text)+import Crypto.Hash.SHA256 (hash)+import qualified Data.ByteString.Base16 as Base16++import Data.List.NonEmpty (NonEmpty)+import Data.Fix(Fix(..))+import Nix.Expr++listDirectories :: FilePath -> IO [FilePath]+listDirectories p =+ filter (/= ".git") <$> listDirectory p+ >>= filterM (doesDirectoryExist . (p </>))++quoted :: (IsString a, Semigroup a) => a -> a+quoted str = "\"" <> str <> "\""++selectOr :: NExpr -> NAttrPath NExpr -> NExpr -> NExpr+selectOr obj path alt = Fix (NSelect obj path (Just $ alt))++mkThrow :: NExpr -> NExpr+mkThrow msg = (mkSym "builtins" @. "throw") @@ msg++sha256 :: String -> String+sha256 = unpack . Base16.encode . hash . pack++bindPath :: NonEmpty Text -> NExpr -> Binding NExpr+bindPath ks e = NamedVar (fmap StaticKey ks) e nullPos
+ lib/Distribution/Nixpkgs/Fetch.hs view
@@ -0,0 +1,155 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE DeriveGeneric #-}++module Distribution.Nixpkgs.Fetch+ ( Source(..)+ , Hash(..)+ , DerivationSource(..), fromDerivationSource+ , fetch+ , fetchWith+ ) where++import Control.Applicative+import Control.DeepSeq+import Control.Monad+import Control.Monad.IO.Class+import Control.Monad.Trans.Maybe+import Data.Aeson+import qualified Data.ByteString.Lazy.Char8 as BS+import GHC.Generics ( Generic )+import System.Directory+import System.Environment+import System.Exit+import System.IO+import System.Process++-- | A source is a location from which we can fetch, such as a HTTP URL, a GIT URL, ....+data Source = Source+ { sourceUrl :: String -- ^ URL to fetch from.+ , sourceRevision :: String -- ^ Revision to use. For protocols where this doesn't make sense (such as HTTP), this+ -- should be the empty string.+ , sourceHash :: Hash -- ^ The expected hash of the source, if available.+ , sourceCabalDir :: String -- ^ Directory where Cabal file is found.+ } deriving (Show, Eq, Ord, Generic)++instance NFData Source++data Hash = Certain String | Guess String | UnknownHash+ deriving (Show, Eq, Ord, Generic)++instance NFData Hash++isUnknown :: Hash -> Bool+isUnknown UnknownHash = True+isUnknown _ = False++hashToList :: Hash -> [String]+hashToList (Certain s) = [s]+hashToList _ = []++-- | A source for a derivation. It always needs a hash and also has a protocol attached to it (url, git, svn, ...).+-- A @DerivationSource@ also always has it's revision fully resolved (not relative revisions like @master@, @HEAD@, etc).+data DerivationSource = DerivationSource+ { derivKind :: String -- ^ The kind of the source. The name of the build-support fetch derivation should be fetch<kind>.+ , derivUrl :: String -- ^ URL to fetch from.+ , derivRevision :: String -- ^ Revision to use. Leave empty if the fetcher doesn't support revisions.+ , derivHash :: String -- ^ The hash of the source.+ }+ deriving (Show, Eq, Ord, Generic)++instance NFData DerivationSource++instance FromJSON DerivationSource where+ parseJSON (Object o) = DerivationSource (error "undefined DerivationSource.kind")+ <$> o .: "url"+ <*> o .: "rev"+ <*> o .: "sha256"+ parseJSON _ = error "invalid DerivationSource"++fromDerivationSource :: DerivationSource -> Source+fromDerivationSource DerivationSource{..} = Source derivUrl derivRevision (Certain derivHash) "."++-- | Fetch a source, trying any of the various nix-prefetch-* scripts.+fetch :: forall a. (String -> MaybeT IO a) -- ^ This function is passed the output path name as an argument.+ -- It should return 'Nothing' if the file doesn't match the expected format.+ -- This is required, because we cannot always check if a download succeeded otherwise.+ -> Source -- ^ The source to fetch from.+ -> IO (Maybe (DerivationSource, a)) -- ^ The derivation source and the result of the processing function. Returns Nothing if the download failed.+fetch f = runMaybeT . fetchers where+ fetchers :: Source -> MaybeT IO (DerivationSource, a)+ fetchers source = msum . (fetchLocal source :) $ map (\fetcher -> fetchWith fetcher source >>= process)+ [ (False, "url", [])+ , (True, "git", ["--fetch-submodules"])+ , (True, "hg", [])+ , (True, "svn", [])+ , (True, "bzr", [])+ ]++ -- | Remove '/' from the end of the path. Nix doesn't accept paths that+ -- end in a slash.+ stripSlashSuffix :: String -> String+ stripSlashSuffix = reverse . dropWhile (== '/') . reverse++ fetchLocal :: Source -> MaybeT IO (DerivationSource, a)+ fetchLocal src = do+ let path = stripSlashSuffix $ stripPrefix "file://" $ sourceUrl src+ existsFile <- liftIO $ doesFileExist path+ existsDir <- liftIO $ doesDirectoryExist path+ guard $ existsDir || existsFile+ let path' | '/' `elem` path = path+ | otherwise = "./" ++ path+ process (DerivationSource "" path' "" "", path') <|> localArchive path'++ localArchive :: FilePath -> MaybeT IO (DerivationSource, a)+ localArchive path = do+ absolutePath <- liftIO $ canonicalizePath path+ unpacked <- snd <$> fetchWith (False, "url", ["--unpack"]) (Source ("file://" ++ absolutePath) "" UnknownHash ".")+ process (DerivationSource "" absolutePath "" "", unpacked)++ process :: (DerivationSource, FilePath) -> MaybeT IO (DerivationSource, a)+ process (derivSource, file) = (,) derivSource <$> f file++-- | Like 'fetch', but allows to specify which script to use.+fetchWith :: (Bool, String, [String]) -> Source -> MaybeT IO (DerivationSource, FilePath)+fetchWith (supportsRev, kind, addArgs) source = do+ unless ((sourceRevision source /= "") || isUnknown (sourceHash source) || not supportsRev) $+ liftIO (hPutStrLn stderr "** need a revision for VCS when the hash is given. skipping.") >> mzero++ MaybeT $ liftIO $ do+ envs <- getEnvironment+ (Nothing, Just stdoutH, _, processH) <- createProcess (proc script args)+ { env = Just $ ("PRINT_PATH", "1") : envs+ , std_in = Inherit+ , std_err = Inherit+ , std_out = CreatePipe+ }++ exitCode <- waitForProcess processH+ case exitCode of+ ExitFailure _ -> return Nothing+ ExitSuccess -> do+ buf <- BS.hGetContents stdoutH+ let (l:ls) = reverse (BS.lines buf)+ buf' = BS.unlines (reverse ls)+ case length ls of+ 0 -> return Nothing+ 1 -> return (Just (DerivationSource kind (sourceUrl source) "" (BS.unpack (head ls)) , sourceUrl source))+ _ -> case eitherDecode buf' of+ Left err -> error ("invalid JSON: " ++ err ++ " in " ++ show buf')+ Right ds -> return (Just (ds { derivKind = kind }, BS.unpack l))+ where++ script :: String+ script = "nix-prefetch-" ++ kind++ args :: [String]+ args = addArgs ++ sourceUrl source : [ sourceRevision source | supportsRev ] ++ hashToList (sourceHash source)++stripPrefix :: Eq a => [a] -> [a] -> [a]+stripPrefix prefix as+ | prefix' == prefix = stripped+ | otherwise = as+ where+ (prefix', stripped) = splitAt (length prefix) as
+ lts2nix/Main.hs view
@@ -0,0 +1,59 @@+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+module Main where++import Data.Foldable (toList)+import System.Environment (getArgs)++import Data.Yaml (decodeFileEither)++import Nix.Pretty (prettyNix)+import Nix.Expr++import Data.Aeson+import qualified Data.HashMap.Strict as Map+import Lens.Micro+import Lens.Micro.Aeson++import Cabal2Nix.Plan++main :: IO ()+main = getArgs >>= \case+ [file] -> do+ print . prettyNix =<< ltsPackages file+ _ -> putStrLn "call with /path/to/lts.yaml (Lts2Nix /path/to/lts-X.Y.yaml)"++ltsPackages :: FilePath -> IO NExpr+ltsPackages lts = do+ evalue <- decodeFileEither lts+ case evalue of+ Left e -> error (show e)+ Right value -> pure $ plan2nix $ lts2plan value++lts2plan :: Value -> Plan+lts2plan lts = Plan { packages , compilerVersion , compilerPackages }+ where+ packages = mappend compilerPackages' $ fmap Just $ lts ^. key "packages" . _Object <&> \v -> Package+ { packageVersion = v ^. key "version" . _String+ , packageRevision = v ^? key "cabal-file-info" . key "hashes" . key "SHA256" . _String+ , packageFlags = Map.mapMaybe (^? _Bool) $ v ^. key "constraints" . key "flags" . _Object+ }+ compilerVersion = lts ^. key "system-info" . key "ghc-version" . _String+ compilerPackages =+ (lts ^. key "system-info" . key "core-packages" . _Object <&> (Just . (^. _String)))+ <> Map.fromList+ [ (p, Nothing) -- core-executables is just a list of+ -- exe names shipped with GHC, which+ -- lots of packages depend on+ -- (e.g. hsc2hs)+ | p <- toList $ lts ^. key "system-info" . key "core-executables" . _Array <&> (^. _String)+ ]+ compilerPackages' = fmap+ (fmap $ \v -> Package+ { packageVersion = v+ , packageRevision = Nothing+ , packageFlags = Map.empty+ }+ )+ compilerPackages
+ nix-tools.cabal view
@@ -0,0 +1,184 @@+name: nix-tools+version: 0.1.0.0+synopsis: cabal/stack to nix translation tools+description: A set of tools to aid in trating stack and cabal projects into nix expressions.+license: BSD3+license-file: LICENSE+author: Moritz Angermann+maintainer: moritz.angermann@gmail.com+-- copyright:+category: Distribution+build-type: Simple+extra-source-files: ChangeLog.md+cabal-version: >=1.10++library+ ghc-options: -Wall+ exposed-modules: Cabal2Nix+ , Cabal2Nix.Util+ , Cabal2Nix.Plan+ , Distribution.Nixpkgs.Fetch+ build-depends: base >=4 && <4.13+ , hnix+ , aeson+ , unordered-containers+ , process+ , deepseq+ , transformers+ , data-fix+ , Cabal >= 2.4+ , text+ , filepath+ , directory+ , bytestring+ , cryptohash-sha256+ , base16-bytestring+ , hpack+ hs-source-dirs: lib+ default-language: Haskell2010+++executable cabal-to-nix+ ghc-options: -Wall+ main-is: Main.hs+ build-depends: base >=4 && <4.13+ , transformers+ , bytestring+ , hpack+ , hnix+ , text+ , nix-tools+ , filepath+ , directory+ , prettyprinter+ hs-source-dirs: cabal2nix+ default-language: Haskell2010++executable hashes-to-nix+ ghc-options: -Wall+ main-is: Main.hs+ build-depends: base >=4 && <4.13+ , hnix+ , nix-tools+ , data-fix+ , aeson+ , microlens+ , microlens-aeson+ , text+ , filepath+ , directory+ hs-source-dirs: hashes2nix+ default-language: Haskell2010++executable plan-to-nix+ ghc-options: -Wall+ main-is: Main.hs+ other-modules: Plan2Nix+ , Plan2Nix.Cache+ , Plan2Nix.CLI+ , Plan2Nix.Project+ , Plan2Nix.Plan+ build-depends: base >=4 && <4.13+ , nix-tools+ , hnix+ , Cabal >= 2.4+ , text+ , hpack+ , unordered-containers+ , vector+ , aeson+ , microlens+ , microlens-aeson+ , optparse-applicative+ , prettyprinter+ , filepath+ , directory+ , bytestring+ , transformers+ , extra+ hs-source-dirs: plan2nix+ default-language: Haskell2010++executable hackage-to-nix+ ghc-options: -Wall+ main-is: Main.hs+ build-depends: base >=4 && <4.13+ , nix-tools+ , hackage-db+ , hnix+ , Cabal+ , containers+ , bytestring+ , text+ , cryptohash-sha256+ , base16-bytestring+ , filepath+ , directory+ , transformers+ hs-source-dirs: hackage2nix+ default-language: Haskell2010++executable lts-to-nix+ ghc-options: -Wall+ main-is: Main.hs+ build-depends: base >=4 && <4.13+ , nix-tools+ , hnix+ , yaml+ , aeson+ , microlens+ , microlens-aeson+ , text+ , filepath+ , directory+ , unordered-containers+ , Cabal+ hs-source-dirs: lts2nix+ default-language: Haskell2010++executable stack-to-nix+ ghc-options: -Wall+ main-is: Main.hs+ other-modules: Stack2nix+ , Stack2nix.Cache+ , Stack2nix.CLI+ , Stack2nix.External.Resolve+ , Stack2nix.Project+ , Stack2nix.Stack+ build-depends: base >=4 && <4.13+ , nix-tools+ , transformers+ , hnix+ , yaml+ , aeson+ , microlens+ , microlens-aeson+ , text+ , Cabal+ , vector+ , prettyprinter+ , directory+ , filepath+ , extra+ , hpack+ , bytestring+ , optparse-applicative+ , http-client-tls+ , http-client+ , http-types+ , unordered-containers+ hs-source-dirs: stack2nix+ default-language: Haskell2010++executable truncate-index+ ghc-options: -Wall+ main-is: Main.hs+ -- other-modules:+ build-depends: base+ , optparse-applicative+ , zlib+ , tar+ , bytestring+ , time+ hs-source-dirs: truncate-index+ default-language: Haskell2010
+ plan2nix/Main.hs view
@@ -0,0 +1,6 @@+module Main where+import Plan2Nix (doPlan2Nix)+import Plan2Nix.CLI (parsePlan2NixArgs)++main :: IO ()+main = parsePlan2NixArgs >>= doPlan2Nix
+ plan2nix/Plan2Nix.hs view
@@ -0,0 +1,255 @@+{-# LANGUAGE LambdaCase, OverloadedStrings, NamedFieldPuns, RecordWildCards #-}++module Plan2Nix+ ( doPlan2Nix+ , planexpr+ , plan2nix+ ) where++import Data.Aeson+import Data.Char ( isDigit )+import Data.HashMap.Strict ( HashMap )+import qualified Data.HashMap.Strict as Map+import Data.Maybe ( mapMaybe+ , isJust+ , fromMaybe+ )+import Data.List.NonEmpty ( NonEmpty (..) )+import qualified Data.Text as Text+import Data.Text ( Text )+import qualified Data.Vector as Vector+import Lens.Micro+import Lens.Micro.Aeson+import Nix.Expr+import Nix.Pretty ( prettyNix )+import System.Environment ( getArgs )++import Data.Text.Prettyprint.Doc (Doc)+import Data.Text.Prettyprint.Doc.Render.Text (hPutDoc)++import Distribution.Types.PackageId (PackageIdentifier(..))+import Distribution.Nixpkgs.Fetch (DerivationSource(..), Source(..), Hash(..), fetch)+import Distribution.Simple.Utils (shortRelativePath)++import Control.Monad.Trans.Maybe+import Control.Monad.IO.Class (liftIO)+import Control.Monad (unless, forM)+import Extra (unlessM)++import Cabal2Nix hiding (Git)+import qualified Cabal2Nix as C2N+import Cabal2Nix.Util+++import Plan2Nix.CLI (Args(..))+import Plan2Nix.Plan (Plan(..), PkgSrc(..), Package(..), Location(..))++import Plan2Nix.Cache (appendCache, cacheHits)+import Plan2Nix.Project++import System.FilePath ((<.>), (</>), takeDirectory, dropFileName)+import System.Directory (createDirectoryIfMissing, doesDirectoryExist, doesFileExist, getCurrentDirectory)+import System.IO (IOMode(..), openFile, hClose)+import Data.String (fromString)+++doPlan2Nix :: Args -> IO ()+doPlan2Nix args = do+ let pkgsNix = argOutputDir args </> "pkgs.nix"+ defaultNix = argOutputDir args </> "default.nix"+ pkgs <- planexpr args+ writeDoc pkgsNix (prettyNix pkgs)+ unlessM (doesFileExist defaultNix) $ do+ writeFile defaultNix defaultNixContents++planexpr :: Args -> IO NExpr+planexpr args =+ do evalue <- eitherDecodeFileStrict (argPlanJSON args)+ case evalue of+ Left e -> error (show e)+ Right value -> plan2nix args $ value2plan value++writeDoc :: FilePath -> Doc ann -> IO ()+writeDoc file doc =+ do handle <- openFile file WriteMode+ hPutDoc handle doc+ hClose handle++plan2nix :: Args -> Plan -> IO NExpr+plan2nix args (Plan { packages, extras, compilerVersion, compilerPackages }) = do+ -- TODO: this is an aweful hack and expects plan-to-nix to be+ -- called from the toplevel project directory.+ cwd <- getCurrentDirectory+ extrasNix <- fmap (mkNonRecSet . concat) . forM (Map.toList extras) $ \case+ (name, Just (Package v r flags (Just (LocalPath folder)))) ->+ do cabalFiles <- findCabalFiles folder+ forM cabalFiles $ \cabalFile ->+ let pkg = cabalFilePkgName cabalFile+ nix = ".plan.nix" </> pkg <.> "nix"+ nixFile = argOutputDir args </> nix+ src = Just . C2N.Path $ relPath </> ".." </> (shortRelativePath cwd folder)+ in do createDirectoryIfMissing True (takeDirectory nixFile)+ writeDoc nixFile =<<+ prettyNix <$> cabal2nix True (argDetailLevel args) src cabalFile+ return $ fromString pkg $= mkPath False nix+ (name, Just (Package v r flags (Just (DVCS (Git url rev) subdirs)))) ->+ fmap concat . forM subdirs $ \subdir ->+ do cacheHits <- liftIO $ cacheHits (argCacheFile args) url rev subdir+ case cacheHits of+ [] -> do+ fetch (\dir -> cabalFromPath url rev subdir $ dir </> subdir)+ (Source url rev UnknownHash subdir) >>= \case+ (Just (DerivationSource{..}, genBindings)) -> genBindings derivHash+ _ -> return []+ hits ->+ forM hits $ \( pkg, nix ) -> do+ return $ fromString pkg $= mkPath False nix+ _ -> return []+ let flags = concatMap (\case+ (name, Just (Package _v _r f _)) -> flags2nix name f+ _ -> []) $ Map.toList extras++ return $ mkNonRecSet [+ "pkgs" $= ("hackage" ==> mkNonRecSet (+ [ "packages" $= (mkNonRecSet $ uncurry bind =<< Map.toList quotedPackages)+ , "compiler" $= mkNonRecSet+ [ "version" $= mkStr compilerVersion+ , "nix-name" $= mkStr ("ghc" <> Text.filter (/= '.') compilerVersion)+ , "packages" $= mkNonRecSet (fmap (uncurry bind') $ Map.toList $ mapKeys quoted compilerPackages)+ ]+ ]))+ , "extras" $= ("hackage" ==> mkNonRecSet [ "packages" $= extrasNix ])+ , "modules" $= mkList [+ mkParamset [("lib", Nothing)] True ==> mkNonRecSet [ "packages" $= mkNonRecSet flags ]+ ]+ ]+ where+ quotedPackages = mapKeys quoted packages+ bind pkg (Just (Package { packageVersion, packageRevision, packageFlags })) =+ let verExpr = mkSym "hackage" @. pkg @. quoted packageVersion+ revExpr = verExpr @. "revisions" @. maybe "default" quoted packageRevision+ flagBindings = Map.foldrWithKey+ (\fname val acc -> bindPath (pkg :| ["flags", fname]) (mkBool val) : acc)+ []+ packageFlags+ in revBinding pkg revExpr : flagBindings+ bind pkg Nothing = [revBinding pkg mkNull]+ revBinding pkg revExpr = bindPath (pkg :| ["revision"]) revExpr+ bind' pkg ver = pkg $= maybe mkNull mkStr ver+ mapKeys f = Map.fromList . fmap (\(k, v) -> (f k, v)) . Map.toList++ relPath = shortRelativePath (argOutputDir args) (dropFileName (argCabalProject args))+ cabalFromPath+ :: String -- URL+ -> String -- Revision+ -> FilePath -- Subdir+ -> FilePath -- Local Directory+ -> MaybeT IO (String -> IO [Binding NExpr])+ cabalFromPath url rev subdir path = do+ d <- liftIO $ doesDirectoryExist path+ unless d $ fail ("not a directory: " ++ path)+ cabalFiles <- liftIO $ findCabalFiles path+ return $ \sha256 ->+ forM cabalFiles $ \cabalFile -> do+ let pkg = cabalFilePkgName cabalFile+ nix = ".plan.nix" </> pkg <.> "nix"+ nixFile = argOutputDir args </> nix+ subdir' = if subdir == "." then Nothing+ else Just subdir+ src = Just $ C2N.Git url rev (Just sha256) subdir'+ createDirectoryIfMissing True (takeDirectory nixFile)+ writeDoc nixFile =<<+ prettyNix <$> cabal2nix True (argDetailLevel args) src cabalFile+ liftIO $ appendCache (argCacheFile args) url rev subdir sha256 pkg nix+ return $ fromString pkg $= mkPath False nix++-- | Converts the project flags for a package flags into @{ packageName = { flags = { flagA = BOOL; flagB = BOOL; }; }; }@+flags2nix :: Text -> HashMap Text Bool -> [Binding NExpr]+flags2nix pkgName pkgFlags =+ [ quoted pkgName $= mkNonRecSet+ -- `mkOverride 900` is used here so that the default values will be replaced (they are 1000).+ -- Values without a priority are treated as 100 and will replace these ones.+ [ "flags" $= mkNonRecSet [ quoted flag $= ("lib" @. "mkOverride" @@ mkInt 900 @@ mkBool val)+ | (flag, val) <- Map.toList pkgFlags+ ]+ ]+ ]++value2plan :: Value -> Plan+value2plan plan = Plan { packages, extras, compilerVersion, compilerPackages }+ where+ packages = fmap Just $ filterInstallPlan $ \pkg -> case ( pkg ^. key "type" . _String+ , pkg ^. key "style" . _String) of+ (_, "global") -> Just $ Package+ { packageVersion = pkg ^. key "pkg-version" . _String+ , packageRevision = Nothing+ , packageFlags = Map.mapMaybe (^? _Bool) $ pkg ^. key "flags" . _Object+ , packageSrc = Nothing+ }+ (_, "inplace") -> Just $ Package+ { packageVersion = pkg ^. key "pkg-version" . _String+ , packageRevision = Nothing+ , packageFlags = Map.mapMaybe (^? _Bool) $ pkg ^. key "flags" . _Object+ , packageSrc = Nothing+ }+ -- Until we figure out how to force Cabal to reconfigure just about any package+ -- this here might be needed, so that we get the pre-existing packages as well.+ -- Or we would have to plug in our very custom minimal pkg-db as well.+ --+ -- The issue is that cabal claims anything in the package db as pre-existing and+ -- wants to reuse it if possible.+ ("pre-existing",_) -> Just $ Package+ { packageVersion = pkg ^. key "pkg-version" . _String+ , packageRevision = Nothing+ , packageFlags = Map.empty+ , packageSrc = Nothing+ }+ _ -> Nothing++ extras = fmap Just $ filterInstallPlan $ \pkg -> case ( pkg ^. key "type" . _String+ , pkg ^. key "style" . _String+ , pkg ^. key "pkg-src" . key "type" . _String+ , pkg ^. key "pkg-src" . _Object) of+ (_, "local", "local", _) -> Just $ Package+ { packageVersion = pkg ^. key "pkg-version" . _String+ , packageRevision = Nothing+ , packageFlags = Map.mapMaybe (^? _Bool) $ pkg ^. key "flags" . _Object+ , packageSrc = Just . LocalPath . Text.unpack $ pkg ^. key "pkg-src" . key "path" . _String+ }+ (_, "local", "source-repo", _) -> Just $ Package+ { packageVersion = pkg ^. key "pkg-version" . _String+ , packageRevision = Nothing+ , packageFlags = Map.mapMaybe (^? _Bool) $ pkg ^. key "flags" . _Object+ , packageSrc = Just . flip DVCS [ Text.unpack $ fromMaybe "." $ pkg ^? key "pkg-src" . key "source-repo" . key "subdir" . _String ] $+ Git ( Text.unpack $ pkg ^. key "pkg-src" . key "source-repo" . key "location" . _String )+ ( Text.unpack $ pkg ^. key "pkg-src" . key "source-repo" . key "tag" . _String )+ }+ _ -> Nothing++ compilerVersion = Text.dropWhile (not . isDigit) $ plan ^. key "compiler-id" . _String+ compilerPackages = fmap Just $ filterInstallPlan $ \pkg -> if isJust (pkg ^? key "style" . _String)+ then Nothing+ else Just $ pkg ^. key "pkg-version" . _String++ filterInstallPlan :: (Value -> Maybe b) -> HashMap Text b+ filterInstallPlan f =+ Map.fromList+ $ mapMaybe (\pkg -> (,) (pkg ^. key "pkg-name" . _String) <$> f pkg)+ $ Vector.toList (plan ^. key "install-plan" . _Array)+++defaultNixContents = unlines $+ [ "{ pkgs ? import <nixpkgs> {} }:"+ , ""+ , "let"+ , " haskell = import (builtins.fetchTarball https://github.com/input-output-hk/haskell.nix/archive/master.tar.gz) { inherit pkgs; };"+ , ""+ , " pkgSet = haskell.mkCabalProjectPkgSet {"+ , " plan-pkgs = import ./pkgs.nix;"+ , " pkg-def-extras = [];"+ , " modules = [];"+ , " };"+ , ""+ , "in"+ , " pkgSet.config.hsPkgs"+ ]
+ plan2nix/Plan2Nix/CLI.hs view
@@ -0,0 +1,34 @@+module Plan2Nix.CLI+ ( Args(..)+ , parsePlan2NixArgs+ ) where++import Options.Applicative hiding (option)+import Data.Semigroup ((<>))+import Cabal2Nix (CabalDetailLevel(..))++--------------------------------------------------------------------------------+-- CLI Arguments+data Args = Args+ { argOutputDir :: FilePath+ , argPlanJSON :: FilePath+ , argCabalProject :: FilePath+ , argCacheFile :: FilePath+ , argDetailLevel :: CabalDetailLevel+ } deriving Show++-- Argument Parser+args :: Parser Args+args = Args+ <$> strOption ( long "output" <> short 'o' <> metavar "DIR" <> help "Generate output in DIR" )+ <*> strOption ( long "plan-json" <> value "dist-newstyle/cache/plan.json" <> showDefault <> metavar "FILE" <> help "Override plan.json location" )+ <*> strOption ( long "cabal-project" <> value "cabal.project" <> showDefault <> metavar "FILE" <> help "Override path to cabal.project" )+ <*> strOption ( long "cache" <> value ".nix-tools.cache" <> showDefault <> metavar "FILE" <> help "Dependency cache file" )+ <*> flag MinimalDetails FullDetails ( long "full" <> help "Output details needed to determine what files are used" )++parsePlan2NixArgs :: IO Args+parsePlan2NixArgs = execParser opts+ where opts = info (args <**> helper)+ ( fullDesc+ <> progDesc "Generate a Nix expression for a Haskell package using Cabal"+ <> header "plan-to-nix - a stack to nix converter" )
+ plan2nix/Plan2Nix/Cache.hs view
@@ -0,0 +1,36 @@+-- Note: this is identical to Stack2nix.Cache+module Plan2Nix.Cache+ ( readCache+ , appendCache+ , cacheHits+ ) where++import Control.Exception (catch, SomeException(..))++readCache :: FilePath+ -> IO [( String -- url+ , String -- rev+ , String -- subdir+ , String -- sha256+ , String -- pkgname+ , String -- nixexpr-path+ )]+readCache f = fmap (toTuple . words) . lines <$> readFile f+ where toTuple [ url, rev, subdir, sha256, pkgname, exprPath ]+ = ( url, rev, subdir, sha256, pkgname, exprPath )++appendCache :: FilePath -> String -> String -> String -> String -> String -> String -> IO ()+appendCache f url rev subdir sha256 pkgname exprPath = do+ appendFile f $ unwords [ url, rev, subdir, sha256, pkgname, exprPath ]+ appendFile f "\n"++cacheHits :: FilePath -> String -> String -> String -> IO [ (String, String) ]+cacheHits f url rev subdir+ = do cache <- catch' (readCache f) (const (pure []))+ return [ ( pkgname, exprPath )+ | ( url', rev', subdir', sha256, pkgname, exprPath ) <- cache+ , url == url'+ , rev == rev'+ , subdir == subdir' ]+ where catch' :: IO a -> (SomeException -> IO a) -> IO a+ catch' = catch
+ plan2nix/Plan2Nix/Plan.hs view
@@ -0,0 +1,47 @@+{-# LANGUAGE OverloadedStrings #-}++module Plan2Nix.Plan+ ( Version+ , Revision+ , URL+ , Rev+ , Plan(..)+ , PkgSrc(..)+ , Package(..)+ , Location(..)+ ) where+++import Data.Text ( Text )+import Data.HashMap.Strict ( HashMap )++type Version = Text+type Revision = Text -- Can be: rNUM, cabal file sha256, or "default"+-- See stack2nix+type URL = String+type Rev = String++data Location+ = Git URL Rev+ | HG URL Rev+ deriving (Show)++data Plan = Plan+ { packages :: HashMap Text (Maybe Package)+ , extras :: HashMap Text (Maybe Package)+ , compilerVersion :: Text+ , compilerPackages :: HashMap Text (Maybe Version)+ } deriving (Show)+++data PkgSrc+ = LocalPath FilePath -- ^ some local package (potentially overriding a package in the index as well)+ | DVCS Location [FilePath] -- ^ One or more packages fetched from git or similar+ deriving Show++data Package = Package+ { packageVersion :: Version+ , packageRevision :: Maybe Revision+ , packageFlags :: HashMap Text Bool+ , packageSrc :: Maybe PkgSrc+ } deriving (Show)
+ plan2nix/Plan2Nix/Project.hs view
@@ -0,0 +1,34 @@+{-# LANGUAGE LambdaCase #-}++module Plan2Nix.Project+ ( findCabalFiles+ ) where++import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import Data.ByteString (ByteString)++import System.FilePath ((</>))+import System.Directory (listDirectory, doesFileExist)+import Data.List (isSuffixOf)++import qualified Hpack+import qualified Hpack.Config as Hpack+import qualified Hpack.Render as Hpack++import Cabal2Nix (CabalFile(..), CabalFileGenerator(..))++findCabalFiles :: FilePath -> IO [CabalFile]+findCabalFiles path = doesFileExist (path </> Hpack.packageConfig) >>= \case+ False -> fmap (OnDisk . (path </>)) . filter (isSuffixOf ".cabal") <$> listDirectory path+ True -> do+ mbPkg <- Hpack.readPackageConfig Hpack.defaultDecodeOptions {Hpack.decodeOptionsTarget = path </> Hpack.packageConfig}+ case mbPkg of+ Left e -> error e+ Right r ->+ return $ [InMemory (Just Hpack)+ (Hpack.decodeResultCabalFile r)+ (encodeUtf8 $ Hpack.renderPackage [] (Hpack.decodeResultPackage r))]++ where encodeUtf8 :: String -> ByteString+ encodeUtf8 = T.encodeUtf8 . T.pack
+ stack2nix/Main.hs view
@@ -0,0 +1,7 @@+module Main where++import Stack2nix (doStack2nix)+import Stack2nix.CLI (parseStack2nixArgs)++main :: IO ()+main = parseStack2nixArgs >>= doStack2nix
+ stack2nix/Stack2nix.hs view
@@ -0,0 +1,208 @@+{-# LANGUAGE LambdaCase, RecordWildCards, OverloadedStrings #-}++module Stack2nix+ ( doStack2nix+ , stackexpr+ , stack2nix+ ) where++import qualified Data.Text as T+import Data.String (fromString)++import Control.Monad.Trans.Maybe+import Control.Monad.IO.Class (liftIO)+import Control.Monad (unless, forM)+import Extra (unlessM)++import System.FilePath ((<.>), (</>), takeDirectory, dropFileName)+import System.Directory (createDirectoryIfMissing, doesDirectoryExist, doesFileExist, getCurrentDirectory)+import System.IO (IOMode(..), openFile, hClose)+import Data.Yaml (decodeFileEither)++import Nix.Expr+import Nix.Pretty (prettyNix)+import Data.Text.Prettyprint.Doc (Doc)+import Data.Text.Prettyprint.Doc.Render.Text (hPutDoc)++import Distribution.Types.PackageId (PackageIdentifier(..))+import Distribution.Nixpkgs.Fetch (DerivationSource(..), Source(..), Hash(..), fetch)+import Distribution.Simple.Utils (shortRelativePath)+import Distribution.Text (Text(..), simpleParse)++import Cabal2Nix hiding (Git)+import qualified Cabal2Nix as C2N+import Cabal2Nix.Util++import Stack2nix.Cache (appendCache, cacheHits)+import Stack2nix.CLI (Args(..))+import Stack2nix.Project+import Stack2nix.Stack (Stack(..), Dependency(..), Location(..), PackageFlags, GhcOptions)+import Stack2nix.External.Resolve++import qualified Data.HashMap.Strict as HM+++doStack2nix :: Args -> IO ()+doStack2nix args = do+ let pkgsNix = argOutputDir args </> "pkgs.nix"+ defaultNix = argOutputDir args </> "default.nix"+ pkgs <- stackexpr args+ writeDoc pkgsNix (prettyNix pkgs)+ unlessM (doesFileExist defaultNix) $ do+ writeFile defaultNix defaultNixContents++stackexpr :: Args -> IO NExpr+stackexpr args =+ do evalue <- decodeFileEither (argStackYaml args)+ case evalue of+ Left e -> error (show e)+ Right value -> stack2nix args+ =<< resolveSnapshot value++stack2nix :: Args -> Stack -> IO NExpr+stack2nix args stack@(Stack resolver compiler pkgs pkgFlags ghcOpts) =+ do let extraDeps = extraDeps2nix pkgs+ flags = flags2nix pkgFlags+ ghcOptions = ghcOptions2nix ghcOpts+ let _f_ = mkSym "f"+ _import_ = mkSym "import"+ _mkForce_ = mkSym "mkForce"+ _isFunction_ = mkSym "isFunction"+ _mapAttrs_ = mkSym "mapAttrs"+ _config_ = mkSym "config"+ packages <- packages2nix args pkgs+ return . mkNonRecSet $+ [ "extras" $= ("hackage" ==> mkNonRecSet+ ([ "packages" $= mkNonRecSet (extraDeps <> packages) ]+ ++ [ "compiler.version" $= fromString (quoted ver)+ | (Just c) <- [compiler], let ver = filter (`elem` (".0123456789" :: [Char])) c]+ ++ [ "compiler.nix-name" $= fromString (quoted name)+ | (Just c) <- [compiler], let name = filter (`elem` ((['a'..'z']++['0'..'9']) :: [Char])) c]))+ , "resolver" $= fromString (quoted resolver)+ , "modules" $= mkList [+ mkParamset [("lib", Nothing)] True ==> mkNonRecSet [ "packages" $= mkNonRecSet flags ]+ , mkNonRecSet [ "packages" $= mkNonRecSet ghcOptions ] ]+ ] ++ [+ "compiler" $= fromString (quoted c) | (Just c) <- [compiler]+ ]+-- | Transform simple package index expressions+-- The idea is to turn+--+-- - name-version[@rev:N | @sha256:SHA]+--+-- into+--+-- { name.revision = hackage.name.version.revisions.default; }+--+extraDeps2nix :: [Dependency] -> [Binding NExpr]+extraDeps2nix pkgs =+ let extraDeps = [(pkgId, info) | PkgIndex pkgId info <- pkgs]+ in [ (quoted (toText pkg)) $= (mkSym "hackage" @. toText pkg @. quoted (toText ver) @. "revisions" @. "default")+ | (PackageIdentifier pkg ver, Nothing) <- extraDeps ]+ ++ [ (quoted (toText pkg)) $= (mkSym "hackage" @. toText pkg @. quoted (toText ver) @. "revisions" @. quoted (T.pack sha))+ | (PackageIdentifier pkg ver, (Just (Left sha))) <- extraDeps ]+ ++ [ (quoted (toText pkg)) $= (mkSym "hackage" @. toText pkg @. quoted (toText ver) @. "revisions" @. toText revNo)+ | (PackageIdentifier pkg ver, (Just (Right revNo))) <- extraDeps ]+ where parsePackageIdentifier :: String -> Maybe PackageIdentifier+ parsePackageIdentifier = simpleParse+ toText :: Text a => a -> T.Text+ toText = fromString . show . disp++-- | Converts 'PackageFlags' into @{ packageName = { flags = { flagA = BOOL; flagB = BOOL; }; }; }@+flags2nix :: PackageFlags -> [Binding NExpr]+flags2nix pkgFlags =+ [ quoted pkgName $= mkNonRecSet+ -- `mkOverride 900` is used here so that the default values will be replaced (they are 1000).+ -- Values without a priority are treated as 100 and will replace these ones.+ [ "flags" $= mkNonRecSet [ quoted flag $= ("lib" @. "mkOverride" @@ mkInt 900 @@ mkBool val)+ | (flag, val) <- HM.toList flags+ ]+ ]+ | (pkgName, flags) <- HM.toList pkgFlags+ ]++-- | Converts 'GhcOptions' into @{ packageName = { ghcOptions = "..."; }; }@+ghcOptions2nix :: GhcOptions -> [Binding NExpr]+ghcOptions2nix ghcOptions =+ [ quoted pkgName $= mkNonRecSet+ [ "package" $= mkNonRecSet [ "ghcOptions" $= mkStr opts ] ]+ | (pkgName, opts) <- HM.toList ghcOptions+ ]++writeDoc :: FilePath -> Doc ann -> IO ()+writeDoc file doc =+ do handle <- openFile file WriteMode+ hPutDoc handle doc+ hClose handle+++-- makeRelativeToCurrentDirectory+packages2nix :: Args -> [Dependency] -> IO [Binding NExpr]+packages2nix args pkgs =+ do cwd <- getCurrentDirectory+ fmap concat . forM pkgs $ \case+ (LocalPath folder) ->+ do cabalFiles <- findCabalFiles (argHpackUse args) (dropFileName (argStackYaml args) </> folder)+ forM cabalFiles $ \cabalFile ->+ let pkg = cabalFilePkgName cabalFile+ nix = pkg <.> "nix"+ nixFile = argOutputDir args </> nix+ src = Just . C2N.Path $ relPath </> folder+ in do createDirectoryIfMissing True (takeDirectory nixFile)+ writeDoc nixFile =<<+ prettyNix <$> cabal2nix True (argDetailLevel args) src cabalFile+ return $ fromString pkg $= mkPath False nix+ (DVCS (Git url rev) subdirs) ->+ fmap concat . forM subdirs $ \subdir ->+ do cacheHits <- liftIO $ cacheHits (argCacheFile args) url rev subdir+ case cacheHits of+ [] -> do+ fetch (\dir -> cabalFromPath url rev subdir $ dir </> subdir)+ (Source url rev UnknownHash subdir) >>= \case+ (Just (DerivationSource{..}, genBindings)) -> genBindings derivHash+ _ -> return []+ hits ->+ forM hits $ \( pkg, nix ) -> do+ return $ fromString pkg $= mkPath False nix+ _ -> return []+ where relPath = shortRelativePath (argOutputDir args) (dropFileName (argStackYaml args))+ cabalFromPath+ :: String -- URL+ -> String -- Revision+ -> FilePath -- Subdir+ -> FilePath -- Local Directory+ -> MaybeT IO (String -> IO [Binding NExpr])+ cabalFromPath url rev subdir path = do+ d <- liftIO $ doesDirectoryExist path+ unless d $ fail ("not a directory: " ++ path)+ cabalFiles <- liftIO $ findCabalFiles (argHpackUse args) path+ return $ \sha256 ->+ forM cabalFiles $ \cabalFile -> do+ let pkg = cabalFilePkgName cabalFile+ nix = pkg <.> "nix"+ nixFile = argOutputDir args </> nix+ subdir' = if subdir == "." then Nothing+ else Just subdir+ src = Just $ C2N.Git url rev (Just sha256) subdir'+ createDirectoryIfMissing True (takeDirectory nixFile)+ writeDoc nixFile =<<+ prettyNix <$> cabal2nix True (argDetailLevel args) src cabalFile+ liftIO $ appendCache (argCacheFile args) url rev subdir sha256 pkg nix+ return $ fromString pkg $= mkPath False nix++defaultNixContents :: String+defaultNixContents = unlines+ [ "{ pkgs ? import <nixpkgs> {} }:"+ , ""+ , "let"+ , " haskell = import (builtins.fetchTarball https://github.com/input-output-hk/haskell.nix/archive/master.tar.gz) { inherit pkgs; };"+ , ""+ , " pkgSet = haskell.mkStackPkgSet {"+ , " stack-pkgs = import ./pkgs.nix;"+ , " pkg-def-extras = [];"+ , " modules = [];"+ , " };"+ , ""+ , "in"+ , " pkgSet.config.hsPkgs"+ ]
+ stack2nix/Stack2nix/CLI.hs view
@@ -0,0 +1,40 @@+module Stack2nix.CLI+ ( Args(..)+ , HpackUse(..)+ , parseStack2nixArgs+ ) where++import Options.Applicative hiding (option)+import Data.Semigroup ((<>))+import Cabal2Nix (CabalDetailLevel(..))++data HpackUse+ = IgnorePackageYaml+ | UsePackageYamlFirst+ deriving Show++--------------------------------------------------------------------------------+-- CLI Arguments+data Args = Args+ { argOutputDir :: FilePath+ , argStackYaml :: FilePath+ , argHpackUse :: HpackUse+ , argCacheFile :: FilePath+ , argDetailLevel :: CabalDetailLevel+ } deriving Show++-- Argument Parser+args :: Parser Args+args = Args+ <$> strOption ( long "output" <> short 'o' <> metavar "DIR" <> help "Generate output in DIR" )+ <*> strOption ( long "stack-yaml" <> value "stack.yaml" <> showDefault <> metavar "FILE" <> help "Override project stack.yaml" )+ <*> flag UsePackageYamlFirst IgnorePackageYaml (long "ignore-package-yaml" <> help "disable hpack run and use only cabal disregarding package.yaml existence")+ <*> strOption ( long "cache" <> value ".stack-to-nix.cache" <> showDefault <> metavar "FILE" <> help "Dependency cache file" )+ <*> flag MinimalDetails FullDetails ( long "full" <> help "Output details needed to determine what files are used" )++parseStack2nixArgs :: IO Args+parseStack2nixArgs = execParser opts+ where opts = info (args <**> helper)+ ( fullDesc+ <> progDesc "Generate a Nix expression for a Haskell package using Stack"+ <> header "stack-to-nix - a stack to nix converter" )
+ stack2nix/Stack2nix/Cache.hs view
@@ -0,0 +1,35 @@+module Stack2nix.Cache+ ( readCache+ , appendCache+ , cacheHits+ ) where++import Control.Exception (catch, SomeException(..))++readCache :: FilePath+ -> IO [( String -- url+ , String -- rev+ , String -- subdir+ , String -- sha256+ , String -- pkgname+ , String -- nixexpr-path+ )]+readCache f = fmap (toTuple . words) . lines <$> readFile f+ where toTuple [ url, rev, subdir, sha256, pkgname, exprPath ]+ = ( url, rev, subdir, sha256, pkgname, exprPath )++appendCache :: FilePath -> String -> String -> String -> String -> String -> String -> IO ()+appendCache f url rev subdir sha256 pkgname exprPath = do+ appendFile f $ unwords [ url, rev, subdir, sha256, pkgname, exprPath ]+ appendFile f "\n"++cacheHits :: FilePath -> String -> String -> String -> IO [ (String, String) ]+cacheHits f url rev subdir+ = do cache <- catch' (readCache f) (const (pure []))+ return [ ( pkgname, exprPath )+ | ( url', rev', subdir', sha256, pkgname, exprPath ) <- cache+ , url == url'+ , rev == rev'+ , subdir == subdir' ]+ where catch' :: IO a -> (SomeException -> IO a) -> IO a+ catch' = catch
+ stack2nix/Stack2nix/External/Resolve.hs view
@@ -0,0 +1,48 @@+module Stack2nix.External.Resolve+ ( resolveSnapshot+ ) where++import Control.Monad (unless)+import Data.Aeson+import Data.Yaml hiding (Parser)+import Control.Applicative ((<|>))+import Data.List (isPrefixOf, isSuffixOf)++import qualified Data.ByteString.Lazy.Char8 as L8++import Network.HTTP.Client+import Network.HTTP.Client.TLS+import Network.HTTP.Types.Status (ok200)+import Control.Exception.Base (SomeException(..),PatternMatchFail(..))++import Stack2nix.Stack (Stack(..), StackSnapshot(..))++-- | A @resolver@ value in a stack.yaml file may point to an URL. As such+-- we need to be able to fetch one.+decodeURLEither :: FromJSON a => String -> IO (Either ParseException a)+decodeURLEither url+ | not (("http://" `isPrefixOf` url) || ("https://" `isPrefixOf` url))+ = return . Left . OtherParseException . SomeException . PatternMatchFail $ "No http or https prefix"+ | otherwise = do+ manager <- newManager tlsManagerSettings+ request <- parseRequest url+ response <- httpLbs request manager+ unless (ok200 == responseStatus response) $ error ("failed to download " ++ url)+ return . decodeEither' . L8.toStrict $ responseBody response+++-- | If a stack.yaml file contains a @resolver@ that points to+-- a file, resolve that file and merge the snapshot into the+-- @Stack@ record.+resolveSnapshot :: Stack -> IO Stack+resolveSnapshot stack@(Stack resolver compiler pkgs flags ghcOptions)+ = if ".yaml" `isSuffixOf` resolver+ then do evalue <- if ("http://" `isPrefixOf` resolver) || ("https://" `isPrefixOf` resolver)+ then decodeURLEither resolver+ else decodeFileEither resolver+ case evalue of+ Left e -> error (show e)+ Right (Snapshot resolver' compiler' _name pkgs' flags' ghcOptions') ->+ pure $ Stack resolver' (compiler' <|> compiler) (pkgs <> pkgs') (flags <> flags')+ (ghcOptions <> ghcOptions')+ else pure stack
+ stack2nix/Stack2nix/Project.hs view
@@ -0,0 +1,39 @@+{-# LANGUAGE LambdaCase #-}++module Stack2nix.Project+ ( findCabalFiles+ ) where++import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import Data.ByteString (ByteString)++import System.FilePath ((</>))+import System.Directory (listDirectory, doesFileExist)+import Data.List (isSuffixOf)++import qualified Hpack.Config as Hpack+import qualified Hpack.Render as Hpack++import Cabal2Nix (CabalFile(..), CabalFileGenerator(..))++import Stack2nix.CLI (HpackUse(..))++findCabalFiles :: HpackUse -> FilePath -> IO [CabalFile]+findCabalFiles IgnorePackageYaml path = findOnlyCabalFiles path+findCabalFiles UsePackageYamlFirst path = doesFileExist (path </> Hpack.packageConfig) >>= \case+ False -> findOnlyCabalFiles path+ True -> do+ mbPkg <- Hpack.readPackageConfig Hpack.defaultDecodeOptions {Hpack.decodeOptionsTarget = path </> Hpack.packageConfig}+ case mbPkg of+ Left e -> error e+ Right r ->+ return $ [InMemory (Just Hpack)+ (Hpack.decodeResultCabalFile r)+ (encodeUtf8 $ Hpack.renderPackage [] (Hpack.decodeResultPackage r))]++ where encodeUtf8 :: String -> ByteString+ encodeUtf8 = T.encodeUtf8 . T.pack++findOnlyCabalFiles :: FilePath -> IO [CabalFile]+findOnlyCabalFiles path = fmap (OnDisk . (path </>)) . filter (isSuffixOf ".cabal") <$> listDirectory path
+ stack2nix/Stack2nix/Stack.hs view
@@ -0,0 +1,221 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++module Stack2nix.Stack+ ( Resolver+ , Name+ , Compiler+ , Sha256+ , CabalRev+ , URL+ , Rev+ , Stack(..)+ , Dependency(..)+ , Location(..)+ , StackSnapshot(..)+ , PackageFlags+ , GhcOptions+ ) where++import Data.Char (isDigit)+import Data.List (isSuffixOf)+import qualified Data.Text as T+import Data.Aeson+import Control.Applicative ((<|>))+import Data.Monoid (mempty)++import Distribution.Types.PackageName+import Distribution.Types.PackageId+import Distribution.Compat.ReadP hiding (Parser)+import Distribution.Text+import Distribution.Types.Version (nullVersion)++import qualified Data.HashMap.Strict as HM++--------------------------------------------------------------------------------+-- The stack.yaml file+--------------------------------------------------------------------------------++--------------------------------------------------------------------------------+-- packages+--+-- * (1) Paths+-- - ./site1+-- - ./site2+-- * (2) Git Locations+-- - location:+-- git: https://github.com/yesodweb/yesod+-- commit: 7038ae6317cb3fe4853597633ba7a40804ca9a46+-- extra-dep: true+-- subdirs:+-- - yesod-core+-- - yesod-bin++--------------------------------------------------------------------------------+-- extra-deps+--+-- * (1) Package index (optional sha of cabal files contents; or revision number)+-- - acme-missiles-0.3+-- - acme-missiles-0.3@sha256:2ba66a092a32593880a87fb00f3213762d7bca65a687d45965778deb8694c5d1+-- - acme-missiles-0.3@rev:0+--+-- * (2) Local File Path (foo-1.2.3 would be parsed as a package index)+-- - vendor/somelib+-- - ./foo-1.2.3+--+-- * (3) Git and Mercurial repos (optional subdirs; or github)+-- - git: git@github.com:commercialhaskell/stack.git+-- commit: 6a86ee32e5b869a877151f74064572225e1a0398+-- - git: git@github.com:snoyberg/http-client.git+-- commit: "a5f4f3"+-- - hg: https://example.com/hg/repo+-- commit: da39a3ee5e6b4b0d3255bfef95601890afd80709+-- - git: git@github.com:yesodweb/wai+-- commit: 2f8a8e1b771829f4a8a77c0111352ce45a14c30f+-- subdirs:+-- - auto-update+-- - wai+-- - github: snoyberg/http-client+-- commit: a5f4f30f01366738f913968163d856366d7e0342+--+-- * (4) Archives (HTTP(S) or local filepath)+-- - https://example.com/foo/bar/baz-0.0.2.tar.gz+-- - archive: http://github.com/yesodweb/wai/archive/2f8a8e1b771829f4a8a77c0111352ce45a14c30f.zip+-- subdirs:+-- - wai+-- - warp+-- - archive: ../acme-missiles-0.3.tar.gz+-- sha256: e563d8b524017a06b32768c4db8eff1f822f3fb22a90320b7e414402647b735b++-- NOTE: We will only parse a suitable subset of the stack.yaml file.++--------------------------------------------------------------------------------+-- Some generic types+type Resolver = String+type Name = String+type Compiler = String+type Sha256 = String+newtype CabalRev = CabalRev Int -- cabal revision 0,1,2,...+ deriving (Show)+type URL = String -- Git/Hg/... URL+type Rev = String -- Git revision++instance Text CabalRev where+ disp (CabalRev rev) = "r" <> disp rev+ parse = char 'r' *> (CabalRev <$> parse)++--------------------------------------------------------------------------------+-- Data Types+-- Dependencies are the merged set of packages and extra-deps.+-- As we do not distinguish them in the same way stack does, we+-- can get away with this.+data Dependency+ = PkgIndex PackageIdentifier (Maybe (Either Sha256 CabalRev)) -- ^ overridden package in the stackage index+ | LocalPath String -- ^ Some local package (potentially overriding a package in the index as well)+ | DVCS Location [FilePath] -- ^ One or more packages fetched from git or similar.+ -- TODO: Support archives.+ -- | Archive ...+ deriving (Show)++-- flags are { pkg -> { flag -> bool } }+type PackageFlags = HM.HashMap T.Text (HM.HashMap T.Text Bool)++type GhcOptions = HM.HashMap T.Text T.Text++data Stack+ = Stack Resolver (Maybe Compiler) [Dependency] PackageFlags GhcOptions+ deriving (Show)++-- stack supports custom snapshots+-- https://docs.haskellstack.org/en/stable/custom_snapshot/+data StackSnapshot+ = Snapshot+ Resolver -- lts-XX.YY/nightly-...+ (Maybe Compiler) -- possible compiler override for the snapshot+ Name -- name+ [Dependency] -- packages+ PackageFlags -- flags+ -- [PackageName] -- drop-packages+ -- [PackageName -> Bool] -- hidden+ GhcOptions -- ghc-options+ deriving (Show)++data Location+ = Git URL Rev+ | HG URL Rev+ deriving (Show)++--------------------------------------------------------------------------------+-- Parsers for package indices+sha256Suffix :: ReadP r Sha256+sha256Suffix = string "@sha256:" *> many1 (satisfy (`elem` (['0'..'9']++['a'..'z']++['A'..'Z'])))+ -- Stack supports optional cabal file size after revision's SHA value,+ -- we parse it but it doesn't get used+ <* optional (char ',' <* many1 (satisfy isDigit))++revSuffix :: ReadP r CabalRev+revSuffix = string "@rev:" *> (CabalRev . read <$> many1 (satisfy (`elem` ['0'..'9'])))++suffix :: ReadP r (Maybe (Either Sha256 CabalRev))+suffix = option Nothing (Just <$> (Left <$> sha256Suffix) +++ (Right <$> revSuffix))++pkgIndex :: ReadP r Dependency+pkgIndex = PkgIndex <$> parse <*> suffix <* eof++--------------------------------------------------------------------------------+-- JSON/YAML destructors++instance FromJSON Location where+ parseJSON = withObject "Location" $ \l ->+ parseGitHub l <|> parseGit l+ where+ parseGit l = Git+ <$> l .: "git"+ <*> l .: "commit"+ parseGitHub l = Git+ <$> do gitHubUrl <$> l .: "github"+ <*> l .: "commit"+ gitHubUrl ownerRepo =+ "https://github.com/" <> ownerRepo <> ".git"++instance FromJSON Stack where+ parseJSON = withObject "Stack" $ \s -> Stack+ <$> s .: "resolver"+ <*> s .:? "compiler" .!= Nothing+ <*> ((<>) <$> s .:? "packages" .!= [LocalPath "."]+ <*> s .:? "extra-deps" .!= [])+ <*> s .:? "flags" .!= mempty+ <*> s .:? "ghc-options" .!= mempty++instance FromJSON StackSnapshot where+ parseJSON = withObject "Snapshot" $ \s -> Snapshot+ <$> s .: "resolver"+ <*> s .:? "compiler" .!= Nothing+ <*> s .: "name"+ <*> s .:? "packages" .!= []+ <*> s .:? "flags" .!= mempty+ <*> s .:? "ghc-options" .!= mempty++instance FromJSON Dependency where+ -- Note: we will parse foo-X.Y.Z as a package.+ -- if we want it to be a localPath, it needs+ -- to be ./foo-X.Y.Z+ parseJSON p = parsePkgIndex p <|> parseLocalPath p <|> parseDVCS p+ where parsePkgIndex = withText "Package Index" $ \pi ->+ case [pi' | (pi',"") <- readP_to_S pkgIndex (T.unpack pi)] of+ -- Cabal will happily parse "foo" as a packageIdentifier,+ -- we however are only interested in those that have a version+ -- as well. Any valid version is larger than @nullVersion@, as+ -- such we can use that as a filter.+ [pi'@(PkgIndex pkgIdent _)] | pkgVersion pkgIdent > nullVersion -> return $ pi'+ _ -> fail $ "invalid package index: " ++ show pi+ parseLocalPath = withText "Local Path" $+ return . LocalPath . dropTrailingSlash . T.unpack+ parseDVCS = withObject "DVCS" $ \o -> DVCS+ <$> (o .: "location" <|> parseJSON p)+ <*> o .:? "subdirs" .!= ["."]++ -- drop trailing slashes. Nix doesn't like them much;+ -- stack doesn't seem to care.+ dropTrailingSlash p | "/" `isSuffixOf` p = take (length p - 1) p+ dropTrailingSlash p = p
+ truncate-index/Main.hs view
@@ -0,0 +1,63 @@+-- I am a sinner!+{-# language RecordWildCards #-}++module Main (main) where++import Data.Maybe+import Data.Time.Clock+import Data.Time.Format+import Data.Time.Clock.POSIX+import Codec.Archive.Tar as Tar+import Codec.Archive.Tar.Entry as Tar+import Data.ByteString.Lazy as BS hiding (filter)+import Codec.Compression.GZip as GZip++import Options.Applicative hiding (option)+import Data.Semigroup ((<>))++-- | Parse a hackage index state like "2019-01-01T12:00:00Z"+parseIndexState :: String -> Maybe UTCTime+parseIndexState = parseTimeM True defaultTimeLocale (iso8601DateFormat (Just "%T%Z"))++-- | Convert the standard 'UTCTime' type into the 'EpochTime' used by the @tar@+-- library.+toEpochTime :: UTCTime -> EpochTime+toEpochTime = floor . utcTimeToPOSIXSeconds++-- | Filter Haskell Index+filterHaskellIndex :: FilePath -> String -> FilePath -> IO ()+filterHaskellIndex orig indexState out =+ BS.writeFile out . nukeHeaderOS . GZip.compress . Tar.write . f . Tar.read . GZip.decompress =<< BS.readFile orig+ where f = filter ((<= ts) . Tar.entryTime) . toList+ ts = toEpochTime . fromJust . parseIndexState $ indexState+ -- gzip headers containt he OS, but we want a stable hash.+ -- 0xff is unknown OS. http://www.zlib.org/rfc-gzip.html+ nukeHeaderOS :: BS.ByteString -> BS.ByteString+ nukeHeaderOS bs = BS.take 9 bs <> BS.singleton 0xff <> BS.drop 10 bs++-- | Convert @Entries e@ to a list while throwing an error on failure.+toList :: Show e => Entries e -> [Entry]+toList (Next e es) = e:(toList es)+toList Done = []+toList (Fail e) = error (show e)++--------------------------------------------------------------------------------+-- CLI Argument+data Args = Args+ { argOutput :: FilePath+ , argInput :: FilePath+ , argIndexState :: String+ } deriving Show++args :: Parser Args+args = Args+ <$> strOption ( long "output" <> short 'o' <> value "00-index.tar.gz" <> showDefault <> metavar "FILE" <> help "The output index" )+ <*> strOption ( long "input" <> short 'i' <> value "01-index.tar.gz" <> showDefault <> metavar "FILE" <> help "The input index" )+ <*> strOption ( long "indexState" <> short 's' <> metavar "INDEX" <> help "Index State ( YYYY-MM-DDTHH:MM:SSZ )" )++main :: IO ()+main = execParser opts >>= \Args{..} -> filterHaskellIndex argInput argIndexState argOutput+ where opts = info (args <**> helper)+ ( fullDesc+ <> progDesc "Generate a truncated Hackage index"+ <> header "truncate-index - a hackage index truncater" )