Skip to content

Use nix instead of json in output of hackage-to-nix #118

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 1 commit into from
Aug 3, 2022
Merged

Use nix instead of json in output of hackage-to-nix #118

Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
86 changes: 52 additions & 34 deletions hackage2nix/Main.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,18 +1,16 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE LambdaCase #-}

module Main where

import Cabal2Nix
import Cabal2Nix.Util ( quoted )
import Control.Applicative ( liftA2 )
import Control.Monad.Trans.State.Strict
import Crypto.Hash.SHA256 ( hash )
import Data.Aeson
import Data.Aeson.Types ( Pair )
import Data.Aeson.Encode.Pretty
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_
)
Expand All @@ -25,6 +23,7 @@ import qualified Data.Sequence as Seq
import Data.String ( IsString(fromString)
)
import Data.Text ( Text )
import qualified Data.Text as T ( pack )
import Data.Text.Encoding ( decodeUtf8 )
import Distribution.Hackage.DB ( hackageTarball )
import qualified Distribution.Hackage.DB.Parsed
Expand All @@ -36,13 +35,30 @@ import Distribution.Pretty ( prettyShow
)
import Distribution.Types.PackageName ( PackageName )
import Distribution.Types.Version ( Version )
import Nix ( (@@)
, mkSym
, mkInt
, mkStr
, NExpr
, ($=)
, mkNonRecSet
)
import Nix.Pretty ( prettyNix )
import System.Directory ( createDirectoryIfMissing
)
import System.Environment ( getArgs )
import System.FilePath ( (</>)
, (<.>)
)
import Data.Char (isUpper)

-- Avoid issues with case insensitive file systems by escaping upper case
-- characters with a leading _ character.
escapeUpperCase :: String -> String
Copy link
Contributor

@yvan-sraka yvan-sraka Aug 3, 2022 •
edited
Loading

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This sounds a bit like a custom hack to me … what about just add something like a base64 representation of strings we want to encode?

Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

As this is for filenames, base64 encoding would make it a lot less readable :-/

I wonder if we'd run into camelCase issues.

That would be converted into camel_case, and thus clash with a package named camel_case? Can we rule out that this would happen?

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I wanted the file names to still be human readable. I guess we could include both human and base64 encoding, but then it is kind of a custom format again.

Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

My hot take would be that here we had a good opportunity to hide this hack behind an abstraction, meaning a small lib. This is a micro Haskell project I would be glad to publish on Hackage!

escapeUpperCase = (>>= (\case
'_' -> "__"
c | isUpper c -> ['_', c]
| otherwise -> [c]))

main :: IO ()
main = do
Expand All @@ -53,23 +69,25 @@ main = do

db <- U.readTarball Nothing inp

let (defaultJson, cabalFiles) =
runState (fmap (object . toList . (Seq.sortOn fst)) $ foldMapWithKeyA package2json db) mempty
let (nixFiles, cabalFiles) =
runState (fmap (toList . (Seq.sortOn fst)) $ foldMapWithKeyA package2nix db) mempty
createDirectoryIfMissing False out
BL.writeFile (out </> "default.nix") $
writeFile (out </> "default.nix") $
"with builtins; mapAttrs (_: mapAttrs (_: data: rec {\n\
\ inherit (data) sha256;\n\
\ revisions = (mapAttrs (rev: rdata: {\n\
\ inherit (rdata) revNum sha256;\n\
\ outPath = ./. + \"/hackage/${rdata.outPath}\";\n\
\ }) data.revisions) // {\n\
\ revisions = data.revisions // {\n\
\ default = revisions.\"${data.revisions.default}\";\n\
\ };\n\
\})) (fromJSON (readFile ./hackage.json))\n"
\})) {\n"
-- Import all the per package nix files
<> mconcat (map (\(pname, _) ->
" " <> quoted pname <> " = import ./nix/" <> escapeUpperCase pname <> ".nix;\n") nixFiles)
<> "}\n"

createDirectoryIfMissing False (out </> "nix")
for_ nixFiles $ \(pname, nix) ->
writeFile (out </> "nix" </> escapeUpperCase pname <.> "nix") $ show $ prettyNix nix

BL.writeFile (out </> "hackage.json") $ encodePretty'
(defConfig {confCompare = compare, confIndent = Spaces 1})
defaultJson
createDirectoryIfMissing False (out </> "hackage")

for_ cabalFiles $ \(cabalFile, pname, path) -> do
Expand All @@ -93,32 +111,32 @@ foldMapWithKeyA f =
fromPretty :: (Pretty a, IsString b) => a -> b
fromPretty = fromString . prettyShow

package2json :: PackageName -> U.PackageData -> GPDWriter (Seq Pair)
package2json pname (U.PackageData { U.versions }) = do
versionBindings <- foldMapWithKeyA (version2json pname) versions
return $ Seq.singleton $ fromPretty pname .= (object . toList $ Seq.sortOn fst $ versionBindings)
package2nix :: PackageName -> U.PackageData -> GPDWriter (Seq (String, NExpr))
package2nix pname (U.PackageData { U.versions }) = do
versionBindings <- foldMapWithKeyA (version2nix pname) versions
return $ Seq.singleton (fromPretty pname, (mkNonRecSet . map (uncurry ($=)) . toList $ Seq.sortOn fst $ versionBindings))

version2json
:: PackageName -> Version -> U.VersionData -> GPDWriter (Seq (Pair))
version2json pname vnum (U.VersionData { U.cabalFileRevisions, U.metaFile }) =
version2nix
:: PackageName -> Version -> U.VersionData -> GPDWriter (Seq (Text, NExpr))
version2nix pname vnum (U.VersionData { U.cabalFileRevisions, U.metaFile }) =
do
revisionBindings <- sequenceA
$ zipWith (revBindingJson pname vnum) cabalFileRevisions [0 ..]
let hash = decodeUtf8 $ fromString $ P.parseMetaData pname vnum metaFile Map.! "sha256"
return $ Seq.singleton $ fromPretty vnum .= object
[ "sha256" .= hash
, "revisions" .= object
( revisionBindings
++ ["default" .= fst (last revisionBindings)]
return $ Seq.singleton (quoted (fromPretty vnum), mkNonRecSet
[ "sha256" $= mkStr hash
, "revisions" $= mkNonRecSet
( map (uncurry ($=)) revisionBindings
++ ["default" $= mkStr (fst (last revisionBindings))]
)
]
])

revBindingJson
:: PackageName
-> Version
-> BS.ByteString
-> Integer
-> GPDWriter (Key, Value)
-> GPDWriter (Text, NExpr)
revBindingJson pname vnum cabalFile revNum = do
let qualifiedName = mconcat $ intersperse
"-"
Expand All @@ -130,8 +148,8 @@ revBindingJson pname vnum cabalFile revNum = do
cabalHash = Base16.encode $ hash cabalFile
modify' $ mappend $ Seq.singleton
(cabalFile, prettyPname ++ ".cabal", revPath)
return $ revName .= object
[ "outPath" .= (qualifiedName <> ".nix")
, "revNum" .= revNum
, "sha256" .= decodeUtf8 cabalHash
]
return (revName, mkNonRecSet
[ "nix" $= mkSym "import" @@ mkSym (T.pack ("../hackage/" <> qualifiedName <> ".nix"))
, "revNum" $= mkInt revNum
, "sha256" $= mkStr (decodeUtf8 cabalHash)
])