nix-freeze-tree-0.1.1.0: src/NixBuilder.hs

{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}

module NixBuilder (BuilderDirs (..), mkBuildExpr) where

import BuilderDirs (BuilderDirs (..), currentDir)
import Control.Monad.Trans.Reader (ReaderT)
import Data.Fix (Fix (..))
import Data.List (dropWhileEnd)
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.List.NonEmpty as NE
import Data.Text (Text)
import qualified Data.Text as T
import Nix
import NixHash (mkFileAttrs, replaceUnsafeChars)
import Path (Abs, Dir, File, Path, Rel)
import qualified Path as P

-- | Given a list of directory contents, construct a Nix expression
-- that builds a derivation, where:
--
-- * Every file is a symlink to a separate fixed-output derivation, and
-- * Every directory is a symlink to a derivation built with 'mkBuildExpr'
--
-- The ReaderT context is the path to the directory, split into an
-- absolute root and a subdirectory relative to the root.
mkBuildExpr :: [Path Rel File] -> [Path Rel Dir] -> ReaderT BuilderDirs IO NExpr
mkBuildExpr files dirs = do
  fileAttrs <- mkFileAttrs files

  let dirAttrs = mkDirAttr <$> dirs
      mSrcs = NE.nonEmpty $ dirAttrs ++ fileAttrs

  drv <- maybe mkEmptyDerivation mkDirectoryDerivation mSrcs <$> currentDir

  pure $ mkParamset [stdenvArg] False ==> drv
  where
    mkDirAttr :: Path Rel Dir -> (Text, NExpr)
    mkDirAttr d =
      ( T.pack $ nixSafeFilePath d,
        "import (./. + "
          @@ mkStr (T.pack ("/" ++ nixSafeFilePath d))
          @@ ")"
          @@ mkNonRecSet [inherit ["stdenv"]]
      )

    stdenvArg =
      ( "stdenv",
        Just $ ("import" @@ mkEnvPath "nixpkgs" @@ mkNonRecSet []) @. "stdenv"
      )

-- | Construct the @mkDerivation@ call for a directory. It builds a
-- derivation that symlinks to each file in $srcs under their original
-- names.
mkDirectoryDerivation :: NonEmpty (Text, NExpr) -> Path Abs Dir -> NExpr
mkDirectoryDerivation srcs d =
  mkLets ["paths" $= mkNonRecSet (NE.toList $ mkBinding <$> srcs)] $
    "stdenv"
      @. "mkDerivation"
      @@ mkNonRecSet
        [ "name" $= abspathToDerivationName d,
          "allowSubstitutes" $= mkBool False,
          "preferLocalBuild" $= mkBool True,
          "phases" $= mkList [mkStr "installPhase"],
          "installPhase" $= installCmds
        ]
  where
    mkBinding :: (Text, NExpr) -> Binding NExpr
    mkBinding (t, e) =
      NamedVar (DynamicKey (Plain (DoubleQuoted [Plain t])) :| []) e nullPos

    installCmds :: NExpr
    installCmds =
      Fix . NStr . Indented 2 $
        [ Plain "mkdir -p $out;",
          Plain "cd $out;"
        ]
          ++ foldMap (mkLinkCmd . fst) srcs
      where
        mkLinkCmd :: Text -> [Antiquoted Text NExpr]
        mkLinkCmd name =
          let -- Use double-quoted selections from "paths".
              -- This works on files that start with a leading '.'.
              sourcePath :: NonEmpty (NKeyName r)
              sourcePath = pure . DynamicKey . Plain $ DoubleQuoted [Plain name]
           in [ Plain "ln -sv ",
                Antiquoted . Fix $ NSelect Nothing "paths" sourcePath,
                Plain $ " '" <> name <> "';"
              ]

-- | Construct the @mkDerivation@ call for an empty directory.
mkEmptyDerivation :: Path Abs Dir -> NExpr
mkEmptyDerivation d =
  "stdenv"
    @. "mkDerivation"
    @@ mkNonRecSet
      [ "name" $= abspathToDerivationName d,
        "allowSubstitutes" $= mkBool False,
        "preferLocalBuild" $= mkBool True,
        "phases" $= mkList [mkStr "installPhase"],
        "installPhase" $= mkStr "mkdir $out"
      ]

abspathToDerivationName :: Path Abs Dir -> NExpr
abspathToDerivationName =
  mkStr
    . T.pack
    . replaceUnsafeChars
    . nixSafeFilePath
    . P.dirname

-- | Nix doesn't like trailing slashes in derivation names or paths.
nixSafeFilePath :: Path b t -> FilePath
nixSafeFilePath = dropWhileEnd (== '/') . P.toFilePath