diff --git a/nixfromnpm.cabal b/nixfromnpm.cabal --- a/nixfromnpm.cabal +++ b/nixfromnpm.cabal @@ -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 diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -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 [-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" diff --git a/src/NixFromNpm.hs b/src/NixFromNpm.hs --- a/src/NixFromNpm.hs +++ b/src/NixFromNpm.hs @@ -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 diff --git a/src/NixFromNpm/Common.hs b/src/NixFromNpm/Common.hs --- a/src/NixFromNpm/Common.hs +++ b/src/NixFromNpm/Common.hs @@ -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 diff --git a/src/NixFromNpm/ConvertToNix.hs b/src/NixFromNpm/ConvertToNix.hs --- a/src/NixFromNpm/ConvertToNix.hs +++ b/src/NixFromNpm/ConvertToNix.hs @@ -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 {}}:\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 {}}: \ + \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 diff --git a/src/NixFromNpm/NpmLookup.hs b/src/NixFromNpm/NpmLookup.hs --- a/src/NixFromNpm/NpmLookup.hs +++ b/src/NixFromNpm/NpmLookup.hs @@ -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) diff --git a/src/NixFromNpm/Options.hs b/src/NixFromNpm/Options.hs new file mode 100644 --- /dev/null +++ b/src/NixFromNpm/Options.hs @@ -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