{-# 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 { unNSym :: Text }
  deriving (IsString, Ord, Eq)

-- | Nix input variable.
newtype NVar = NVar NSym
  deriving (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 vals = Fix . N.NStr . N.DoubleQuoted
  $ flip map vals $ \case
      T t -> N.Plain t
      V (NVar (NSym t)) -> N.Antiquoted $ N.mkSym t

-- | A registry that we know of and can therefore shorten
-- into a nix function call.
data Registry = Registry
  { registrySym :: NSym
    -- ^ nix symbol used in the output file
  , 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
  { gitUrl :: 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
  { pkgDataName :: YLT.PackageKeyName -- ^ package name
  , pkgDataVersion :: Text            -- ^ package version
  , pkgDataUpstream :: a              -- ^ points to upstream
  , pkgDataHashSum :: Text            -- ^ the hash sum of the package
  , pkgDataDependencies :: [Text]     -- ^ list of dependencies (as resolved nix symbols)
  }

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

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

shortcuts :: M.Map [NSym] NSym
shortcuts = M.fromList
  [ (["self"], "s")
  , (["registries", "yarn"], "y")
  , (["registries", "npm"], "n")
  , (["nodeFilePackage"], "f")
  , (["nodeFileLocalPackage"], "l")
  , (["nodeGitPackage"], "g")
  , (["identityRegistry"], "ir")
  , (["scopedName"], "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 (YLT.ScopedPackageKey{}) _ = Nothing
recognizeRegistry _ fileUrl = snd <$> foundRegistry
  where
    -- | Get registry by the prefix of the registry’s URL.
    foundRegistry = find predicate registries
    predicate :: (Text, Registry) -> Bool
    predicate reg = fst reg `T.isPrefixOf` fileUrl


-- | Convert a 'Res.ResolvedLockfile' to its final, nix-ready form.
convertLockfile :: Res.ResolvedLockfile -> M.Map Text PkgRef
convertLockfile = M.fromList . foldMap convert . 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 (keys, Res.Resolved{ hashSum, resolved=pkg }) = let
      -- | Since there might be more than one key name, we choose
      -- the one with most entries.
      defName = NE.head $ maximumBy (comparing length) $ NE.group $ NE.sort $ fmap YLT.name keys
      defSym = packageKeyToSymbol $ YLT.PackageKey
        { YLT.name = defName
        , YLT.npmVersionSpec = YLT.version pkg }
      pkgDataGeneric upstream = PkgData
        { pkgDataName = defName
        , pkgDataVersion = YLT.version pkg
        , pkgDataUpstream = upstream
        , pkgDataHashSum = hashSum
        , pkgDataDependencies = map packageKeyToSymbol
            -- TODO: handle optional dependencies better
            $ YLT.dependencies pkg <> YLT.optionalDependencies pkg
        }
      def = case YLT.remote pkg of
        YLT.FileRemote{fileUrl} ->
          PkgDefFile $ pkgDataGeneric $ note fileUrl
            $ recognizeRegistry defName fileUrl
        YLT.FileLocal{fileLocalPath} ->
          PkgDefFileLocal $ pkgDataGeneric $ fileLocalPath
        YLT.GitRemote{gitRepoUrl, gitRev} ->
          PkgDefGit $ pkgDataGeneric $ Git gitRepoUrl gitRev
        YLT.FileRemoteNoIntegrity {} ->
          panic "programming error, should have thrown an error in ResolveLockfile"
        YLT.FileLocalNoIntegrity {} ->
          panic "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 = List.delete defSym $ toList $ NE.nub
        $ fmap packageKeyToSymbol keys
      in (defSym, def) : map (\rn -> (rn, PkgRef defSym)) 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 packages =
  NA.simpleParamSet ["fetchurl", "fetchgit"]
    -- enable self-referencing of packages
    -- with string names with a self/super fix
    -- see note FIX
    ==> N.Param "self" ==> N.Param "super"
    ==> N.mkLets
        (  [ "registries" $= N.mkNonRecSet (fmap (mkRegistry . snd) registries)
           , "nodeFilePackage" $= buildPkgFn
           , "nodeFileLocalPackage" $= buildPkgLocalFn
           , "nodeGitPackage" $= buildPkgGitFn
           , "identityRegistry" $= NA.multiParam ["url", "_", "_"] "url"
           , "scopedName" $=
               (NA.multiParam ["scope", "name"]
                 $ N.mkNonRecSet [ inheritStatic ["scope", "name"] ])
           ]
        <> fmap mkShortcut (M.toList shortcuts) )
        (N.mkNonRecSet (map mkPkg $ M.toAscList packages))
  where
    mkRegistry (Registry{..}) = unNSym registrySym $=
      (N.Param "n" ==> N.Param "v" ==> antiquote (registryBuilder "n" "v"))

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

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

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

    selfSym :: Text
    selfSym = "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.
-}