packages feed

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 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