nixfromnpm 0.1.0.7 → 0.2.1
raw patch · 7 files changed
+353/−143 lines, 7 filesdep +nixfromnpmdep +optparse-applicativedep −docoptPVP ok
version bump matches the API change (PVP)
Dependencies added: nixfromnpm, optparse-applicative
Dependencies removed: docopt
API changes (from Hackage documentation)
- NixFromNpm: [nfnoPkgName] :: NixFromNpmOptions -> Name
- NixFromNpm: _defaultCurlArgs :: [Text]
- NixFromNpm: defaultOptions :: Name -> Text -> NixFromNpmOptions
+ NixFromNpm: FromExistingInExtension :: Name -> NExpr -> FullyDefinedPackage
+ NixFromNpm: FromExistingInOutput :: NExpr -> FullyDefinedPackage
+ NixFromNpm: FromExtension :: Name -> NExpr -> PreExistingPackage
+ NixFromNpm: FromOutput :: NExpr -> PreExistingPackage
+ NixFromNpm: NewPackage :: ResolvedPkg -> FullyDefinedPackage
+ NixFromNpm: [nfnoGithubToken] :: NixFromNpmOptions -> Maybe Text
+ NixFromNpm: [nfnoPkgNames] :: NixFromNpmOptions -> [Name]
+ NixFromNpm: [nfnoPkgPaths] :: NixFromNpmOptions -> [Text]
+ NixFromNpm: concatDots :: SemVer -> Text
+ NixFromNpm: data FullyDefinedPackage
+ NixFromNpm: data PreExistingPackage
+ NixFromNpm: getEnv :: Text -> IO (Maybe Text)
+ NixFromNpm: getExtensions :: [Text] -> Record Path
+ NixFromNpm: mapPM :: (a -> b) -> PackageMap a -> PackageMap b
+ NixFromNpm: modifyMap :: (Eq k, Hashable k) => (a -> Maybe b) -> HashMap k a -> HashMap k b
+ NixFromNpm: pOptions :: Maybe Text -> Parser NixFromNpmOptions
+ NixFromNpm: preloadPackages :: Bool -> Path -> Record Path -> IO (PackageMap PreExistingPackage)
+ NixFromNpm: takeNewPackages :: PackageMap FullyDefinedPackage -> (PackageMap ResolvedPkg, PackageMap NExpr)
+ NixFromNpm: textOption :: Mod OptionFields String -> Parser Text
+ NixFromNpm: toFullyDefined :: PreExistingPackage -> FullyDefinedPackage
+ NixFromNpm: type PackageMap pkg = Record (HashMap SemVer pkg)
+ NixFromNpm: type Path = Text
- NixFromNpm: NixFromNpmOptions :: Name -> Text -> Bool -> [Text] -> Bool -> [Text] -> Int -> NixFromNpmOptions
+ NixFromNpm: NixFromNpmOptions :: [Name] -> [Text] -> Text -> Bool -> [Text] -> Bool -> [Text] -> Int -> Maybe Text -> NixFromNpmOptions
- NixFromNpm: NpmFetcherState :: [URI] -> Maybe Text -> Record (HashMap SemVer (Either NExpr ResolvedPkg)) -> Record PackageInfo -> HashSet (Name, SemVer) -> Int -> HashSet Name -> Bool -> NpmFetcherState
+ NixFromNpm: NpmFetcherState :: [URI] -> Maybe Text -> PackageMap FullyDefinedPackage -> Record PackageInfo -> HashSet (Name, SemVer) -> Int -> HashSet Name -> Bool -> NpmFetcherState
- NixFromNpm: [resolved] :: NpmFetcherState -> Record (HashMap SemVer (Either NExpr ResolvedPkg))
+ NixFromNpm: [resolved] :: NpmFetcherState -> PackageMap FullyDefinedPackage
- NixFromNpm: dumpPkgNamed :: Bool -> Text -> Text -> IO ()
+ NixFromNpm: dumpPkgNamed :: Text -> Path -> PackageMap PreExistingPackage -> Record Path -> Maybe Text -> IO ()
- NixFromNpm: dumpPkgs :: MonadIO m => String -> Record (HashMap SemVer (Either NExpr ResolvedPkg)) -> m ()
+ NixFromNpm: dumpPkgs :: MonadIO m => String -> PackageMap ResolvedPkg -> PackageMap NExpr -> Record Path -> m ()
- NixFromNpm: findExisting :: String -> IO (Record (HashMap SemVer NExpr))
+ NixFromNpm: findExisting :: Maybe Name -> Path -> IO (PackageMap PreExistingPackage)
- NixFromNpm: getPkg :: Name -> Record (HashMap SemVer NExpr) -> IO (Record (HashMap SemVer (Either NExpr ResolvedPkg)))
+ NixFromNpm: getPkg :: Name -> PackageMap PreExistingPackage -> Maybe Text -> IO (PackageMap FullyDefinedPackage)
- NixFromNpm: mkDefaultNix :: Record (HashMap SemVer a) -> NExpr
+ NixFromNpm: mkDefaultNix :: Record [SemVer] -> Record Path -> NExpr
- NixFromNpm: parseVersion :: String -> IO (Maybe (SemVer, NExpr))
+ NixFromNpm: parseVersion :: Name -> Path -> IO (Maybe (SemVer, NExpr))
- NixFromNpm: startState :: Record (HashMap SemVer NExpr) -> [Text] -> Maybe Text -> NpmFetcherState
+ NixFromNpm: startState :: PackageMap PreExistingPackage -> [Text] -> Maybe Text -> NpmFetcherState
Files
- nixfromnpm.cabal +21/−19
- src/Main.hs +14/−27
- src/NixFromNpm.hs +2/−0
- src/NixFromNpm/Common.hs +18/−2
- src/NixFromNpm/ConvertToNix.hs +162/−80
- src/NixFromNpm/NpmLookup.hs +63/−15
- src/NixFromNpm/Options.hs +73/−0
nixfromnpm.cabal view
@@ -1,19 +1,24 @@--- Initial nixfromnpm.cabal generated by cabal init. For further--- documentation, see http://haskell.org/cabal/users-guide/- name: nixfromnpm-version: 0.1.0.7-synopsis: Generate nix expressions from npm packages.--- description:+version: 0.2.1+synopsis: Generate nix expressions from npm packages.+description:+ Given an npm package name and one or more npm repositories, will dump out a+ collection of nix files, one each for the initial package and all of its+ dependencies. Will generate a top-level 'default.nix' which returns a set+ containing all of these expressions. Subsequent invocations of the program+ using the same target directory will result in re-use of the existing files,+ to avoid unnecessary duplication. license: MIT author: Allen Nelson maintainer: anelson@narrativescience.com--- copyright:--- category: build-type: Simple--- extra-source-files: cabal-version: >=1.10+bug-reports: https://github.com/adnelson/nixfromnpm/issues +source-repository head+ type: git+ location: git://github.com/adnelson/nixfromnpm.git+ library exposed-modules: NixFromNpm other-modules: NixFromNpm.Common@@ -21,6 +26,7 @@ , NixFromNpm.NpmLookup , NixFromNpm.NpmTypes , NixFromNpm.NpmVersion+ , NixFromNpm.Options , NixFromNpm.SemVer , NixFromNpm.Parsers.Common , NixFromNpm.Parsers.NpmVersion@@ -44,6 +50,7 @@ , network-uri , directory , hnix+ , optparse-applicative hs-source-dirs: src default-language: Haskell2010 @@ -51,15 +58,7 @@ executable nixfromnpm main-is: Main.hs- other-modules: NixFromNpm.Common- , NixFromNpm.ConvertToNix- , NixFromNpm.NpmLookup- , NixFromNpm.NpmTypes- , NixFromNpm.NpmVersion- , NixFromNpm.SemVer- , NixFromNpm.Parsers.Common- , NixFromNpm.Parsers.NpmVersion- , NixFromNpm.Parsers.SemVer+ -- other-modules: other-extensions: NoImplicitPrelude, OverloadedStrings build-depends: base >=4.8 && <4.9 , classy-prelude@@ -80,7 +79,9 @@ , network-uri , directory , hnix- , docopt+ , nixfromnpm+ , optparse-applicative+ -- extra-libraries: curl hs-source-dirs: src default-language: Haskell2010 @@ -114,3 +115,4 @@ , network-uri , directory , hnix+ , optparse-applicative
src/Main.hs view
@@ -1,36 +1,23 @@ {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-} module Main where -import System.Environment (getArgs)-import System.Console.Docopt.NoTH+import Options.Applicative -import NixFromNpm hiding (getArgs)+import NixFromNpm hiding (getArgs, (<>)) -usageString :: String-usageString = "\- \Usage:\n\- \ nixfromnpm <packagename> [-o PATH] [options]\n\- \Options:\n\- \ -o, --output PATH Output files to this path\n\- \ --extend PATHS... Use nix expressions existing at these\n\- \ paths\n\ - \ --registries REGISTRIES... Use only these registries\n\- \ --extra-registries REGISTRIES.. Use these in addition to default registry\n\- \ --no-cache Don't use existing cache\n\- \ --test Don't write expressions, just fetch\n\- \ --timeout SECONDS Seconds after which to fail fetching a\n\- \ package\n\- \ --node-version VERSION Use this version of node\n" main :: IO () main = do- patterns <- parseUsageOrExit usageString- args <- parseArgsOrExit patterns =<< getArgs- let getText = map pack . getArgOrExitWith patterns args- getFlag = isPresent args . longOption- pkgName <- getText (argument "packagename")- path <- getText (longOption "output")- dumpPkgFromOptions $ (defaultOptions pkgName path) {- nfnoNoCache = getFlag "no-cache"- }+ maybeToken <- getEnv "GITHUB_TOKEN"+ let opts = info (helper <*> pOptions maybeToken)+ (fullDesc <> progDesc description <> header headerText)+ parsedOpts <- execParser opts+ dumpPkgFromOptions parsedOpts+ where+ description = concat ["nixfromnpm allows you to generate nix expressions ",+ "automatically from npm packages. It provides ",+ "features such as de-duplication of shared ",+ "dependencies and advanced customization."]+ headerText = "nixfromnpm - Create nix expressions from NPM"
src/NixFromNpm.hs view
@@ -1,6 +1,7 @@ {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE LambdaCase #-} module NixFromNpm (module NixFromNpm.Common,+ module NixFromNpm.Options, module NixFromNpm.SemVer, module NixFromNpm.Parsers.SemVer, module NixFromNpm.NpmVersion,@@ -10,6 +11,7 @@ module NixFromNpm.ConvertToNix) where import NixFromNpm.Common+import NixFromNpm.Options import NixFromNpm.SemVer import NixFromNpm.Parsers.SemVer import NixFromNpm.NpmVersion
src/NixFromNpm/Common.hs view
@@ -32,10 +32,10 @@ module System.Directory, module Text.Render, module System.FilePath.Posix,- Name, Record,+ Name, Record, Path, tuple, tuple3, fromRight, cerror, cerror', uriToText, uriToString, slash, putStrsLn, pathToText, putStrs, dropSuffix, maybeIf, grab, withDir,- pathToString, joinBy, mapJoinBy+ pathToString, joinBy, mapJoinBy, getEnv, modifyMap ) where import ClassyPrelude hiding (assert, asList, find, FilePath, bracket,@@ -70,12 +70,16 @@ import Network.URI (URI(..), parseURI, parseAbsoluteURI, parseRelativeReference, relativeTo) import qualified Network.URI as NU+import Shelly hiding (get, relativeTo) import System.Directory import System.FilePath.Posix hiding (FilePath) -- | Indicates that the text is some identifier. type Name = Text +-- | Indicates that the text is some path.+type Path = Text+ -- | A record is a lookup table with string keys. type Record = HashMap Name @@ -96,6 +100,14 @@ let newMap = H.fromList newPairs newMap +-- | Create a hashmap by applying a test to everything in the existing+-- map.+modifyMap :: (Eq k, Hashable k) => (a -> Maybe b) -> HashMap k a -> HashMap k b+modifyMap test inputMap = foldl' step mempty $ H.toList inputMap where+ step result (k, elem) = case test elem of+ Nothing -> result+ Just newElem -> H.insert k newElem result+ cerror :: [String] -> a cerror = error . concat @@ -159,3 +171,7 @@ mapJoinBy :: Text -> (a -> Text) -> [a] -> Text mapJoinBy sep func = joinBy sep . map func++-- | Reads an environment variable.+getEnv :: Text -> IO (Maybe Text)+getEnv = shelly . silently . get_env
src/NixFromNpm/ConvertToNix.hs view
@@ -2,6 +2,7 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-} module NixFromNpm.ConvertToNix where import Data.HashMap.Strict (HashMap)@@ -15,31 +16,32 @@ import Nix.Types import Nix.Parser import Nix.Pretty (prettyNix)+import NixFromNpm.Options import NixFromNpm.NpmTypes import NixFromNpm.SemVer import NixFromNpm.Parsers.SemVer-import NixFromNpm.NpmLookup-+import NixFromNpm.NpmLookup (getPkg, FullyDefinedPackage(..), concatDots,+ PackageMap, mapPM, PreExistingPackage(..)) _startingSrc :: String _startingSrc = "\- \{nixpkgs ? import <nixpkgs> {}}:\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\+ \{nixpkgs ? import <nixpkgs> {}}: \+ \let \+ \ inherit (nixpkgs.lib) attrValues foldl; \+ \ joinSets = foldl (a: b: a // b) {}; \+ \ joinedExtensions = joinSets (attrValues extensions); \+ \ allPkgs = nixpkgs // nodePkgs // joinedExtensions // \+ \ {inherit (nixpkgs.nodePackages)buildNodePackage;}; \+ \ callPackage = nixpkgs.lib.callPackageWith allPkgs; \+ \ nodePkgs = joinedExtensions // byVersion // defaults; \+ \in \ \nodePkgs" _startingExpr :: NExpr _startingExpr = case parseNixString _startingSrc of Success e -> e- Failure e -> error $ unlines ["Starting source failed to parse:", show e]+ Failure e -> error $ unlines ["FATAL: Starting source failed to parse:",+ show e] callPackage :: NExpr -> NExpr callPackage = callPackageWith []@@ -60,10 +62,9 @@ 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"+toDotNix v = concatDots v <> ".nix" -- | Creates a doublequoted string from some text. str :: Text -> NExpr@@ -108,106 +109,187 @@ -- | Creates the `default.nix` file that is the top-level expression we are -- generating.-mkDefaultNix :: Record (HashMap SemVer a) -> NExpr-mkDefaultNix rec = do+mkDefaultNix :: Record [SemVer] -- ^ Map of names to versions of packages that+ -- exist in this library.+ -> Record Path -- ^ Map of extensions being included.+ -> NExpr -- ^ A generated nix expression.+mkDefaultNix versionMap extensionMap = do let mkPath' = mkPath False . unpack toPath name ver = mkPath' $ concat ["./", name, "/", toDotNix ver]- mkBinding name ver = toDepName name ver + -- Make a set of all of the extensions+ extensionsSet = mkNonRecSet $+ -- Map over the expression map, creating a binding for each pair.+ flip map (H.toList extensionMap) $ \(name, path) ->+ name `bindTo` (mkApp+ (mkApp (mkSym "import") (mkPath False (unpack path)))+ (mkNonRecSet [Inherit Nothing [mkSelector "nixpkgs"]]))+ mkBinding name ver = toDepName name ver `bindTo` callPackage (toPath name ver) mkBindings name vers = map (mkBinding name) vers- mkDefVer name vers = do- fixName name `bindTo` mkSym (toDepName name $ maximum vers)+ mkDefVer name vers = case vers of+ [] -> errorC ["FATAL: no versions generated for package ", name]+ _ -> 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+ versOnly = sortOn fst $ H.toList versionMap byVersion = mkNonRecSet $ concatMap (uncurry mkBindings) versOnly defaults = mkWith (mkSym "byVersion") $ mkNonRecSet $ map (uncurry mkDefVer) versOnly- newBindings = ["byVersion" `bindTo` byVersion, + newBindings = ["extensions" `bindTo` extensionsSet,+ "byVersion" `bindTo` byVersion, "defaults" `bindTo` defaults] modifyFunctionBody (appendBindings newBindings) _startingExpr +-- | The npm lookup utilities will produce a bunch of fully defined packages.+-- However, the only packages that we want to write are the new ones; that+-- is, the ones that we've discovered and the ones that already exist. This+-- will perform the appropriate filter.+takeNewPackages :: PackageMap FullyDefinedPackage+ -> (PackageMap ResolvedPkg, PackageMap NExpr)+takeNewPackages startingRec = do+ let isNew (NewPackage rpkg) = Just rpkg+ isNew _ = Nothing+ exists (FromExistingInOutput expr) = Just expr+ exists _ = Nothing+ newPkgs = H.map (modifyMap isNew) startingRec+ existingPkgs = H.map (modifyMap exists) startingRec+ removeEmpties = H.filter (not . H.null)+ (removeEmpties newPkgs, removeEmpties existingPkgs)++-- | Actually writes the packages to disk. Takes in the new packages to write,+-- and the names/paths to the libraries being extended. dumpPkgs :: MonadIO m- => String- -> Record (HashMap SemVer (Either NExpr ResolvedPkg))+ => String -- ^ Path to output directory.+ -> PackageMap ResolvedPkg -- ^ New packages being written.+ -> PackageMap NExpr -- ^ Existing packages to be included+ -- in the generated default.nix.+ -> Record Path -- ^ Libraries being extended. -> m ()-dumpPkgs path rPkgs = liftIO $ do- createDirectoryIfMissing True path- withDir path $ forM_ (H.toList rPkgs) $ \(pkgName, pkgVers) -> do- 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) $ show $ prettyNix nixexpr+dumpPkgs path newPackages existingPackages extensions = liftIO $ do+ let _path = pack path+ -- If there aren't any new packages, we can stop here.+ if H.null newPackages+ then putStrLn "No new packages created." >> return ()+ else do+ putStrsLn ["Creating new packages at ", _path]+ createDirectoryIfMissing True path+ withDir path $ do+ -- Write the .nix file for each version of this package.+ forM_ (H.toList newPackages) $ \(pkgName, pkgVers) -> do+ let subdir = path </> unpack pkgName+ createDirectoryIfMissing False subdir+ withDir subdir $ forM_ (H.toList pkgVers) $ \(ver, rpkg) -> do+ let expr = resolvedPkgToNix rpkg+ fullPath = subdir </> unpack (toDotNix ver)+ putStrsLn ["Writing package file at ", pack fullPath]+ writeFile (unpack $ toDotNix ver) $ show $ prettyNix expr+ -- Write the default.nix file for the library.+ -- We need to build up a record mapping package names to the list of+ -- versions being defined in this library.+ let versionMap = map H.keys newPackages <> map H.keys existingPackages+ defaultNix = mkDefaultNix versionMap extensions+ writeFile "default.nix" $ show $ prettyNix defaultNix -parseVersion :: String -> IO (Maybe (SemVer, NExpr))-parseVersion pth = do- case parseSemVer . pack $ dropSuffix ".nix" $ takeBaseName pth of+-- | Given the path to a package, finds all of the .nix files which parse+-- correctly.+parseVersion :: Name -> Path -> IO (Maybe (SemVer, NExpr))+parseVersion pkgName path = do+ let pth = unpack path+ versionTxt = pack $ dropSuffix ".nix" $ takeBaseName pth+ case parseSemVer versionTxt of Left _ -> return Nothing -- not a version file Right version -> parseNixString . pack <$> readFile pth >>= \case Failure err -> do- putStrsLn [pack pth, " failed to parse: ", pack $ show err]+ putStrsLn ["Warning: expression for ", pkgName, " version ",+ versionTxt, " failed to parse:\n", pack $ show err] return Nothing -- invalid nix, should overwrite Success expr -> return $ Just (version, expr) -findExisting :: String -> IO (Record (HashMap SemVer NExpr))-findExisting path = do- putStrLn "Searching for existing expressions..."- doesDirectoryExist path >>= \case- False -> return mempty- True -> withDir path $ do+-- | Given the path to a file possibly containing nix expressions, finds all+-- expressions findable at that path and returns a map of them.+findExisting :: Maybe Name -- ^ Is `Just` if this is an extension.+ -> Path -- ^ The path to search.+ -> IO (PackageMap PreExistingPackage) -- ^ Mapping of package+ -- names to maps of+ -- versions to nix+ -- expressions.+findExisting maybeName path = do+ doesDirectoryExist (unpack path) >>= \case+ False -> case maybeName of+ Just name -> errorC ["Extension ", name, " at path ", path,+ " does not exist."]+ Nothing -> return mempty+ True -> withDir (unpack path) $ do+ let wrapper :: NExpr -> PreExistingPackage+ wrapper = case maybeName of Nothing -> FromOutput+ Just name -> FromExtension name+ putStrsLn ["Searching for existing expressions in ", path, "..."] contents <- getDirectoryContents "." verMaps <- forM contents $ \dir -> do exprs <- doesDirectoryExist dir >>= \case True -> withDir dir $ do contents <- getDirectoryContents "."- let files = filter (endswith ".nix") contents- catMaybes <$> mapM parseVersion files+ let files = pack <$> filter (endswith ".nix") contents+ catMaybes <$> mapM (parseVersion $ pack dir) files False -> do- putStrsLn [pack dir, " is not a directory"] return mempty -- not a directory case exprs of [] -> return Nothing- vs -> return $ Just (pack dir, H.fromList exprs)+ vs -> return $ Just (pack dir, H.map wrapper $ H.fromList exprs) let total = sum $ map (H.size . snd) $ catMaybes verMaps putStrsLn ["Found ", render total, " existing expressions"] return $ H.fromList $ catMaybes verMaps --- | Various options we have available for nixfromnpm. As of right now,--- most of these are unimplemented.-data NixFromNpmOptions = NixFromNpmOptions {- nfnoPkgName :: Name,- nfnoOutputPath :: Text,- nfnoNoCache :: Bool,- nfnoExtendPaths :: [Text],- nfnoTest :: Bool,- nfnoRegistries :: [Text],- nfnoTimeout :: Int-} deriving (Show, Eq)+-- | Given the output directory and any number of extensions to load,+-- finds any existing packages.+preloadPackages :: Bool -- ^ Whether to skip the existence check.+ -> Path -- ^ Output path to search for existing packages.+ -> Record Path -- ^ Mapping of names of libraries to extend,+ -- and paths to those libraries.+ -> IO (PackageMap PreExistingPackage)+preloadPackages noExistCheck path toExtend = do+ existing <- if noExistCheck then pure mempty+ else findExisting Nothing path+ libraries <- fmap concat $ forM (H.toList toExtend) $ \(name, path) -> do+ findExisting (Just name) path+ return (existing <> libraries) -defaultOptions :: Name -> Text -> NixFromNpmOptions-defaultOptions pkgName outputPath = NixFromNpmOptions {- nfnoPkgName = pkgName,- nfnoOutputPath = outputPath,- nfnoNoCache = False,- nfnoExtendPaths = [],- nfnoTest = False,- nfnoTimeout = 10,- nfnoRegistries = []- } +-- | Given the name of a package and a place to dump expressions to, generates+-- the expressions needed to build that package.+dumpPkgNamed :: Text -- ^ The name of the package to fetch.+ -> Path -- ^ The path to output to.+ -> PackageMap PreExistingPackage -- ^ Set of existing packages.+ -> Record Path -- ^ Names -> paths of extensions.+ -> Maybe Text -- ^ Optional github token.+ -> IO () -- ^ Writes files to a folder.+dumpPkgNamed name path existing extensions token = do+ pwd <- getCurrentDirectory+ packages <- getPkg name existing token+ let (new, existing) = takeNewPackages packages+ dumpPkgs (pwd </> unpack path) new existing extensions -dumpPkgNamed :: Bool -> Text -> Text -> IO ()-dumpPkgNamed noExistCheck name path = do- existing <- if noExistCheck then pure mempty else findExisting $ unpack path- getPkg name existing >>= dumpPkgs (unpack path)+-- | Parse the NAME=PATH extension directives.+getExtensions :: [Text] -> Record Path+getExtensions = foldl' step mempty where+ step :: Record Path -> Text -> Record Path+ step exts nameEqPath = case T.split (== '=') nameEqPath of+ [name, path] -> append name path+ [path] -> append (pack $ takeBaseName (unpack path)) path+ _ -> errorC ["Extensions must be of the form NAME=PATH (in argument ",+ nameEqPath, ")"]+ where+ append name path = case H.lookup name exts of+ Nothing -> H.insert name path exts+ Just path' -> errorC ["Extension ", name, " is mapped to both path ",+ path, " and path ", path'] +-- displayExisting :: PackageMap -> IO ()+-- displayExisting pmap = forM_+ dumpPkgFromOptions :: NixFromNpmOptions -> IO () dumpPkgFromOptions NixFromNpmOptions{..} = do- dumpPkgNamed nfnoNoCache nfnoPkgName nfnoOutputPath+ forM_ nfnoPkgNames $ \name -> do+ let extensions = getExtensions nfnoExtendPaths+ existing <- preloadPackages nfnoNoCache nfnoOutputPath extensions+ -- displayExisting existing+ dumpPkgNamed name nfnoOutputPath existing extensions nfnoGithubToken
src/NixFromNpm/NpmLookup.hs view
@@ -32,10 +32,40 @@ import Nix.Types -------------------------------------------------------------------------- +-- | Things which can be converted into nix expressions: either they+-- are actual nix expressions themselves (which can be either+-- existing in the output, or existing in an extension), or they are+-- new packages which we have discovered.+data FullyDefinedPackage+ = NewPackage ResolvedPkg+ | FromExistingInOutput NExpr+ | FromExistingInExtension Name NExpr+ deriving (Show, Eq)++-- | The type of pre-existing packages, which can either come from the+-- output path, or come from an extension+data PreExistingPackage+ = FromOutput NExpr+ | FromExtension Name NExpr+ deriving (Show, Eq)++toFullyDefined :: PreExistingPackage -> FullyDefinedPackage+toFullyDefined (FromOutput expr) = FromExistingInOutput expr+toFullyDefined (FromExtension name expr) = FromExistingInExtension name expr++-- | We use this data structure a lot: a mapping of package names to+-- a mapping of versions to fully defined packages.+type PackageMap pkg = Record (HashMap SemVer pkg)++-- | Map a function across a PackageMap.+mapPM :: (a -> b) -> PackageMap a -> PackageMap b+mapPM f = H.map (H.map f)++-- | The state of the NPM fetcher. data NpmFetcherState = NpmFetcherState { registries :: [URI], githubAuthToken :: Maybe Text,- resolved :: Record (HashMap SemVer (Either NExpr ResolvedPkg)),+ resolved :: PackageMap FullyDefinedPackage, pkgInfos :: Record PackageInfo, -- For cycle detection. currentlyResolving :: HashSet (Name, SemVer),@@ -46,6 +76,9 @@ type NpmFetcher = ExceptT EList (StateT NpmFetcherState IO) +concatDots :: SemVer -> Text+concatDots (a, b, c) = pack $ intercalate "." (map show [a,b,c])+ indent :: Text -> NpmFetcher Text indent txt = do ind <- gets indentLevel@@ -65,17 +98,15 @@ addResolvedPkg :: Name -> SemVer -> ResolvedPkg -> NpmFetcher () addResolvedPkg name version _rpkg = do- let rpkg = Right _rpkg+ let rpkg = NewPackage _rpkg pkgSet <- H.lookupDefault mempty name <$> gets resolved modify $ \s -> s { resolved = H.insert name (H.insert version rpkg pkgSet) (resolved s) } -_defaultCurlArgs :: [Text]-_defaultCurlArgs = ["-L", "--fail"]-+-- | Performs a curl query and returns whatever that query returns. curl :: [Text] -> NpmFetcher Text-curl args = shell $ print_stdout False $ run "curl" (_defaultCurlArgs <> args)+curl args = shell $ print_stdout False $ run "curl" (["-L", "--fail"] <> args) -- | Queries NPM for package information. _getPackageInfo :: Name -> URI -> NpmFetcher PackageInfo@@ -192,6 +223,7 @@ githubCurl :: Text -> NpmFetcher Value githubCurl uri = do+ -- Add in the github auth token if it is provided. extraCurlArgs <- gets githubAuthToken >>= \case Nothing -> return [] Just token -> return ["-H", "Authorization: token " <> token]@@ -284,9 +316,24 @@ -- duplication. resolveDep :: Name -> SemVerRange -> NpmFetcher SemVer resolveDep name range = H.lookup name <$> gets resolved >>= \case+ -- We've alread defined some versions of this package. Just versions -> case filter (matches range) (H.keys versions) of [] -> _resolveDep name range -- No matching versions, need to fetch.- vs -> return $ maximum vs+ vs -> do+ let bestVersion = maximum vs+ versionDots = concatDots bestVersion+ package = fromJust $ H.lookup bestVersion versions+ putStrsLn ["Requirement ", name, " version ", pack $ show range,+ " already satisfied:"]+ putStrsLn $ case package of+ NewPackage _ -> ["Fetched package version ", versionDots]+ FromExistingInOutput _ -> ["Already had version ", versionDots,+ " in output directory (use --no-cache",+ " to override)"]+ FromExistingInExtension name _ -> ["Version ", versionDots,+ " provided by extension ", name]+ return bestVersion+ -- We haven't yet found any versions of this package. Nothing -> _resolveDep name range startResolving :: Name -> SemVer -> NpmFetcher ()@@ -379,7 +426,7 @@ Nothing -> errorC ["Invalid URI: ", txt] Just uri -> uri -startState :: Record (HashMap SemVer NExpr)+startState :: PackageMap PreExistingPackage -> [Text] -> Maybe Text -> NpmFetcherState@@ -387,7 +434,7 @@ NpmFetcherState { registries = parseURIs registries, githubAuthToken = token,- resolved = map (map Left) existing,+ resolved = mapPM toFullyDefined existing, pkgInfos = mempty, currentlyResolving = mempty, knownProblematicPackages = HS.fromList ["websocket-server"],@@ -420,11 +467,12 @@ (Left elist, _) -> error $ "\n" <> (unpack $ render elist) (Right x, state) -> return (x, state) -getPkg :: Name- -> Record (HashMap SemVer NExpr)- -> IO (Record (HashMap SemVer (Either NExpr ResolvedPkg)))-getPkg name existing = do+getPkg :: Name -- ^ Name of package to get.+ -> PackageMap PreExistingPackage -- ^ Set of pre-existing packages.+ -> Maybe Text -- ^ A possible github token.+ -> IO (PackageMap FullyDefinedPackage) -- ^ Set of fully defined packages.+getPkg name existing token = do let range = Gt (0, 0, 0)- state <- startState existing <$> getRegistries <*> getToken- (_, finalState) <- runItWith state (_resolveDep name range)+ state <- startState existing <$> getRegistries <*> pure token+ (_, finalState) <- runItWith state (resolveDep name range) return (resolved finalState)
+ src/NixFromNpm/Options.hs view
@@ -0,0 +1,73 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}+module NixFromNpm.Options where++import Options.Applicative++import NixFromNpm.Common hiding ((<>))++-- | Various options we have available for nixfromnpm. As of right now,+-- most of these are unimplemented.+data NixFromNpmOptions = NixFromNpmOptions {+ nfnoPkgNames :: [Name], -- ^ Names of packages to build.+ nfnoPkgPaths :: [Text], -- ^ Paths to package.jsons to build.+ nfnoOutputPath :: Text, -- ^ Path to output built expressions to.+ nfnoNoCache :: Bool, -- ^ Build all expressions from scratch.+ nfnoExtendPaths :: [Text], -- ^ Extend existing expressions.+ nfnoTest :: Bool, -- ^ Fetch only; don't write expressions.+ nfnoRegistries :: [Text], -- ^ List of registries to query.+ nfnoTimeout :: Int, -- ^ Number of seconds after which to timeout.+ nfnoGithubToken :: Maybe Text -- ^ Github authentication token.+} deriving (Show, Eq)++textOption :: Mod OptionFields String -> Parser Text+textOption opts = pack <$> strOption opts++pOptions :: Maybe Text -> Parser NixFromNpmOptions+pOptions githubToken = NixFromNpmOptions+ <$> many (textOption packageName)+ <*> many (textOption packageFile)+ <*> textOption outputDir+ <*> noCache+ <*> extendPaths+ <*> isTest+ <*> liftA2 snoc registries (pure "https://registry.npmjs.org")+ <*> timeout+ <*> token+ where+ packageName = (short 'p'+ <> long "package"+ <> metavar "PACKAGENAME"+ <> help "Package to generate expression for")+ packageFile = (short 'f'+ <> long "file"+ <> metavar "PACKAGEFILE"+ <> help "Path to package.json to generate expression for")+ outputDir = (short 'o'+ <> long "output"+ <> metavar "DIRECTORY"+ <> help "Directory to output expressions to")+ noCache = switch (long "no-cache"+ <> help "Build all expressions from scratch")+ extendHelp = "Use expressions at PATH called NAME"+ extendPaths = many (textOption (long "extend"+ <> short 'E'+ <> metavar "NAME=PATH"+ <> help extendHelp))+ isTest = switch (long "test"+ <> help "Don't write expressions; just test")+ timeout = option auto (long "timeout"+ <> metavar "SECONDS"+ <> help "Time requests out after SECONDS seconds"+ <> value 10)+ registries :: Parser [Text]+ registries = many $ textOption (long "registry"+ <> short 'R'+ <> metavar "REGISTRY"+ <> help "NPM registry to query")+ tokenHelp = ("Token to use for github access (also can be set with " <>+ "GITHUB_TOKEN environment variable)")+ token = (Just <$> textOption (long "github-token"+ <> metavar "TOKEN"+ <> help tokenHelp))+ <|> pure githubToken