packages feed

nix-freeze-tree-0.1.0.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.Functor ((<&>))
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, replaceLeadingDot)
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 <- currentDir <&> case mSrcs of
    Nothing -> mkEmptyDerivation
    Just srcs -> mkDirectoryDerivation srcs

  pure $ mkParamset [stdenvArg] False ==> drv

  where
    mkDirAttr :: Path Rel Dir -> (Text, NExpr)
    mkDirAttr d =
      ( T.pack $ nixSafeFilePath d
      , "import" @@ mkPath False (nixSafeFilePath d) @@ mkNonRecSet
        [ inherit ["stdenv"] nullPos ]
      )

    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 "paths" sourcePath Nothing
            , 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
  . replaceLeadingDot
  . nixSafeFilePath
  . P.dirname

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