Skip to content

Commit 5c23bf6

Browse files
angermanangerman
committed
Integrate more of the haskell changes from #6
This rather crudely integrates most of the haskell changes from elvishjerricco/per-component-new-names.
1 parent 9794520 commit 5c23bf6

File tree

8 files changed

+151
-97
lines changed

8 files changed

+151
-97
lines changed

‎hackage2nix/Main.hs

Lines changed: 91 additions & 55 deletions
Original file line numberDiff line numberDiff line change
@@ -1,35 +1,43 @@
11
{-# LANGUAGE OverloadedStrings #-}
22
{-# LANGUAGE NamedFieldPuns #-}
33

4-
module Main
5-
where
4+
module Main where
65

76
import Cabal2Nix
87
import Cabal2Nix.Util ( quoted )
9-
import Crypto.Hash.SHA256 ( hash
10-
, hashlazy
11-
)
8+
import Control.Applicative ( liftA2 )
9+
import Control.Monad.Trans.State.Strict
10+
import Crypto.Hash.SHA256 ( hashlazy )
1211
import qualified Data.ByteString.Base16 as Base16
1312
import qualified Data.ByteString.Char8 as BS
1413
import qualified Data.ByteString.Lazy as BL
15-
import Data.Foldable ( toList )
14+
import Data.Foldable ( toList
15+
, for_
16+
)
17+
import Data.List ( intersperse )
18+
import Data.Map ( Map )
1619
import qualified Data.Map as Map
20+
import Data.Semigroup as Sem
21+
import Data.Sequence ( Seq )
1722
import qualified Data.Sequence as Seq
18-
import Data.String ( IsString(fromString) )
23+
import Data.String ( IsString(fromString)
24+
)
25+
import Data.Text ( Text )
1926
import Data.Text.Encoding ( decodeUtf8 )
2027
import Distribution.Hackage.DB ( hackageTarball )
2128
import qualified Distribution.Hackage.DB.Parsed
2229
as P
23-
import Distribution.Hackage.DB.Parsed ( parseMetaData
24-
, parseVersionData
25-
)
26-
import Distribution.Hackage.DB.Unparsed
30+
import qualified Distribution.Hackage.DB.Unparsed
31+
as U
2732
import Distribution.Pretty ( prettyShow
2833
, Pretty
2934
)
35+
import Distribution.Types.PackageName ( PackageName )
36+
import Distribution.Types.Version ( Version )
3037
import Nix.Expr
3138
import Nix.Pretty ( prettyNix )
32-
import System.Directory ( createDirectoryIfMissing )
39+
import System.Directory ( createDirectoryIfMissing
40+
)
3341
import System.Environment ( getArgs )
3442
import System.FilePath ( (</>)
3543
, (<.>)
@@ -38,50 +46,78 @@ import System.FilePath ( (</>)
3846
main :: IO ()
3947
main = do
4048
[out] <- getArgs
41-
db <- readTarball Nothing =<< hackageTarball
49+
db <- U.readTarball Nothing =<< hackageTarball
50+
51+
let (defaultNix, cabalFiles) =
52+
runState (fmap seqToSet $ foldMapWithKeyA package2nix db) mempty
4253

43-
let defaultNix = seqToSet $ Map.foldMapWithKey package2nix db
4454
createDirectoryIfMissing False out
4555
writeFile (out </> "default.nix") $ show $ prettyNix defaultNix
56+
createDirectoryIfMissing False (out </> "hackage")
57+
58+
for_ cabalFiles $ \(cabalFile, pname, path) -> do
59+
gpd <- cabal2nix Nothing $ InMemory Nothing pname $ BL.toStrict cabalFile
60+
writeFile (out </> path) $ show $ prettyNix gpd
61+
62+
type GPDWriter = State (Seq (BL.ByteString, String, FilePath))
63+
64+
newtype ApplicativeMonoid f a = ApplicativeMonoid { unApplicativeMonoid :: f a }
65+
instance (Applicative f, Semigroup a) => Sem.Semigroup (ApplicativeMonoid f a) where
66+
ApplicativeMonoid a <> ApplicativeMonoid b = ApplicativeMonoid $ liftA2 (Sem.<>) a b
67+
instance (Applicative f, Monoid a) => Monoid (ApplicativeMonoid f a) where
68+
mempty = ApplicativeMonoid $ pure mempty
69+
mappend = (Sem.<>)
70+
71+
foldMapWithKeyA
72+
:: (Applicative f, Monoid b) => (k -> a -> f b) -> Map k a -> f b
73+
foldMapWithKeyA f =
74+
unApplicativeMonoid . Map.foldMapWithKey (\k -> ApplicativeMonoid . f k)
75+
76+
seqToSet :: Seq (Binding NExpr) -> NExpr
77+
seqToSet = mkNonRecSet . toList
78+
79+
fromPretty :: (Pretty a, IsString b) => a -> b
80+
fromPretty = fromString . prettyShow
81+
82+
package2nix :: PackageName -> U.PackageData -> GPDWriter (Seq (Binding NExpr))
83+
package2nix pname (U.PackageData { U.versions }) = do
84+
versionBindings <- foldMapWithKeyA (version2nix pname) versions
85+
return $ Seq.singleton $ quoted (fromPretty pname) $= seqToSet versionBindings
86+
87+
version2nix
88+
:: PackageName -> Version -> U.VersionData -> GPDWriter (Seq (Binding NExpr))
89+
version2nix pname vnum (U.VersionData { U.cabalFileRevisions, U.metaFile }) =
90+
do
91+
revisionBindings <- sequenceA
92+
$ zipWith (revBinding pname vnum) cabalFileRevisions [0 ..]
93+
return $ Seq.singleton $ quoted (fromPretty vnum) $= mkRecSet
94+
[ "sha256" $= mkStr
95+
(fromString $ P.parseMetaData pname vnum metaFile Map.! "sha256")
96+
, "revisions" $= mkNonRecSet
97+
( fmap (uncurry ($=)) revisionBindings
98+
++ ["default" $= (mkSym "revisions" @. fst (last revisionBindings))]
99+
)
100+
]
46101

47-
_ <- forWithKey db $ \pname (PackageData { versions }) ->
48-
forWithKey versions $ \vnum vdata@(VersionData { cabalFileRevisions }) ->
49-
let parsedVData = parseVersionData pname vnum vdata
50-
writeFiles gpd cabalFile revNum = do
51-
let dir = out </> packagePath pname </> fromPretty vnum
52-
revPath = dir </> revName revNum
53-
createDirectoryIfMissing True dir
54-
BL.writeFile (revPath <.> "cabal") cabalFile
55-
writeFile (revPath <.> "nix") $ show $ prettyNix $ gpd2nix Nothing Nothing gpd
56-
in sequence $ zipWith3 writeFiles
57-
(toList (P.cabalFileRevisions parsedVData))
58-
cabalFileRevisions
59-
[(0 :: Int) ..]
60-
return ()
61-
where
62-
forWithKey :: Applicative f => Map.Map k v -> (k -> v -> f x) -> f (Map.Map k x)
63-
forWithKey = flip Map.traverseWithKey
64-
seqToSet = mkNonRecSet . toList
65-
fromPretty :: (Pretty a, IsString b) => a -> b
66-
fromPretty = fromString . prettyShow
67-
package2nix pname (PackageData { versions }) =
68-
Seq.singleton $ quoted (fromPretty pname) $= seqToSet
69-
(Map.foldMapWithKey (version2nix pname) versions)
70-
version2nix pname vnum (VersionData { cabalFileRevisions, metaFile }) =
71-
Seq.singleton $ quoted (fromPretty vnum) $= mkRecSet
72-
( ("revision" $= mkSym (revName $ length cabalFileRevisions - 1))
73-
: ("sha256" $= mkStr (fromString $ parseMetaData pname vnum metaFile Map.! "sha256"))
74-
: zipWith (revBinding (packagePath pname) vnum) cabalFileRevisions [(0 :: Int) ..]
75-
)
76-
revName revNum = "r" <> fromString (show revNum)
77-
revBinding ppath vnum cabalFile revNum =
78-
let name :: (IsString a, Semigroup a) => a
79-
name = revName revNum
80-
revPath = "." </> ppath </> fromPretty vnum </> name
81-
in name $= mkNonRecSet
82-
[ "outPath" $= mkRelPath (revPath <.> "nix")
83-
, "cabalFile" $= mkRelPath (revPath <.> "cabal")
84-
, "cabalSha256" $= mkStr (decodeUtf8 $ Base16.encode $ hashlazy cabalFile)
85-
]
86-
packagePath pname =
87-
BS.unpack (BS.take 30 $ Base16.encode $ hash $ fromPretty pname) ++ "-" ++ fromPretty pname
102+
revBinding
103+
:: PackageName
104+
-> Version
105+
-> BL.ByteString
106+
-> Integer
107+
-> GPDWriter (Text, NExpr)
108+
revBinding pname vnum cabalFile revNum = do
109+
let qualifiedName = mconcat $ intersperse
110+
"-"
111+
[prettyPname, fromPretty vnum, revName, BS.unpack cabalHash]
112+
revName :: (Semigroup a, IsString a) => a
113+
revName = "r" <> fromString (show revNum)
114+
revPath = "." </> "hackage" </> qualifiedName <.> "nix"
115+
prettyPname = fromPretty pname
116+
cabalHash = Base16.encode $ hashlazy cabalFile
117+
modify' $ mappend $ Seq.singleton
118+
(cabalFile, prettyPname ++ ".cabal", revPath)
119+
return $ (,) revName $ mkNonRecSet
120+
[ "outPath" $= mkRelPath revPath
121+
, "revNum" $= mkInt revNum
122+
, "sha256" $= mkStr (decodeUtf8 cabalHash)
123+
]

‎lib/Cabal2Nix.hs

Lines changed: 6 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -60,7 +60,7 @@ data CabalFileGenerator
6060

6161
data CabalFile
6262
= OnDisk FilePath
63-
| InMemory CabalFileGenerator FilePath ByteString
63+
| InMemory (Maybe CabalFileGenerator) FilePath ByteString
6464
deriving Show
6565

6666

@@ -76,23 +76,21 @@ genExtra Hpack = mkNonRecSet [ "cabal-generator" $= mkStr "hpack" ]
7676

7777
cabal2nix :: Maybe Src -> CabalFile -> IO NExpr
7878
cabal2nix src = \case
79-
(OnDisk path) -> fmap (gpd2nix Nothing src)
79+
(OnDisk path) -> fmap (gpd2nix src Nothing)
8080
$ readGenericPackageDescription normal path
81-
(InMemory gen path body) -> fmap (gpd2nix (Just $ genExtra gen) src)
81+
(InMemory gen _ body) -> fmap (gpd2nix src (genExtra <$> gen))
8282
$ maybe (error "Failed to parse in-memory cabal file") pure (parseGenericPackageDescriptionMaybe body)
8383

84-
gpd2nix :: Maybe NExpr -> Maybe Src -> GenericPackageDescription -> NExpr
85-
gpd2nix extra src gpd = mkFunction args . lets gpd $ toNix gpd $//? (toNix <$> src) $//? extra
84+
gpd2nix :: Maybe Src -> Maybe NExpr -> GenericPackageDescription -> NExpr
85+
gpd2nix src extra gpd = mkFunction args $ toNix gpd $//? (toNix <$> src) $//? extra
8686
where args :: Params NExpr
8787
args = mkParamset [ ("system", Nothing)
8888
, ("compiler", Nothing)
89-
, ("flags", Just $ mkNonRecSet [])
89+
, ("flags", Nothing)
9090
, (pkgs, Nothing)
9191
, (hsPkgs, Nothing)
9292
, (pkgconfPkgs, Nothing)]
9393
False
94-
lets :: GenericPackageDescription -> NExpr -> NExpr
95-
lets gpd = mkLets [ flags $= (mkNonRecSet . fmap toNixBinding $ genPackageFlags gpd) $// mkSym "flags" ]
9694

9795
class HasBuildInfo a where
9896
getBuildInfo :: a -> BuildInfo

‎lib/Cabal2Nix/Plan.hs

Lines changed: 16 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -4,15 +4,18 @@
44
module Cabal2Nix.Plan
55
where
66

7-
import Cabal2Nix.Util ( quoted )
7+
import Cabal2Nix.Util ( quoted
8+
, bindPath
9+
)
810
import Data.HashMap.Strict ( HashMap )
911
import qualified Data.HashMap.Strict as Map
12+
import Data.List.NonEmpty ( NonEmpty (..) )
1013
import Data.Text ( Text )
1114
import qualified Data.Text as Text
1215
import Nix.Expr
1316

1417
type Version = Text
15-
type Revision = Text -- Can be: rNUM, cabal file sha256, or "revision"
18+
type Revision = Text -- Can be: rNUM, cabal file sha256, or "default"
1619

1720
data Plan = Plan
1821
{ packages :: HashMap Text Package
@@ -23,13 +26,14 @@ data Plan = Plan
2326
data Package = Package
2427
{ packageVersion :: Version
2528
, packageRevision :: Maybe Revision
29+
, packageFlags :: HashMap Text Bool
2630
}
2731

2832
plan2nix :: Plan -> NExpr
2933
plan2nix (Plan { packages, compilerVersion, compilerPackages }) =
3034
mkFunction "hackage"
3135
. mkNonRecSet
32-
$ [ "packages" $= (mkNonRecSet $ uncurry bind <$> Map.toList packages)
36+
$ [ "packages" $= (mkNonRecSet $ uncurry bind =<< Map.toList packages)
3337
, "compiler" $= mkNonRecSet
3438
[ "version" $= mkStr compilerVersion
3539
, "nix-name" $= mkStr ("ghc" <> Text.filter (/= '.') compilerVersion)
@@ -54,9 +58,13 @@ plan2nix (Plan { packages, compilerVersion, compilerPackages }) =
5458
$ fmap (uncurry bindTo) . Map.toList $ (\k _v -> mkSym "dontCheck'" @@ (mkSym "super" @. k)) `Map.mapWithKey` packages)
5559
]
5660
where
57-
bind pkg (Package { packageVersion, packageRevision }) =
58-
let verExpr = mkSym "hackage" @. pkg @. quoted packageVersion
59-
revExpr = maybe verExpr (verExpr @.) (quoted <$> packageRevision)
60-
-- disable revision logic, until we have that fixed in the hackage expression.
61-
in quoted pkg $= verExpr -- revExpr
61+
bind pkg (Package { packageVersion, packageRevision, packageFlags }) =
62+
let verExpr = mkSym "hackage" @. pkg @. quoted packageVersion
63+
revExpr = verExpr @. "revisions" @. maybe "default" quoted packageRevision
64+
revBinding = bindPath (pkg :| ["revision"]) revExpr
65+
flagBindings = Map.foldrWithKey
66+
(\fname val acc -> bindPath (pkg :| ["flags", fname]) (mkBool val) : acc)
67+
[]
68+
packageFlags
69+
in revBinding : flagBindings
6270
bind' pkg ver = quoted pkg $= mkStr ver

‎lib/Cabal2Nix/Util.hs

Lines changed: 7 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -8,9 +8,13 @@ import Control.Monad
88
import Data.String (IsString)
99

1010
import Data.ByteString.Char8 (pack, unpack)
11+
import Data.Text (Text)
1112
import Crypto.Hash.SHA256 (hash)
1213
import qualified Data.ByteString.Base16 as Base16
1314

15+
import Data.List.NonEmpty (NonEmpty)
16+
import Nix.Expr
17+
1418
listDirectories :: FilePath -> IO [FilePath]
1519
listDirectories p =
1620
filter (/= ".git") <$> listDirectory p
@@ -21,3 +25,6 @@ quoted str = "\"" <> str <> "\""
2125

2226
sha256 :: String -> String
2327
sha256 = unpack . Base16.encode . hash . pack
28+
29+
bindPath :: NonEmpty Text -> NExpr -> Binding NExpr
30+
bindPath ks e = NamedVar (fmap StaticKey ks) e nullPos

‎lts2nix/Main.hs

Lines changed: 6 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -10,10 +10,10 @@ import Data.Yaml (decodeFileEither)
1010
import Nix.Pretty (prettyNix)
1111
import Nix.Expr
1212

13-
import Data.Aeson
14-
import Lens.Micro
15-
import Lens.Micro.Aeson
16-
13+
import Data.Aeson
14+
import qualified Data.HashMap.Strict as Map
15+
import Lens.Micro
16+
import Lens.Micro.Aeson
1717

1818
import Cabal2Nix.Plan
1919

@@ -36,6 +36,7 @@ lts2plan lts = Plan { packages , compilerVersion , compilerPackages }
3636
packages = lts ^. key "packages" . _Object <&> \v -> Package
3737
{ packageVersion = v ^. key "version" . _String
3838
, packageRevision = v ^? key "cabal-file-info" . key "hashes" . key "SHA256" . _String
39+
, packageFlags = Map.mapMaybe (^? _Bool) $ v ^. key "constraints" . key "flags" . _Object
3940
}
40-
compilerVersion = lts ^. key "system-info" . key "ghc-version" . _String
41+
compilerVersion = lts ^. key "system-info" . key "ghc-version" . _String
4142
compilerPackages = lts ^. key "system-info" . key "core-packages" . _Object <&> (^. _String)

‎nix-tools.cabal

Lines changed: 19 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -65,24 +65,6 @@ executable hashes-to-nix
6565
hs-source-dirs: hashes2nix
6666
default-language: Haskell2010
6767

68-
executable hackage-to-nix
69-
ghc-options: -Wall
70-
main-is: Main.hs
71-
build-depends: base >=4.11 && <4.12
72-
, nix-tools
73-
, hackage-db
74-
, hnix
75-
, Cabal
76-
, containers
77-
, bytestring
78-
, text
79-
, cryptohash-sha256
80-
, base16-bytestring
81-
, filepath
82-
, directory
83-
hs-source-dirs: hackage2nix
84-
default-language: Haskell2010
85-
8668
executable plan-to-nix
8769
ghc-options: -Wall
8870
main-is: Main.hs
@@ -98,6 +80,25 @@ executable plan-to-nix
9880
hs-source-dirs: plan2nix
9981
default-language: Haskell2010
10082

83+
executable hackage-to-nix
84+
ghc-options: -Wall
85+
main-is: Main.hs
86+
build-depends: base >=4.11 && <4.12
87+
, nix-tools
88+
, hackage-db
89+
, hnix
90+
, Cabal
91+
, containers
92+
, bytestring
93+
, text
94+
, cryptohash-sha256
95+
, base16-bytestring
96+
, filepath
97+
, directory
98+
, transformers
99+
hs-source-dirs: hackage2nix
100+
default-language: Haskell2010
101+
101102
executable lts-to-nix
102103
ghc-options: -Wall
103104
main-is: Main.hs

‎plan2nix/Main.hs

Lines changed: 5 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -40,8 +40,11 @@ value2plan plan = Plan {packages , compilerVersion , compilerPackages }
4040
where
4141
packages = filterInstallPlan $ \pkg -> if (pkg ^. key "style" . _String) /= "global"
4242
then Nothing
43-
else Just
44-
$ Package {packageVersion = pkg ^. key "pkg-version" . _String, packageRevision = Nothing}
43+
else Just $ Package
44+
{ packageVersion = pkg ^. key "pkg-version" . _String
45+
, packageRevision = Nothing
46+
, packageFlags = Map.mapMaybe (^? _Bool) $ pkg ^. key "flags" . _Object
47+
}
4548
compilerVersion = Text.dropWhile (not . isDigit) $ plan ^. key "compiler-id" . _String
4649
compilerPackages = filterInstallPlan $ \pkg -> if isJust (pkg ^? key "style" . _String)
4750
then Nothing

‎stack2nix/Main.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -215,7 +215,7 @@ findCabalFiles path = doesFileExist (path </> Hpack.packageConfig) >>= \case
215215
case mbPkg of
216216
Left e -> error e
217217
Right r ->
218-
return $ [InMemory Hpack
218+
return $ [InMemory (Just Hpack)
219219
(Hpack.decodeResultCabalFile r)
220220
(encodeUtf8 $ Hpack.renderPackage [] (Hpack.decodeResultPackage r))]
221221

0 commit comments

Comments
 (0)