Skip to content

Commit ecdbd72

Browse files
andreabediniandreabedini
committed
Minimize differences with master
1 parent f4c2e41 commit ecdbd72

File tree

1 file changed

+70
-89
lines changed

1 file changed

+70
-89
lines changed

‎nix-tools/plan2nix/Plan2Nix.hs

Lines changed: 70 additions & 89 deletions
Original file line numberDiff line numberDiff line change
@@ -55,7 +55,6 @@ import System.FilePath ((<.>), (</>), takeDirectory, dropFileName)
5555
import System.Directory (createDirectoryIfMissing, doesDirectoryExist, doesFileExist, getCurrentDirectory)
5656
import System.IO (IOMode(..), openFile, hClose)
5757
import Data.String (fromString)
58-
import qualified Data.Text as T
5958

6059

6160
doPlan2Nix :: Args -> IO ()
@@ -86,7 +85,7 @@ plan2nix args Plan { packages, extras, components, compilerVersion, compilerPack
8685
-- called from the toplevel project directory.
8786
cwd <- getCurrentDirectory
8887
extrasNix <- fmap (mkNonRecSet . concat) . forM (Map.toList extras) $ \case
89-
(_name, Just (Package _vers _flags (Just (LocalPath folder)) False)) ->
88+
(_name, Just (Package v flags (Just (LocalPath folder)) False)) ->
9089
do cabalFiles <- findCabalFiles folder
9190
forM cabalFiles $ \cabalFile ->
9291
let pkg = cabalFilePkgName cabalFile
@@ -96,7 +95,7 @@ plan2nix args Plan { packages, extras, components, compilerVersion, compilerPack
9695
in do createDirectoryIfMissing True (takeDirectory nixFile)
9796
writeDoc nixFile . prettyNix =<< cabal2nix True (argDetailLevel args) src cabalFile
9897
return $ fromString pkg $= mkPath False nix
99-
(_name, Just (Package _vers _flags (Just (DVCS (Git url rev) subdirs)) False)) ->
98+
(_name, Just (Package v flags (Just (DVCS (Git url rev) subdirs)) False)) ->
10099
fmap concat . forM subdirs $ \subdir ->
101100
do cacheHits <- liftIO $ cacheHits (argCacheFile args) url rev subdir
102101
case cacheHits of
@@ -109,22 +108,20 @@ plan2nix args Plan { packages, extras, components, compilerVersion, compilerPack
109108
forM hits $ \( pkg, nix ) -> do
110109
return $ fromString pkg $= mkPath False nix
111110
_ -> return []
112-
113111
let flags = concatMap (\case
114-
(name, Just (Package _vers f _hasDescriptionOverride _)) -> flags2nix name f
112+
(name, Just (Package _v f _hasDescriptionOverride _)) -> flags2nix name f
115113
_ -> []) $ Map.toList extras
116-
117114
-- Set the `planned` option for all components in the plan.
118115
planned = map (\name -> name <> ".planned" $=
119116
("lib" @. "mkOverride" @@ mkInt 900 @@ mkBool True)) $ Set.toList components
120117

121118
return $ mkNonRecSet [
122119
"pkgs" $= ("hackage" ==> mkNonRecSet
123-
[ "packages" $= mkNonRecSet (Map.toList packages >>= \(name, pkg) -> bind name pkg)
120+
[ "packages" $= mkNonRecSet (uncurry bind =<< Map.toList packages)
124121
, "compiler" $= mkNonRecSet
125122
[ "version" $= mkStr compilerVersion
126123
, "nix-name" $= mkStr ("ghc" <> Text.filter (/= '.') compilerVersion)
127-
, "packages" $= mkNonRecSet [ pkgName $= maybe mkNull mkStr ver | (pkgName, ver) <- Map.toList compilerPackages ]
124+
, "packages" $= mkNonRecSet (fmap (uncurry bind') $ Map.toList $ mapKeys quoted compilerPackages)
128125
]
129126
])
130127
, "extras" $= ("hackage" ==> mkNonRecSet [ "packages" $= extrasNix ])
@@ -135,30 +132,19 @@ plan2nix args Plan { packages, extras, components, compilerVersion, compilerPack
135132
]
136133
where
137134
bind :: Text -> Maybe Package -> [Binding NExpr]
138-
bind pkg Nothing =
139-
[revBinding pkg mkNull]
140135
bind pkg (Just Package { packageFlags, packageHasDescriptionOverride = True }) =
141-
bindPath (VarName pkg :| ["revision"]) (mkSym "import" @@ mkPath False ("." </> "cabal-files" </> T.unpack pkg <.> "nix"))
142-
: bindPath (VarName pkg :| ["cabalFile"]) (mkPath False ("." </> "cabal-files" </> T.unpack pkg <.> "cabal"))
143-
: flagBindings
144-
145-
where
146-
flagBindings = Map.foldrWithKey
147-
(\fname val acc -> bindPath (VarName pkg :| ["flags", fname]) (mkBool val) : acc)
148-
[]
149-
packageFlags
150-
136+
bindPath (VarName pkg :| ["revision"]) (mkSym "import" @@ mkPath False ("." </> "cabal-files" </> Text.unpack pkg <.> "nix"))
137+
: bindPath (VarName pkg :| ["cabalFile"]) (mkPath False ("." </> "cabal-files" </> Text.unpack pkg <.> "cabal"))
138+
: flagBindings pkg packageFlags
151139
bind pkg (Just Package { packageVersion, packageFlags, packageHasDescriptionOverride = False }) =
152140
let verExpr = (mkSym "hackage" @. pkg) @. quoted packageVersion
153141
revExpr = (verExpr @. "revisions") @. "default"
154-
flagBindings = Map.foldrWithKey
155-
(\fname val acc -> bindPath (VarName pkg :| ["flags", fname]) (mkBool val) : acc)
156-
[]
157-
packageFlags
158-
in revBinding pkg revExpr : flagBindings
159-
142+
in revBinding pkg revExpr : flagBindings pkg packageFlags
143+
bind pkg Nothing = [revBinding pkg mkNull]
160144
revBinding :: Text -> NExpr -> Binding NExpr
161145
revBinding pkg revExpr = bindPath (VarName pkg :| ["revision"]) revExpr
146+
bind' pkg ver = pkg $= maybe mkNull mkStr ver
147+
mapKeys f = Map.fromList . fmap (\(k, v) -> (f k, v)) . Map.toList
162148

163149
relPath = shortRelativePath (argOutputDir args) (dropFileName (argCabalProject args))
164150
cabalFromPath
@@ -183,6 +169,10 @@ plan2nix args Plan { packages, extras, components, compilerVersion, compilerPack
183169
writeDoc nixFile . prettyNix =<< cabal2nix True (argDetailLevel args) src cabalFile
184170
liftIO $ appendCache (argCacheFile args) url rev subdir sha256 pkg nix
185171
return $ fromString pkg $= mkPath False nix
172+
flagBindings pkg packageFlags = Map.foldrWithKey
173+
(\fname val acc -> bindPath (VarName pkg :| ["flags", fname]) (mkBool val) : acc)
174+
[]
175+
packageFlags
186176

187177
-- | Converts the project flags for a package flags into @{ packageName = { flags = { flagA = BOOL; flagB = BOOL; }; }; }@
188178
flags2nix :: Text -> HashMap VarName Bool -> [Binding NExpr]
@@ -199,69 +189,60 @@ flags2nix pkgName pkgFlags =
199189
value2plan :: Value -> Plan
200190
value2plan plan = Plan { packages, components, extras, compilerVersion, compilerPackages }
201191
where
202-
packages =
203-
fmap Just $
204-
filterInstallPlan $ \pkg ->
205-
case ( pkg ^. key "type" . _String , pkg ^. key "style" . _String) of
206-
-- source-repo packages will be included in `extras`. We do not need them
207-
-- in `packages` as well (this could lead to attribute not found errors looking
208-
-- for them in hackage).
209-
(_, _) | pkg ^. key "pkg-src" . key "type" . _String == "source-repo" -> Nothing
210-
211-
(_, "global") -> Just $ Package
212-
{ packageVersion = pkg ^. key "pkg-version" . _String
213-
, packageFlags = Map.fromList . fmap (\(k, v) -> (VarName (Key.toText k), v))
214-
. KeyMap.toList $ KeyMap.mapMaybe (^? _Bool) $ pkg ^. key "flags" . _Object
215-
, packageSrc = Nothing
216-
, packageHasDescriptionOverride = isJust (pkg ^? key "pkg-cabal-sha256")
217-
}
218-
219-
(_, "inplace") -> Just $ Package
220-
{ packageVersion = pkg ^. key "pkg-version" . _String
221-
, packageFlags = Map.fromList . fmap (\(k, v) -> (VarName (Key.toText k), v))
222-
. KeyMap.toList $ KeyMap.mapMaybe (^? _Bool) $ pkg ^. key "flags" . _Object
223-
, packageSrc = Nothing
224-
, packageHasDescriptionOverride = isJust (pkg ^? key "pkg-cabal-sha256")
225-
}
226-
227-
-- Until we figure out how to force Cabal to reconfigure just about any package
228-
-- this here might be needed, so that we get the pre-existing packages as well.
229-
-- Or we would have to plug in our very custom minimal pkg-db as well.
230-
--
231-
-- The issue is that cabal claims anything in the package db as pre-existing and
232-
-- wants to reuse it if possible.
233-
("pre-existing",_) -> Just $ Package
234-
{ packageVersion = pkg ^. key "pkg-version" . _String
235-
, packageFlags = Map.empty
236-
, packageSrc = Nothing
237-
, packageHasDescriptionOverride = isJust (pkg ^? key "pkg-cabal-sha256") -- likely this is always false
238-
}
239-
240-
_ -> Nothing
241-
242-
extras =
243-
fmap Just $
244-
filterInstallPlan $ \pkg ->
245-
case ( pkg ^. key "style" . _String , pkg ^. key "pkg-src" . key "type" . _String) of
246-
("local", "local") -> Just $ Package
247-
{ packageVersion = pkg ^. key "pkg-version" . _String
248-
, packageFlags = Map.fromList . fmap (\(k, v) -> (VarName (Key.toText k), v))
249-
. KeyMap.toList $ KeyMap.mapMaybe (^? _Bool) $ pkg ^. key "flags" . _Object
250-
, packageSrc = Just . LocalPath . Text.unpack $ pkg ^. key "pkg-src" . key "path" . _String
251-
, packageHasDescriptionOverride = isJust (pkg ^? key "pkg-cabal-sha256") -- likely this is always false
252-
}
253-
254-
(_, "source-repo") -> Just $ Package
255-
{ packageVersion = pkg ^. key "pkg-version" . _String
256-
, packageFlags = Map.fromList . fmap (\(k, v) -> (VarName (Key.toText k), v))
257-
. KeyMap.toList $ KeyMap.mapMaybe (^? _Bool) $ pkg ^. key "flags" . _Object
258-
, packageSrc = Just . flip DVCS [ Text.unpack $ fromMaybe "." $ pkg ^? key "pkg-src" . key "source-repo" . key "subdir" . _String ] $
259-
Git ( Text.unpack $ pkg ^. key "pkg-src" . key "source-repo" . key "location" . _String )
260-
( Text.unpack $ pkg ^. key "pkg-src" . key "source-repo" . key "tag" . _String )
261-
, packageHasDescriptionOverride = isJust (pkg ^? key "pkg-cabal-sha256") -- likely this is always false
262-
}
263-
264-
_ -> Nothing
192+
packages = fmap Just $ filterInstallPlan $ \pkg -> case ( pkg ^. key "type" . _String
193+
, pkg ^. key "style" . _String) of
194+
-- source-repo packages will be included in `extras`. We do not need them
195+
-- in `packages` as well (this could lead to attribute not found errors looking
196+
-- for them in hackage).
197+
(_, _) | pkg ^. key "pkg-src" . key "type" . _String == "source-repo" -> Nothing
198+
(_, "global") -> Just $ Package
199+
{ packageVersion = pkg ^. key "pkg-version" . _String
200+
, packageFlags = Map.fromList . fmap (\(k, v) -> (VarName (Key.toText k), v))
201+
. KeyMap.toList $ KeyMap.mapMaybe (^? _Bool) $ pkg ^. key "flags" . _Object
202+
, packageSrc = Nothing
203+
, packageHasDescriptionOverride = isJust (pkg ^? key "pkg-cabal-sha256")
204+
}
205+
206+
(_, "inplace") -> Just $ Package
207+
{ packageVersion = pkg ^. key "pkg-version" . _String
208+
, packageFlags = Map.fromList . fmap (\(k, v) -> (VarName (Key.toText k), v))
209+
. KeyMap.toList $ KeyMap.mapMaybe (^? _Bool) $ pkg ^. key "flags" . _Object
210+
, packageSrc = Nothing
211+
, packageHasDescriptionOverride = isJust (pkg ^? key "pkg-cabal-sha256")
212+
}
213+
-- Until we figure out how to force Cabal to reconfigure just about any package
214+
-- this here might be needed, so that we get the pre-existing packages as well.
215+
-- Or we would have to plug in our very custom minimal pkg-db as well.
216+
--
217+
-- The issue is that cabal claims anything in the package db as pre-existing and
218+
-- wants to reuse it if possible.
219+
("pre-existing",_) -> Just $ Package
220+
{ packageVersion = pkg ^. key "pkg-version" . _String
221+
, packageFlags = Map.empty
222+
, packageSrc = Nothing
223+
, packageHasDescriptionOverride = isJust (pkg ^? key "pkg-cabal-sha256") -- likely this is always false
224+
}
225+
_ -> Nothing
226+
227+
extras = fmap Just $ filterInstallPlan $ \pkg -> case ( pkg ^. key "style" . _String
228+
, pkg ^. key "pkg-src" . key "type" . _String) of
229+
("local", "local") -> Just $ Package
230+
{ packageVersion = pkg ^. key "pkg-version" . _String
231+
, packageFlags = Map.fromList . fmap (\(k, v) -> (VarName (Key.toText k), v))
232+
. KeyMap.toList $ KeyMap.mapMaybe (^? _Bool) $ pkg ^. key "flags" . _Object
233+
, packageSrc = Just . LocalPath . Text.unpack $ pkg ^. key "pkg-src" . key "path" . _String
234+
, packageHasDescriptionOverride = isJust (pkg ^? key "pkg-cabal-sha256") -- likely this is always false
235+
}
236+
(_, "source-repo") -> Just $ Package
237+
{ packageVersion = pkg ^. key "pkg-version" . _String
238+
, packageFlags = Map.fromList . fmap (\(k, v) -> (VarName (Key.toText k), v))
239+
. KeyMap.toList $ KeyMap.mapMaybe (^? _Bool) $ pkg ^. key "flags" . _Object
240+
, packageSrc = Just . flip DVCS [ Text.unpack $ fromMaybe "." $ pkg ^? key "pkg-src" . key "source-repo" . key "subdir" . _String ] $
241+
Git ( Text.unpack $ pkg ^. key "pkg-src" . key "source-repo" . key "location" . _String )
242+
( Text.unpack $ pkg ^. key "pkg-src" . key "source-repo" . key "tag" . _String )
243+
, packageHasDescriptionOverride = isJust (pkg ^? key "pkg-cabal-sha256") -- likely this is always false
244+
}
245+
_ -> Nothing
265246

266247
compilerVersion = Text.dropWhile (not . isDigit) $ plan ^. key "compiler-id" . _String
267248
compilerPackages = fmap Just $ filterInstallPlan $ \pkg -> if isJust (pkg ^? key "style" . _String)

0 commit comments

Comments
 (0)