{-# LANGUAGE OverloadedStrings, NoImplicitPrelude, GeneralizedNewtypeDeriving, ViewPatterns, RecordWildCards, LambdaCase, NamedFieldPuns #-}
{-|
Description: Generate an optimized nix file from a resolved @YLT.Lockfile@

We want to generate a nix file with the following attributes:

1. easy to parse by humans
2. as short as possible
3. updating the yarn.lock generates diffs that are as short as possible

Readability means a clear structure, with definitions at the top.

Reducing the filesize means we can’t duplicate any information and keep identifiers very short. This interferes with readability, but can be amended by giving the full names in the static section and then giving them short identifiers in a second section.

Nice diffing includes having line-based output (if possible one line per package/dependency), as well as keeping the order of items stable (alphabetically sorting package names and dependencies).
-}
module Distribution.Nixpkgs.Nodejs.OptimizedNixOutput
( convertLockfile
-- * File Structure
-- $fileStructure
, mkPackageSet
-- * NOTE: fix
-- $noteFix
) where

import Protolude
import qualified Data.Map as M
import qualified Data.Text as T
import Data.Fix (Fix(Fix))
import qualified Data.MultiKeyedMap as MKM
import qualified Data.List as List
import qualified Data.List.NonEmpty as NE

import Nix.Expr (NExpr, ($=), (==>), (@@))
import Nix.Expr.Additions (($$=), (!!.), inheritStatic)
import qualified Nix.Expr as N
import qualified Nix.Expr.Additions as NA

import qualified Yarn.Lock.Types as YLT

import qualified Distribution.Nixpkgs.Nodejs.ResolveLockfile as Res
import Distribution.Nixpkgs.Nodejs.Utils (packageKeyToSymbol)

-- | Nix symbol.
newtype NSym = NSym { NSym -> Text
unNSym :: Text }
  deriving (String -> NSym
(String -> NSym) -> IsString NSym
forall a. (String -> a) -> IsString a
fromString :: String -> NSym
$cfromString :: String -> NSym
IsString, Eq NSym
Eq NSym
-> (NSym -> NSym -> Ordering)
-> (NSym -> NSym -> Bool)
-> (NSym -> NSym -> Bool)
-> (NSym -> NSym -> Bool)
-> (NSym -> NSym -> Bool)
-> (NSym -> NSym -> NSym)
-> (NSym -> NSym -> NSym)
-> Ord NSym
NSym -> NSym -> Bool
NSym -> NSym -> Ordering
NSym -> NSym -> NSym
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: NSym -> NSym -> NSym
$cmin :: NSym -> NSym -> NSym
max :: NSym -> NSym -> NSym
$cmax :: NSym -> NSym -> NSym
>= :: NSym -> NSym -> Bool
$c>= :: NSym -> NSym -> Bool
> :: NSym -> NSym -> Bool
$c> :: NSym -> NSym -> Bool
<= :: NSym -> NSym -> Bool
$c<= :: NSym -> NSym -> Bool
< :: NSym -> NSym -> Bool
$c< :: NSym -> NSym -> Bool
compare :: NSym -> NSym -> Ordering
$ccompare :: NSym -> NSym -> Ordering
$cp1Ord :: Eq NSym
Ord, NSym -> NSym -> Bool
(NSym -> NSym -> Bool) -> (NSym -> NSym -> Bool) -> Eq NSym
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NSym -> NSym -> Bool
$c/= :: NSym -> NSym -> Bool
== :: NSym -> NSym -> Bool
$c== :: NSym -> NSym -> Bool
Eq)

-- | Nix input variable.
newtype NVar = NVar NSym
  deriving (String -> NVar
(String -> NVar) -> IsString NVar
forall a. (String -> a) -> IsString a
fromString :: String -> NVar
$cfromString :: String -> NVar
IsString)

-- | Builder type for simple antiquoted nix strings.
data AStrVal = V NVar
             -- ^ nix antiquoted variable
             | T Text
             -- ^ normal nix string

-- | Build a nix string from multiple @AStrVal@s.
antiquote :: [AStrVal] -> NExpr
antiquote :: [AStrVal] -> NExpr
antiquote [AStrVal]
vals = NExprF NExpr -> NExpr
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NExprF NExpr -> NExpr)
-> ([Antiquoted Text NExpr] -> NExprF NExpr)
-> [Antiquoted Text NExpr]
-> NExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NString NExpr -> NExprF NExpr
forall r. NString r -> NExprF r
N.NStr (NString NExpr -> NExprF NExpr)
-> ([Antiquoted Text NExpr] -> NString NExpr)
-> [Antiquoted Text NExpr]
-> NExprF NExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Antiquoted Text NExpr] -> NString NExpr
forall r. [Antiquoted Text r] -> NString r
N.DoubleQuoted
  ([Antiquoted Text NExpr] -> NExpr)
-> [Antiquoted Text NExpr] -> NExpr
forall a b. (a -> b) -> a -> b
$ ((AStrVal -> Antiquoted Text NExpr)
 -> [AStrVal] -> [Antiquoted Text NExpr])
-> [AStrVal]
-> (AStrVal -> Antiquoted Text NExpr)
-> [Antiquoted Text NExpr]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (AStrVal -> Antiquoted Text NExpr)
-> [AStrVal] -> [Antiquoted Text NExpr]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map [AStrVal]
vals ((AStrVal -> Antiquoted Text NExpr) -> [Antiquoted Text NExpr])
-> (AStrVal -> Antiquoted Text NExpr) -> [Antiquoted Text NExpr]
forall a b. (a -> b) -> a -> b
$ \case
      T Text
t -> Text -> Antiquoted Text NExpr
forall v r. v -> Antiquoted v r
N.Plain Text
t
      V (NVar (NSym Text
t)) -> NExpr -> Antiquoted Text NExpr
forall v r. r -> Antiquoted v r
N.Antiquoted (NExpr -> Antiquoted Text NExpr) -> NExpr -> Antiquoted Text NExpr
forall a b. (a -> b) -> a -> b
$ Text -> NExpr
N.mkSym Text
t

-- | A registry that we know of and can therefore shorten
-- into a nix function call.
data Registry = Registry
  { Registry -> NSym
registrySym :: NSym
    -- ^ nix symbol used in the output file
  , Registry -> NVar -> NVar -> [AStrVal]
registryBuilder :: NVar -> NVar -> [AStrVal]
    -- ^ constructs a nix function that in turn constructs a repository string;
    -- the function takes a package name and package version
  }

data Git = Git
  { Git -> Text
gitUrl :: Text
  , Git -> Text
gitRev :: Text }

-- | Final package reference used in the generated package list.
data PkgRef
  -- | reference to another package definition (e.g. @^1.2@ points to @1.2@)
  = PkgRef Text
  | PkgDefFile (PkgData (Either Text Registry))
  -- ^ actual definition of a file package
  | PkgDefFileLocal (PkgData Text)
  -- ^ actual definition of a local package (tar.gz file relative to nix expression)
  | PkgDefGit  (PkgData Git)
  -- ^ actual definition of a git package

-- | Package definition needed for calling the build function.
data PkgData a = PkgData
  { PkgData a -> PackageKeyName
pkgDataName :: YLT.PackageKeyName -- ^ package name
  , PkgData a -> Text
pkgDataVersion :: Text            -- ^ package version
  , PkgData a -> a
pkgDataUpstream :: a              -- ^ points to upstream
  , PkgData a -> Text
pkgDataHashSum :: Text            -- ^ the hash sum of the package
  , PkgData a -> [Text]
pkgDataDependencies :: [Text]     -- ^ list of dependencies (as resolved nix symbols)
  }

-- | Tuples of prefix string to registry
registries :: [(Text, Registry)]
registries :: [(Text, Registry)]
registries =
  [ ( Text
yarnP
    , NSym -> (NVar -> NVar -> [AStrVal]) -> Registry
Registry NSym
"yarn"
        ((NVar -> NVar -> [AStrVal]) -> Registry)
-> (NVar -> NVar -> [AStrVal]) -> Registry
forall a b. (a -> b) -> a -> b
$ \NVar
n NVar
v -> [Text -> AStrVal
T Text
yarnP, NVar -> AStrVal
V NVar
n, Text -> AStrVal
T Text
"/-/", NVar -> AStrVal
V NVar
n, Text -> AStrVal
T Text
"-", NVar -> AStrVal
V NVar
v, Text -> AStrVal
T Text
".tgz"] )
  , ( Text
npmjsP
    , NSym -> (NVar -> NVar -> [AStrVal]) -> Registry
Registry NSym
"npm"
        ((NVar -> NVar -> [AStrVal]) -> Registry)
-> (NVar -> NVar -> [AStrVal]) -> Registry
forall a b. (a -> b) -> a -> b
$ \NVar
n NVar
v -> [Text -> AStrVal
T Text
npmjsP, NVar -> AStrVal
V NVar
n, Text -> AStrVal
T Text
"/-/", NVar -> AStrVal
V NVar
n, Text -> AStrVal
T Text
"-", NVar -> AStrVal
V NVar
v, Text -> AStrVal
T Text
".tgz"] )

  ]
  where
    yarnP :: Text
yarnP = Text
"https://registry.yarnpkg.com/"
    npmjsP :: Text
npmjsP = Text
"https://registry.npmjs.org/"

shortcuts :: M.Map [NSym] NSym
shortcuts :: Map [NSym] NSym
shortcuts = [([NSym], NSym)] -> Map [NSym] NSym
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
  [ ([NSym
"self"], NSym
"s")
  , ([NSym
"registries", NSym
"yarn"], NSym
"y")
  , ([NSym
"registries", NSym
"npm"], NSym
"n")
  , ([NSym
"nodeFilePackage"], NSym
"f")
  , ([NSym
"nodeFileLocalPackage"], NSym
"l")
  , ([NSym
"nodeGitPackage"], NSym
"g")
  , ([NSym
"identityRegistry"], NSym
"ir")
  , ([NSym
"scopedName"], NSym
"sc")
  ]

-- | Find out which registry the given 'YLT.Remote' shortens to.
recognizeRegistry :: YLT.PackageKeyName -- ^ package name
                  -> Text -- ^ url to file
                  -> Maybe Registry
-- We don’t shorten scoped key names, because
-- they are handled specially by npm registries and
-- the URLs differ from other packages
recognizeRegistry :: PackageKeyName -> Text -> Maybe Registry
recognizeRegistry (YLT.ScopedPackageKey{}) Text
_ = Maybe Registry
forall a. Maybe a
Nothing
recognizeRegistry PackageKeyName
_ Text
fileUrl = (Text, Registry) -> Registry
forall a b. (a, b) -> b
snd ((Text, Registry) -> Registry)
-> Maybe (Text, Registry) -> Maybe Registry
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Text, Registry)
foundRegistry
  where
    -- | Get registry by the prefix of the registry’s URL.
    foundRegistry :: Maybe (Text, Registry)
foundRegistry = ((Text, Registry) -> Bool)
-> [(Text, Registry)] -> Maybe (Text, Registry)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Text, Registry) -> Bool
predicate [(Text, Registry)]
registries
    predicate :: (Text, Registry) -> Bool
    predicate :: (Text, Registry) -> Bool
predicate (Text, Registry)
reg = (Text, Registry) -> Text
forall a b. (a, b) -> a
fst (Text, Registry)
reg Text -> Text -> Bool
`T.isPrefixOf` Text
fileUrl


-- | Convert a 'Res.ResolvedLockfile' to its final, nix-ready form.
convertLockfile :: Res.ResolvedLockfile -> M.Map Text PkgRef
convertLockfile :: ResolvedLockfile -> Map Text PkgRef
convertLockfile = [(Text, PkgRef)] -> Map Text PkgRef
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Text, PkgRef)] -> Map Text PkgRef)
-> (ResolvedLockfile -> [(Text, PkgRef)])
-> ResolvedLockfile
-> Map Text PkgRef
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((NonEmpty PackageKey, Resolved Package) -> [(Text, PkgRef)])
-> [(NonEmpty PackageKey, Resolved Package)] -> [(Text, PkgRef)]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (NonEmpty PackageKey, Resolved Package) -> [(Text, PkgRef)]
convert ([(NonEmpty PackageKey, Resolved Package)] -> [(Text, PkgRef)])
-> (ResolvedLockfile -> [(NonEmpty PackageKey, Resolved Package)])
-> ResolvedLockfile
-> [(Text, PkgRef)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResolvedLockfile -> [(NonEmpty PackageKey, Resolved Package)]
forall k v. MKMap k v -> [(NonEmpty k, v)]
MKM.toList
  where
    -- | For the list of package keys we generate a @PkgRef@ each
    -- and then one actual @PkgDef@.
    convert :: (NE.NonEmpty YLT.PackageKey, (Res.Resolved YLT.Package))
            -> [(Text, PkgRef)]
    convert :: (NonEmpty PackageKey, Resolved Package) -> [(Text, PkgRef)]
convert (NonEmpty PackageKey
keys, Res.Resolved{ Text
hashSum :: forall a. Resolved a -> Text
hashSum :: Text
hashSum, resolved :: forall a. Resolved a -> a
resolved=Package
pkg }) = let
      -- | Since there might be more than one key name, we choose
      -- the one with most entries.
      defName :: PackageKeyName
defName = NonEmpty PackageKeyName -> PackageKeyName
forall a. NonEmpty a -> a
NE.head (NonEmpty PackageKeyName -> PackageKeyName)
-> NonEmpty PackageKeyName -> PackageKeyName
forall a b. (a -> b) -> a -> b
$ (NonEmpty PackageKeyName -> NonEmpty PackageKeyName -> Ordering)
-> [NonEmpty PackageKeyName] -> NonEmpty PackageKeyName
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy ((NonEmpty PackageKeyName -> Int)
-> NonEmpty PackageKeyName -> NonEmpty PackageKeyName -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing NonEmpty PackageKeyName -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length) ([NonEmpty PackageKeyName] -> NonEmpty PackageKeyName)
-> [NonEmpty PackageKeyName] -> NonEmpty PackageKeyName
forall a b. (a -> b) -> a -> b
$ NonEmpty PackageKeyName -> [NonEmpty PackageKeyName]
forall (f :: * -> *) a. (Foldable f, Eq a) => f a -> [NonEmpty a]
NE.group (NonEmpty PackageKeyName -> [NonEmpty PackageKeyName])
-> NonEmpty PackageKeyName -> [NonEmpty PackageKeyName]
forall a b. (a -> b) -> a -> b
$ NonEmpty PackageKeyName -> NonEmpty PackageKeyName
forall a. Ord a => NonEmpty a -> NonEmpty a
NE.sort (NonEmpty PackageKeyName -> NonEmpty PackageKeyName)
-> NonEmpty PackageKeyName -> NonEmpty PackageKeyName
forall a b. (a -> b) -> a -> b
$ (PackageKey -> PackageKeyName)
-> NonEmpty PackageKey -> NonEmpty PackageKeyName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PackageKey -> PackageKeyName
YLT.name NonEmpty PackageKey
keys
      defSym :: Text
defSym = PackageKey -> Text
packageKeyToSymbol (PackageKey -> Text) -> PackageKey -> Text
forall a b. (a -> b) -> a -> b
$ PackageKey :: PackageKeyName -> Text -> PackageKey
YLT.PackageKey
        { name :: PackageKeyName
YLT.name = PackageKeyName
defName
        , npmVersionSpec :: Text
YLT.npmVersionSpec = Package -> Text
YLT.version Package
pkg }
      pkgDataGeneric :: a -> PkgData a
pkgDataGeneric a
upstream = PkgData :: forall a.
PackageKeyName -> Text -> a -> Text -> [Text] -> PkgData a
PkgData
        { pkgDataName :: PackageKeyName
pkgDataName = PackageKeyName
defName
        , pkgDataVersion :: Text
pkgDataVersion = Package -> Text
YLT.version Package
pkg
        , pkgDataUpstream :: a
pkgDataUpstream = a
upstream
        , pkgDataHashSum :: Text
pkgDataHashSum = Text
hashSum
        , pkgDataDependencies :: [Text]
pkgDataDependencies = (PackageKey -> Text) -> [PackageKey] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map PackageKey -> Text
packageKeyToSymbol
            -- TODO: handle optional dependencies better
            ([PackageKey] -> [Text]) -> [PackageKey] -> [Text]
forall a b. (a -> b) -> a -> b
$ Package -> [PackageKey]
YLT.dependencies Package
pkg [PackageKey] -> [PackageKey] -> [PackageKey]
forall a. Semigroup a => a -> a -> a
<> Package -> [PackageKey]
YLT.optionalDependencies Package
pkg
        }
      def :: PkgRef
def = case Package -> Remote
YLT.remote Package
pkg of
        YLT.FileRemote{Text
fileUrl :: Remote -> Text
fileUrl :: Text
fileUrl} ->
          PkgData (Either Text Registry) -> PkgRef
PkgDefFile (PkgData (Either Text Registry) -> PkgRef)
-> PkgData (Either Text Registry) -> PkgRef
forall a b. (a -> b) -> a -> b
$ Either Text Registry -> PkgData (Either Text Registry)
forall a. a -> PkgData a
pkgDataGeneric (Either Text Registry -> PkgData (Either Text Registry))
-> Either Text Registry -> PkgData (Either Text Registry)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Registry -> Either Text Registry
forall e (m :: * -> *) a. MonadError e m => e -> Maybe a -> m a
note Text
fileUrl
            (Maybe Registry -> Either Text Registry)
-> Maybe Registry -> Either Text Registry
forall a b. (a -> b) -> a -> b
$ PackageKeyName -> Text -> Maybe Registry
recognizeRegistry PackageKeyName
defName Text
fileUrl
        YLT.FileLocal{Text
fileLocalPath :: Remote -> Text
fileLocalPath :: Text
fileLocalPath} ->
          PkgData Text -> PkgRef
PkgDefFileLocal (PkgData Text -> PkgRef) -> PkgData Text -> PkgRef
forall a b. (a -> b) -> a -> b
$ Text -> PkgData Text
forall a. a -> PkgData a
pkgDataGeneric (Text -> PkgData Text) -> Text -> PkgData Text
forall a b. (a -> b) -> a -> b
$ Text
fileLocalPath
        YLT.GitRemote{Text
gitRepoUrl :: Remote -> Text
gitRepoUrl :: Text
gitRepoUrl, Text
gitRev :: Remote -> Text
gitRev :: Text
gitRev} ->
          PkgData Git -> PkgRef
PkgDefGit (PkgData Git -> PkgRef) -> PkgData Git -> PkgRef
forall a b. (a -> b) -> a -> b
$ Git -> PkgData Git
forall a. a -> PkgData a
pkgDataGeneric (Git -> PkgData Git) -> Git -> PkgData Git
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Git
Git Text
gitRepoUrl Text
gitRev
        YLT.FileRemoteNoIntegrity {} ->
          Text -> PkgRef
forall a. HasCallStack => Text -> a
panic Text
"programming error, should have thrown an error in ResolveLockfile"
        YLT.FileLocalNoIntegrity {} ->
          Text -> PkgRef
forall a. HasCallStack => Text -> a
panic Text
"programming error, should have thrown an error in ResolveLockfile"
                 -- we don’t need another ref indirection
                 -- if that’s already the name of our def
      refNames :: [Text]
refNames = Text -> [Text] -> [Text]
forall a. Eq a => a -> [a] -> [a]
List.delete Text
defSym ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ NonEmpty Text -> [Text]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (NonEmpty Text -> [Text]) -> NonEmpty Text -> [Text]
forall a b. (a -> b) -> a -> b
$ NonEmpty Text -> NonEmpty Text
forall a. Eq a => NonEmpty a -> NonEmpty a
NE.nub
        (NonEmpty Text -> NonEmpty Text) -> NonEmpty Text -> NonEmpty Text
forall a b. (a -> b) -> a -> b
$ (PackageKey -> Text) -> NonEmpty PackageKey -> NonEmpty Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PackageKey -> Text
packageKeyToSymbol NonEmpty PackageKey
keys
      in (Text
defSym, PkgRef
def) (Text, PkgRef) -> [(Text, PkgRef)] -> [(Text, PkgRef)]
forall a. a -> [a] -> [a]
: (Text -> (Text, PkgRef)) -> [Text] -> [(Text, PkgRef)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (\Text
rn -> (Text
rn, Text -> PkgRef
PkgRef Text
defSym)) [Text]
refNames


{- $fileStructure

@
{ fetchgit, fetchurl }:
# self & super: see notes on fix
self: super:
let
  # shorten the name of known package registries
  registries = {
    yarn = n: v: "https://registry.yarnpkg.com/${n}/-/${n}-${v}.tgz";
  };

  # We want each package definition to be one line, by putting
  # the boilerplate into these functions for different remotes.
  nodeFilePackage = …
  nodeFileLocalPackage = …
  nodeGitPackage = …

  # an identity function for e.g. git repos or unknown registries
  identityRegistry = url: _: _: url;

  # a way to pass through scoped package names
  scopedName = scope: name: { inherit scope name; }

  # shortcut section
  s = self;
  ir = identityRegistry;
  f = nodeFilePackage;
  l = nodeFileLocalPackage;
  g = nodeGitPackage;
  y = registries.yarnpkg;
  sc = scopedName;
  …

# the actual package definitions
in {
  "accepts@~1.3.3" = s."accepts@1.3.3";
  "accepts@1.3.3" = f "accepts" "1.3.3" y "sha" [];
  "@types/accepts@1.3.3" = f (sc "types" "accepts") "1.3.3" y "sha" [];
  "babel-core@^6.14.0" = s."babel-core@6.24.1";
  "babel-core@6.24.1" = f "babel-core" "6.24.1" y "a0e457c58ebdbae575c9f8cd75127e93756435d8" [
    s."accepts@~1.3.3"
  ];
  "local-package@file:../foo.tgz" = l "local-package" "file:../foo.tgz" ../foo.tgz "thehash" []
}
@
-}

-- | Convert a list of packages prepared with 'convertLockfile'
-- to a nix expression.
mkPackageSet :: M.Map Text PkgRef -> NExpr
mkPackageSet :: Map Text PkgRef -> NExpr
mkPackageSet Map Text PkgRef
packages =
  [Text] -> Params NExpr
NA.simpleParamSet [Text
"fetchurl", Text
"fetchgit"]
    -- enable self-referencing of packages
    -- with string names with a self/super fix
    -- see note FIX
    Params NExpr -> NExpr -> NExpr
==> Text -> Params NExpr
forall r. Text -> Params r
N.Param Text
"self" Params NExpr -> NExpr -> NExpr
==> Text -> Params NExpr
forall r. Text -> Params r
N.Param Text
"super"
    Params NExpr -> NExpr -> NExpr
==> [Binding NExpr] -> NExpr -> NExpr
N.mkLets
        (  [ Text
"registries" Text -> NExpr -> Binding NExpr
$= [Binding NExpr] -> NExpr
N.mkNonRecSet (((Text, Registry) -> Binding NExpr)
-> [(Text, Registry)] -> [Binding NExpr]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Registry -> Binding NExpr
mkRegistry (Registry -> Binding NExpr)
-> ((Text, Registry) -> Registry)
-> (Text, Registry)
-> Binding NExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Registry) -> Registry
forall a b. (a, b) -> b
snd) [(Text, Registry)]
registries)
           , Text
"nodeFilePackage" Text -> NExpr -> Binding NExpr
$= NExpr
buildPkgFn
           , Text
"nodeFileLocalPackage" Text -> NExpr -> Binding NExpr
$= NExpr
buildPkgLocalFn
           , Text
"nodeGitPackage" Text -> NExpr -> Binding NExpr
$= NExpr
buildPkgGitFn
           , Text
"identityRegistry" Text -> NExpr -> Binding NExpr
$= [Text] -> NExpr -> NExpr
NA.multiParam [Text
"url", Text
"_", Text
"_"] NExpr
"url"
           , Text
"scopedName" Text -> NExpr -> Binding NExpr
$=
               ([Text] -> NExpr -> NExpr
NA.multiParam [Text
"scope", Text
"name"]
                 (NExpr -> NExpr) -> NExpr -> NExpr
forall a b. (a -> b) -> a -> b
$ [Binding NExpr] -> NExpr
N.mkNonRecSet [ [Text] -> Binding NExpr
forall e. [Text] -> Binding e
inheritStatic [Text
"scope", Text
"name"] ])
           ]
        [Binding NExpr] -> [Binding NExpr] -> [Binding NExpr]
forall a. Semigroup a => a -> a -> a
<> (([NSym], NSym) -> Binding NExpr)
-> [([NSym], NSym)] -> [Binding NExpr]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([NSym], NSym) -> Binding NExpr
mkShortcut (Map [NSym] NSym -> [([NSym], NSym)]
forall k a. Map k a -> [(k, a)]
M.toList Map [NSym] NSym
shortcuts) )
        ([Binding NExpr] -> NExpr
N.mkNonRecSet (((Text, PkgRef) -> Binding NExpr)
-> [(Text, PkgRef)] -> [Binding NExpr]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (Text, PkgRef) -> Binding NExpr
mkPkg ([(Text, PkgRef)] -> [Binding NExpr])
-> [(Text, PkgRef)] -> [Binding NExpr]
forall a b. (a -> b) -> a -> b
$ Map Text PkgRef -> [(Text, PkgRef)]
forall k a. Map k a -> [(k, a)]
M.toAscList Map Text PkgRef
packages))
  where
    mkRegistry :: Registry -> Binding NExpr
mkRegistry (Registry{NSym
NVar -> NVar -> [AStrVal]
registryBuilder :: NVar -> NVar -> [AStrVal]
registrySym :: NSym
registryBuilder :: Registry -> NVar -> NVar -> [AStrVal]
registrySym :: Registry -> NSym
..}) = NSym -> Text
unNSym NSym
registrySym Text -> NExpr -> Binding NExpr
$=
      (Text -> Params NExpr
forall r. Text -> Params r
N.Param Text
"n" Params NExpr -> NExpr -> NExpr
==> Text -> Params NExpr
forall r. Text -> Params r
N.Param Text
"v" Params NExpr -> NExpr -> NExpr
==> [AStrVal] -> NExpr
antiquote (NVar -> NVar -> [AStrVal]
registryBuilder NVar
"n" NVar
"v"))

    concatNSyms :: [NSym] -> NExpr
    concatNSyms :: [NSym] -> NExpr
concatNSyms [] = Text -> NExpr
forall a. HasCallStack => Text -> a
panic Text
"non-empty shortcut syms!"
    concatNSyms (NSym
l:[NSym]
ls) = (NExpr -> Text -> NExpr) -> NExpr -> [Text] -> NExpr
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl NExpr -> Text -> NExpr
(!!.) (Text -> NExpr
N.mkSym (Text -> NExpr) -> Text -> NExpr
forall a b. (a -> b) -> a -> b
$ NSym -> Text
unNSym NSym
l) ((NSym -> Text) -> [NSym] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NSym -> Text
unNSym [NSym]
ls)
    mkShortcut :: ([NSym], NSym) -> N.Binding NExpr
    mkShortcut :: ([NSym], NSym) -> Binding NExpr
mkShortcut ([NSym]
nSyms, NSym
short) = NSym -> Text
unNSym NSym
short Text -> NExpr -> Binding NExpr
$= [NSym] -> NExpr
concatNSyms [NSym]
nSyms
    -- | Try to shorten sym, otherwise use input.
    shorten :: [NSym] -> NExpr
    shorten :: [NSym] -> NExpr
shorten [NSym]
s = case [NSym] -> Map [NSym] NSym -> Maybe NSym
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup [NSym]
s Map [NSym] NSym
shortcuts of
      Maybe NSym
Nothing -> [NSym] -> NExpr
concatNSyms [NSym]
s
      Just NSym
sc -> Text -> NExpr
N.mkSym (NSym -> Text
unNSym NSym
sc)
    -- | Build function boilerplate the build functions share in common.
    buildPkgFnGeneric :: [Text] -> NExpr -> NExpr
    buildPkgFnGeneric :: [Text] -> NExpr -> NExpr
buildPkgFnGeneric [Text]
additionalArguments NExpr
srcNExpr =
      [Text] -> NExpr -> NExpr
NA.multiParam ([Text
"key", Text
"version"] [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
additionalArguments [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text
"deps"])
        (NExpr -> NExpr) -> NExpr -> NExpr
forall a b. (a -> b) -> a -> b
$ (NExpr
"super" NExpr -> Text -> NExpr
!!. Text
"_buildNodePackage") NExpr -> NExpr -> NExpr
@@ [Binding NExpr] -> NExpr
N.mkNonRecSet
          [ [Text] -> Binding NExpr
forall e. [Text] -> Binding e
inheritStatic [Text
"key", Text
"version"]
          , Text
"src" Text -> NExpr -> Binding NExpr
$= NExpr
srcNExpr
          , Text
"nodeBuildInputs" Text -> NExpr -> Binding NExpr
$= NExpr
"deps" ]
    -- | Building a 'YLT.FileRemote' package.
    buildPkgFn :: NExpr
    buildPkgFn :: NExpr
buildPkgFn =
      [Text] -> NExpr -> NExpr
buildPkgFnGeneric [Text
"registry", Text
"sha1"]
        (NExpr
"fetchurl" NExpr -> NExpr -> NExpr
@@ [Binding NExpr] -> NExpr
N.mkNonRecSet
          [ Text
"url" Text -> NExpr -> Binding NExpr
$= (NExpr
"registry" NExpr -> NExpr -> NExpr
@@ NExpr
"key" NExpr -> NExpr -> NExpr
@@ NExpr
"version")
          , [Text] -> Binding NExpr
forall e. [Text] -> Binding e
inheritStatic [Text
"sha1"] ])
    -- | Building a 'YLT.FileLocal' package.
    buildPkgLocalFn :: NExpr
    buildPkgLocalFn :: NExpr
buildPkgLocalFn =
      [Text] -> NExpr -> NExpr
buildPkgFnGeneric [Text
"path", Text
"sha1"]
        (NExpr
"builtins.path" NExpr -> NExpr -> NExpr
@@ [Binding NExpr] -> NExpr
N.mkNonRecSet
          [ [Text] -> Binding NExpr
forall e. [Text] -> Binding e
inheritStatic [Text
"path"]
          -- TODO: use the sha1 here! (does builtins.path only take sha256?)
          -- , "sha256" $= "sha1"
          ])
    -- | Building a 'YLT.GitRemote' package.
    buildPkgGitFn :: NExpr
    buildPkgGitFn :: NExpr
buildPkgGitFn =
      [Text] -> NExpr -> NExpr
buildPkgFnGeneric [Text
"url", Text
"rev", Text
"sha256"]
        (NExpr
"fetchgit" NExpr -> NExpr -> NExpr
@@ [Binding NExpr] -> NExpr
N.mkNonRecSet
          [ [Text] -> Binding NExpr
forall e. [Text] -> Binding e
inheritStatic [Text
"url", Text
"rev", Text
"sha256"] ])

    -- | Create a package definition.
    mkPkg :: (Text, PkgRef) -> N.Binding NExpr
    mkPkg :: (Text, PkgRef) -> Binding NExpr
mkPkg (Text
key, PkgRef
pkgRef) = Text
key Text -> NExpr -> Binding NExpr
$$= case PkgRef
pkgRef of
      PkgRef Text
t -> Text -> NExpr
N.mkSym Text
selfSym NExpr -> Text -> NExpr
!!. Text
t
      PkgDefFile pd :: PkgData (Either Text Registry)
pd@PkgData{Either Text Registry
pkgDataUpstream :: Either Text Registry
pkgDataUpstream :: forall a. PkgData a -> a
pkgDataUpstream, Text
pkgDataHashSum :: Text
pkgDataHashSum :: forall a. PkgData a -> Text
pkgDataHashSum} ->
        PkgData (Either Text Registry) -> NSym -> [NExpr] -> NExpr
forall a. PkgData a -> NSym -> [NExpr] -> NExpr
mkDefGeneric PkgData (Either Text Registry)
pd NSym
"nodeFilePackage"
          [ (Text -> NExpr)
-> (Registry -> NExpr) -> Either Text Registry -> NExpr
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\Text
url -> [NSym] -> NExpr
shorten [NSym
"identityRegistry"] NExpr -> NExpr -> NExpr
@@ Text -> NExpr
N.mkStr Text
url )
                   (\Registry
reg -> [NSym] -> NExpr
shorten [NSym
"registries", Registry -> NSym
registrySym Registry
reg])
                   Either Text Registry
pkgDataUpstream
          , Text -> NExpr
N.mkStr Text
pkgDataHashSum ]
      PkgDefFileLocal pd :: PkgData Text
pd@PkgData{pkgDataUpstream :: forall a. PkgData a -> a
pkgDataUpstream = Text
path, Text
pkgDataHashSum :: Text
pkgDataHashSum :: forall a. PkgData a -> Text
pkgDataHashSum} ->
        PkgData Text -> NSym -> [NExpr] -> NExpr
forall a. PkgData a -> NSym -> [NExpr] -> NExpr
mkDefGeneric PkgData Text
pd NSym
"nodeFileLocalPackage" [ Bool -> String -> NExpr
N.mkPath Bool
False (Text -> String
forall a b. ConvertText a b => a -> b
toS Text
path), Text -> NExpr
N.mkStr Text
pkgDataHashSum ]
      PkgDefGit pd :: PkgData Git
pd@PkgData{pkgDataUpstream :: forall a. PkgData a -> a
pkgDataUpstream = Git{Text
gitRev :: Text
gitUrl :: Text
gitRev :: Git -> Text
gitUrl :: Git -> Text
..}, Text
pkgDataHashSum :: Text
pkgDataHashSum :: forall a. PkgData a -> Text
pkgDataHashSum} ->
        PkgData Git -> NSym -> [NExpr] -> NExpr
forall a. PkgData a -> NSym -> [NExpr] -> NExpr
mkDefGeneric PkgData Git
pd NSym
"nodeGitPackage"
          [ Text -> NExpr
N.mkStr Text
gitUrl, Text -> NExpr
N.mkStr Text
gitRev, Text -> NExpr
N.mkStr Text
pkgDataHashSum ]

    -- | The common parts of creating a package definition.
    mkDefGeneric :: PkgData a -> NSym -> [NExpr] -> NExpr
    mkDefGeneric :: PkgData a -> NSym -> [NExpr] -> NExpr
mkDefGeneric PkgData{a
[Text]
Text
PackageKeyName
pkgDataDependencies :: [Text]
pkgDataHashSum :: Text
pkgDataUpstream :: a
pkgDataVersion :: Text
pkgDataName :: PackageKeyName
pkgDataDependencies :: forall a. PkgData a -> [Text]
pkgDataHashSum :: forall a. PkgData a -> Text
pkgDataUpstream :: forall a. PkgData a -> a
pkgDataVersion :: forall a. PkgData a -> Text
pkgDataName :: forall a. PkgData a -> PackageKeyName
..} NSym
buildFnSym [NExpr]
additionalArguments =
      (NExpr -> NExpr -> NExpr) -> NExpr -> [NExpr] -> NExpr
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' NExpr -> NExpr -> NExpr
(@@) ([NSym] -> NExpr
shorten [NSym
buildFnSym])
        ([NExpr] -> NExpr) -> [NExpr] -> NExpr
forall a b. (a -> b) -> a -> b
$ [ case PackageKeyName
pkgDataName of
              YLT.SimplePackageKey Text
n -> Text -> NExpr
N.mkStr Text
n
              YLT.ScopedPackageKey Text
s Text
n -> NExpr
"sc" NExpr -> NExpr -> NExpr
@@ Text -> NExpr
N.mkStr Text
s NExpr -> NExpr -> NExpr
@@ Text -> NExpr
N.mkStr Text
n
          , Text -> NExpr
N.mkStr Text
pkgDataVersion ]
          [NExpr] -> [NExpr] -> [NExpr]
forall a. Semigroup a => a -> a -> a
<> [NExpr]
additionalArguments [NExpr] -> [NExpr] -> [NExpr]
forall a. Semigroup a => a -> a -> a
<>
          [ [NExpr] -> NExpr
N.mkList ([NExpr] -> NExpr) -> [NExpr] -> NExpr
forall a b. (a -> b) -> a -> b
$ (Text -> NExpr) -> [Text] -> [NExpr]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (Text -> NExpr
N.mkSym Text
selfSym NExpr -> Text -> NExpr
!!.) [Text]
pkgDataDependencies ]

    selfSym :: Text
    selfSym :: Text
selfSym = Text
"s"

{- $noteFix

@
self: super:
@

follows the fixpoint scheme first introduced
by the @haskellPackage@ set in @nixpkgs@.
See the @Overlays@ documentation in the @nixpkgs@
manual for explanations of how this works.

Note: originally, this was a shallow fix like

@
let attrs = self: {
    "foo bar" = 1;
    bar = self."foo bar" + 2;
  };
in fix attrs
@

which was just in place to work around referencing
attrset attributes through string names.
The new method is a lot more general and allows deep
overrides of arbitrary packages in the dependency set.
-}