diff --git a/nixfromnpm.cabal b/nixfromnpm.cabal --- a/nixfromnpm.cabal +++ b/nixfromnpm.cabal @@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: nixfromnpm -version: 0.1.0.6 +version: 0.1.0.7 synopsis: Generate nix expressions from npm packages. -- description: license: MIT @@ -31,6 +31,7 @@ , mtl , bytestring , unordered-containers + , containers , parsec , aeson , data-default @@ -42,7 +43,7 @@ , filepath , network-uri , directory - , simple-nix >=0.1.0.4 + , hnix hs-source-dirs: src default-language: Haskell2010 @@ -50,14 +51,23 @@ executable nixfromnpm main-is: Main.hs --- other-modules: NixFromNpm + other-modules: NixFromNpm.Common + , NixFromNpm.ConvertToNix + , NixFromNpm.NpmLookup + , NixFromNpm.NpmTypes + , NixFromNpm.NpmVersion + , NixFromNpm.SemVer + , NixFromNpm.Parsers.Common + , NixFromNpm.Parsers.NpmVersion + , NixFromNpm.Parsers.SemVer other-extensions: NoImplicitPrelude, OverloadedStrings - build-depends: base >=4.8 && <4.9 + build-depends: base >=4.8 && <4.9 , classy-prelude , text , mtl , bytestring , unordered-containers + , containers , parsec , aeson , data-default @@ -69,7 +79,7 @@ , filepath , network-uri , directory - , simple-nix >=0.1.0.4 + , hnix , docopt hs-source-dirs: src default-language: Haskell2010 @@ -86,6 +96,7 @@ , text , bytestring , unordered-containers + , containers , parsec , io-streams , http-client-streams @@ -102,4 +113,4 @@ , filepath , network-uri , directory - , simple-nix + , hnix diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -23,15 +23,14 @@ \ package\n\ \ --node-version VERSION Use this version of node\n" -getFlag args f = isPresent args (longOption f) - main :: IO () main = do patterns <- parseUsageOrExit usageString args <- parseArgsOrExit patterns =<< getArgs - let args ?? arg = getArgOrExitWith patterns args (argument arg) - pkgName <- map pack $ args ?? "packagename" - path <- map pack $ args ?? "outputpath" + let getText = map pack . getArgOrExitWith patterns args + getFlag = isPresent args . longOption + pkgName <- getText (argument "packagename") + path <- getText (longOption "output") dumpPkgFromOptions $ (defaultOptions pkgName path) { - nfnoNoCache = args `getFlag` "no-cache" + nfnoNoCache = getFlag "no-cache" } diff --git a/src/NixFromNpm/ConvertToNix.hs b/src/NixFromNpm/ConvertToNix.hs --- a/src/NixFromNpm/ConvertToNix.hs +++ b/src/NixFromNpm/ConvertToNix.hs @@ -6,123 +6,158 @@ import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as H +import Data.Map (Map) +import qualified Data.Map as M import Data.Text (Text) import qualified Data.Text as T import NixFromNpm.Common -import Nix.Expr +import Nix.Types import Nix.Parser +import Nix.Pretty (prettyNix) import NixFromNpm.NpmTypes import NixFromNpm.SemVer import NixFromNpm.Parsers.SemVer import NixFromNpm.NpmLookup -_startingSrc :: Text -_startingSrc = unlines [ - "{nixpkgs ? import {}}:", - "let", - " allPkgs = nixpkgs // nodePkgs // {inherit (nixpkgs.nodePackages)", - " buildNodePackage;};", - " callPackage = pth: overrides: let", - " f = import pth;", - " in", - " f ((builtins.intersectAttrs (builtins.functionArgs f) allPkgs)", - " // overrides);", - " nodePkgs = byVersion // defaults;", - "in", - "nodePkgs" - ] +_startingSrc :: String +_startingSrc = "\ + \{nixpkgs ? import {}}:\n\ + \let\n\ + \ allPkgs = nixpkgs // nodePkgs // {inherit (nixpkgs.nodePackages)\n\ + \ buildNodePackage;};\n\ + \ callPackage = pth: overrides: let\n\ + \ f = import pth;\n\ + \ in\n\ + \ f ((builtins.intersectAttrs (builtins.functionArgs f) allPkgs)\n\ + \ // overrides);\n\ + \ nodePkgs = byVersion // defaults;\n\ + \in\n\ + \nodePkgs" -_startingExpr :: NixExpr -_startingExpr = fromRight $ parseNix _startingSrc +_startingExpr :: NExpr +_startingExpr = case parseNixString _startingSrc of + Success e -> e + Failure e -> error $ unlines ["Starting source failed to parse:", show e] -callPackage :: NixExpr -> NixExpr -callPackage e = Apply (Apply (Var "callPackage") e) (Set False []) +callPackage :: NExpr -> NExpr +callPackage = callPackageWith [] +callPackageWith :: [Binding NExpr] -> NExpr -> NExpr +callPackageWith args e = mkApp (mkApp (mkSym "callPackage") e) + (mkNonRecSet args) + +callPackageWithRec :: [Binding NExpr] -> NExpr -> NExpr +callPackageWithRec args e = mkApp (mkApp (mkSym "callPackage") e) + (mkRecSet args) + +-- | Turns a string into one that can be used as an identifier. fixName :: Name -> Name fixName = T.replace "." "-" +-- | Converts a package name and semver into an identifier. toDepName :: Name -> SemVer -> Name toDepName name (a, b, c) = concat [fixName name, "_", pack $ intercalate "-" $ map show [a, b, c]] +-- | Gets the .nix filename of a semver. E.g. (0, 1, 2) -> 0.1.2.nix toDotNix :: SemVer -> Text toDotNix (a,b,c) = pack $ intercalate "." (map show [a,b,c]) <> ".nix" -distInfoToNix :: DistInfo -> NixExpr -distInfoToNix DistInfo{..} = Apply (Var "fetchurl") $ Set False - [ "url" =$= str diUrl, - "sha1" =$= str diShasum ] +-- | Creates a doublequoted string from some text. +str :: Text -> NExpr +str = mkStr DoubleQuoted +-- | Converts distinfo into a nix fetchurl call. +distInfoToNix :: DistInfo -> NExpr +distInfoToNix DistInfo{..} = mkApp (mkSym "fetchurl") $ mkNonRecSet + [ "url" `bindTo` str diUrl, + "sha1" `bindTo` str diShasum ] + +-- | Tests if there is information in the package meta. metaNotEmpty :: PackageMeta -> Bool metaNotEmpty PackageMeta{..} = isJust pmDescription -metaToNix :: PackageMeta -> NixExpr +-- | Converts package meta to a nix expression. +metaToNix :: PackageMeta -> NExpr metaToNix PackageMeta{..} = case pmDescription of - Nothing -> Set False [] - Just d -> Set False ["description" =$= str d] + Nothing -> mkNonRecSet [] + Just d -> mkNonRecSet ["description" `bindTo` str d] -resolvedPkgToNix :: ResolvedPkg -> NixExpr +-- | Converts a resolved package object into a nix expression. The expresion +-- will be a function where the arguments are its dependencies, and its result +-- is a call to `buildNodePackage`. +resolvedPkgToNix :: ResolvedPkg -> NExpr resolvedPkgToNix ResolvedPkg{..} = do - let deps = map (Var . uncurry toDepName) $ H.toList rpDependencies + let -- Get a string representation of each dependency in name-version format. + deps = map (mkSym . uncurry toDepName) $ H.toList rpDependencies + -- Get the parameters of the package function (deps + utility functions). _funcParams = map (uncurry toDepName) (H.toList rpDependencies) <> ["buildNodePackage", "fetchurl"] - funcParams = toKwargs $ map (\x -> (x, Nothing)) _funcParams - let args = Set False $ catMaybes [ - Just $ "name" =$= str rpName, - Just $ "version" =$= (str $ renderSV rpVersion), - Just $ "src" =$= distInfoToNix rpDistInfo, - maybeIf (length deps > 0) $ "deps" =$= List deps, - maybeIf (metaNotEmpty rpMeta) $ "meta" =$= metaToNix rpMeta + -- None of these have defaults, so put them into pairs with Nothing. + funcParams = mkFormalSet $ map (\x -> (x, Nothing)) _funcParams + let args = mkNonRecSet $ catMaybes [ + Just $ "name" `bindTo` str rpName, + Just $ "version" `bindTo` (str $ renderSV rpVersion), + Just $ "src" `bindTo` distInfoToNix rpDistInfo, + maybeIf (length deps > 0) $ "deps" `bindTo` mkList deps, + maybeIf (metaNotEmpty rpMeta) $ "meta" `bindTo` metaToNix rpMeta ] - Function funcParams $ Apply (Var "buildNodePackage") args + mkFunction funcParams $ mkApp (mkSym "buildNodePackage") args -mkDefault :: Record (HashMap SemVer a) -> NixExpr -mkDefault rec = do - let mkPath name ver = fromText $ concat ["./", name, "/", toDotNix ver] - mkAssign name ver = Assign [Plain $ toDepName name ver] - (callPackage $ Path $ mkPath name ver) - mkAssigns name vers = map (mkAssign name) vers +-- | Creates the `default.nix` file that is the top-level expression we are +-- generating. +mkDefaultNix :: Record (HashMap SemVer a) -> NExpr +mkDefaultNix rec = do + let mkPath' = mkPath False . unpack + toPath name ver = mkPath' $ concat ["./", name, "/", toDotNix ver] + mkBinding name ver = toDepName name ver + `bindTo` callPackage (toPath name ver) + mkBindings name vers = map (mkBinding name) vers mkDefVer name vers = do - Assign [Plain $ fixName name] (Var $ toDepName name $ maximum vers) + fixName name `bindTo` mkSym (toDepName name $ maximum vers) -- This bit of map gymnastics will create a list of pairs of names -- with all of the versions of that name that we have. versOnly = map (map (map fst)) $ H.toList $ map H.toList rec - byVersion = Set False $ concatMap (uncurry mkAssigns) versOnly - defaults = With (Var "byVersion") $ - Set False $ map (uncurry mkDefVer) versOnly - newAssigns = ["byVersion" =$= byVersion, "defaults" =$= defaults] - Function params (Let assigns e) = _startingExpr - Function params (Let (assigns <> newAssigns) e) + byVersion = mkNonRecSet $ concatMap (uncurry mkBindings) versOnly + defaults = mkWith (mkSym "byVersion") $ + mkNonRecSet $ map (uncurry mkDefVer) versOnly + newBindings = ["byVersion" `bindTo` byVersion, + "defaults" `bindTo` defaults] + modifyFunctionBody (appendBindings newBindings) _startingExpr dumpPkgs :: MonadIO m => String - -> Record (HashMap SemVer (Either NixExpr ResolvedPkg)) + -> Record (HashMap SemVer (Either NExpr ResolvedPkg)) -> m () dumpPkgs path rPkgs = liftIO $ do createDirectoryIfMissing True path withDir path $ forM_ (H.toList rPkgs) $ \(pkgName, pkgVers) -> do - writeFile "default.nix" $ renderIndented 2 $ mkDefault rPkgs + writeFile "default.nix" $ show $ prettyNix $ mkDefaultNix rPkgs let subdir = path unpack pkgName createDirectoryIfMissing False subdir withDir subdir $ forM_ (H.toList pkgVers) $ \(ver, rpkg) -> do let nixexpr = case rpkg of + -- A left value means it had already existed; we can simply + -- dump out the package we had before. Left e -> e + -- A right value means it's a ResolvedPkg object; in this case + -- we convert it to a nix expression. Right r -> resolvedPkgToNix r - writeFile (unpack $ toDotNix ver) $ renderIndented 2 nixexpr + writeFile (unpack $ toDotNix ver) $ show $ prettyNix nixexpr -parseVersion :: String -> IO (Maybe (SemVer, NixExpr)) +parseVersion :: String -> IO (Maybe (SemVer, NExpr)) parseVersion pth = do case parseSemVer . pack $ dropSuffix ".nix" $ takeBaseName pth of Left _ -> return Nothing -- not a version file - Right version -> parseNix . pack <$> readFile pth >>= \case - Left err -> do + Right version -> parseNixString . pack <$> readFile pth >>= \case + Failure err -> do putStrsLn [pack pth, " failed to parse: ", pack $ show err] return Nothing -- invalid nix, should overwrite - Right expr -> return $ Just (version, expr) + Success expr -> return $ Just (version, expr) -findExisting :: String -> IO (Record (HashMap SemVer NixExpr)) +findExisting :: String -> IO (Record (HashMap SemVer NExpr)) findExisting path = do putStrLn "Searching for existing expressions..." doesDirectoryExist path >>= \case diff --git a/src/NixFromNpm/NpmLookup.hs b/src/NixFromNpm/NpmLookup.hs --- a/src/NixFromNpm/NpmLookup.hs +++ b/src/NixFromNpm/NpmLookup.hs @@ -29,13 +29,13 @@ import NixFromNpm.Parsers.SemVer import NixFromNpm.NpmVersion import NixFromNpm.Parsers.NpmVersion -import Nix.Expr +import Nix.Types -------------------------------------------------------------------------- data NpmFetcherState = NpmFetcherState { registries :: [URI], githubAuthToken :: Maybe Text, - resolved :: Record (HashMap SemVer (Either NixExpr ResolvedPkg)), + resolved :: Record (HashMap SemVer (Either NExpr ResolvedPkg)), pkgInfos :: Record PackageInfo, -- For cycle detection. currentlyResolving :: HashSet (Name, SemVer), @@ -379,7 +379,7 @@ Nothing -> errorC ["Invalid URI: ", txt] Just uri -> uri -startState :: Record (HashMap SemVer NixExpr) +startState :: Record (HashMap SemVer NExpr) -> [Text] -> Maybe Text -> NpmFetcherState @@ -421,8 +421,8 @@ (Right x, state) -> return (x, state) getPkg :: Name - -> Record (HashMap SemVer NixExpr) - -> IO (Record (HashMap SemVer (Either NixExpr ResolvedPkg))) + -> Record (HashMap SemVer NExpr) + -> IO (Record (HashMap SemVer (Either NExpr ResolvedPkg))) getPkg name existing = do let range = Gt (0, 0, 0) state <- startState existing <$> getRegistries <*> getToken