{-# 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 :: [Path Rel File] -> [Path Rel Dir] -> ReaderT BuilderDirs IO NExpr
mkBuildExpr [Path Rel File]
files [Path Rel Dir]
dirs = do
  [(Text, NExpr)]
fileAttrs <- [Path Rel File] -> ReaderT BuilderDirs IO [(Text, NExpr)]
mkFileAttrs [Path Rel File]
files

  let
    dirAttrs :: [(Text, NExpr)]
dirAttrs = Path Rel Dir -> (Text, NExpr)
mkDirAttr (Path Rel Dir -> (Text, NExpr))
-> [Path Rel Dir] -> [(Text, NExpr)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Path Rel Dir]
dirs
    mSrcs :: Maybe (NonEmpty (Text, NExpr))
mSrcs = [(Text, NExpr)] -> Maybe (NonEmpty (Text, NExpr))
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty ([(Text, NExpr)] -> Maybe (NonEmpty (Text, NExpr)))
-> [(Text, NExpr)] -> Maybe (NonEmpty (Text, NExpr))
forall a b. (a -> b) -> a -> b
$ [(Text, NExpr)]
dirAttrs [(Text, NExpr)] -> [(Text, NExpr)] -> [(Text, NExpr)]
forall a. [a] -> [a] -> [a]
++ [(Text, NExpr)]
fileAttrs

  NExpr
drv <- ReaderT BuilderDirs IO (Path Abs Dir)
currentDir ReaderT BuilderDirs IO (Path Abs Dir)
-> (Path Abs Dir -> NExpr) -> ReaderT BuilderDirs IO NExpr
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> case Maybe (NonEmpty (Text, NExpr))
mSrcs of
    Maybe (NonEmpty (Text, NExpr))
Nothing -> Path Abs Dir -> NExpr
mkEmptyDerivation
    Just NonEmpty (Text, NExpr)
srcs -> NonEmpty (Text, NExpr) -> Path Abs Dir -> NExpr
mkDirectoryDerivation NonEmpty (Text, NExpr)
srcs

  NExpr -> ReaderT BuilderDirs IO NExpr
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NExpr -> ReaderT BuilderDirs IO NExpr)
-> NExpr -> ReaderT BuilderDirs IO NExpr
forall a b. (a -> b) -> a -> b
$ [(Text, Maybe NExpr)] -> Bool -> Params NExpr
mkParamset [(Text, Maybe NExpr)
stdenvArg] Bool
False Params NExpr -> NExpr -> NExpr
==> NExpr
drv

  where
    mkDirAttr :: Path Rel Dir -> (Text, NExpr)
    mkDirAttr :: Path Rel Dir -> (Text, NExpr)
mkDirAttr Path Rel Dir
d =
      ( String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Path Rel Dir -> String
forall b t. Path b t -> String
nixSafeFilePath Path Rel Dir
d
      , NExpr
"import" NExpr -> NExpr -> NExpr
@@ Bool -> String -> NExpr
mkPath Bool
False (Path Rel Dir -> String
forall b t. Path b t -> String
nixSafeFilePath Path Rel Dir
d) NExpr -> NExpr -> NExpr
@@ [Binding NExpr] -> NExpr
mkNonRecSet
        [ [NKeyName NExpr] -> SourcePos -> Binding NExpr
forall e. [NKeyName e] -> SourcePos -> Binding e
inherit [NKeyName NExpr
"stdenv"] SourcePos
nullPos ]
      )

    stdenvArg :: (Text, Maybe NExpr)
stdenvArg =
      ( Text
"stdenv"
      , NExpr -> Maybe NExpr
forall a. a -> Maybe a
Just (NExpr -> Maybe NExpr) -> NExpr -> Maybe NExpr
forall a b. (a -> b) -> a -> b
$ (NExpr
"import" NExpr -> NExpr -> NExpr
@@ String -> NExpr
mkEnvPath String
"nixpkgs" NExpr -> NExpr -> NExpr
@@ [Binding NExpr] -> NExpr
mkNonRecSet []) NExpr -> Text -> NExpr
@. Text
"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 :: NonEmpty (Text, NExpr) -> Path Abs Dir -> NExpr
mkDirectoryDerivation NonEmpty (Text, NExpr)
srcs Path Abs Dir
d =
  [Binding NExpr] -> NExpr -> NExpr
mkLets [Text
"paths" Text -> NExpr -> Binding NExpr
$= [Binding NExpr] -> NExpr
mkNonRecSet (NonEmpty (Binding NExpr) -> [Binding NExpr]
forall a. NonEmpty a -> [a]
NE.toList (NonEmpty (Binding NExpr) -> [Binding NExpr])
-> NonEmpty (Binding NExpr) -> [Binding NExpr]
forall a b. (a -> b) -> a -> b
$ (Text, NExpr) -> Binding NExpr
mkBinding ((Text, NExpr) -> Binding NExpr)
-> NonEmpty (Text, NExpr) -> NonEmpty (Binding NExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (Text, NExpr)
srcs)] (NExpr -> NExpr) -> NExpr -> NExpr
forall a b. (a -> b) -> a -> b
$
    NExpr
"stdenv" NExpr -> Text -> NExpr
@. Text
"mkDerivation" NExpr -> NExpr -> NExpr
@@ [Binding NExpr] -> NExpr
mkNonRecSet
      [ Text
"name" Text -> NExpr -> Binding NExpr
$= Path Abs Dir -> NExpr
abspathToDerivationName Path Abs Dir
d
      , Text
"allowSubstitutes" Text -> NExpr -> Binding NExpr
$= Bool -> NExpr
mkBool Bool
False
      , Text
"preferLocalBuild" Text -> NExpr -> Binding NExpr
$= Bool -> NExpr
mkBool Bool
True
      , Text
"phases" Text -> NExpr -> Binding NExpr
$= [NExpr] -> NExpr
mkList [Text -> NExpr
mkStr Text
"installPhase"]
      , Text
"installPhase" Text -> NExpr -> Binding NExpr
$= NExpr
installCmds
      ]

  where
    mkBinding :: (Text, NExpr) -> Binding NExpr
    mkBinding :: (Text, NExpr) -> Binding NExpr
mkBinding (Text
t, NExpr
e) =
      NAttrPath NExpr -> NExpr -> SourcePos -> Binding NExpr
forall r. NAttrPath r -> r -> SourcePos -> Binding r
NamedVar (Antiquoted (NString NExpr) NExpr -> NKeyName NExpr
forall r. Antiquoted (NString r) r -> NKeyName r
DynamicKey (NString NExpr -> Antiquoted (NString NExpr) NExpr
forall v r. v -> Antiquoted v r
Plain ([Antiquoted Text NExpr] -> NString NExpr
forall r. [Antiquoted Text r] -> NString r
DoubleQuoted [Text -> Antiquoted Text NExpr
forall v r. v -> Antiquoted v r
Plain Text
t])) NKeyName NExpr -> [NKeyName NExpr] -> NAttrPath NExpr
forall a. a -> [a] -> NonEmpty a
:| []) NExpr
e SourcePos
nullPos

    installCmds :: NExpr
    installCmds :: NExpr
installCmds = 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
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
. Int -> [Antiquoted Text NExpr] -> NString NExpr
forall r. Int -> [Antiquoted Text r] -> NString r
Indented Int
2 ([Antiquoted Text NExpr] -> NExpr)
-> [Antiquoted Text NExpr] -> NExpr
forall a b. (a -> b) -> a -> b
$
      [ Text -> Antiquoted Text NExpr
forall v r. v -> Antiquoted v r
Plain Text
"mkdir -p $out;"
      , Text -> Antiquoted Text NExpr
forall v r. v -> Antiquoted v r
Plain Text
"cd $out;"
      ] [Antiquoted Text NExpr]
-> [Antiquoted Text NExpr] -> [Antiquoted Text NExpr]
forall a. [a] -> [a] -> [a]
++ ((Text, NExpr) -> [Antiquoted Text NExpr])
-> NonEmpty (Text, NExpr) -> [Antiquoted Text NExpr]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Text -> [Antiquoted Text NExpr]
mkLinkCmd (Text -> [Antiquoted Text NExpr])
-> ((Text, NExpr) -> Text)
-> (Text, NExpr)
-> [Antiquoted Text NExpr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, NExpr) -> Text
forall a b. (a, b) -> a
fst) NonEmpty (Text, NExpr)
srcs
      where
        mkLinkCmd :: Text -> [Antiquoted Text NExpr]
        mkLinkCmd :: Text -> [Antiquoted Text NExpr]
mkLinkCmd Text
name =
          let
            -- Use double-quoted selections from "paths".
            -- This works on files that start with a leading '.'.
            sourcePath :: NonEmpty (NKeyName r)
            sourcePath :: NonEmpty (NKeyName r)
sourcePath = NKeyName r -> NonEmpty (NKeyName r)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NKeyName r -> NonEmpty (NKeyName r))
-> (NString r -> NKeyName r) -> NString r -> NonEmpty (NKeyName r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Antiquoted (NString r) r -> NKeyName r
forall r. Antiquoted (NString r) r -> NKeyName r
DynamicKey (Antiquoted (NString r) r -> NKeyName r)
-> (NString r -> Antiquoted (NString r) r)
-> NString r
-> NKeyName r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NString r -> Antiquoted (NString r) r
forall v r. v -> Antiquoted v r
Plain (NString r -> NonEmpty (NKeyName r))
-> NString r -> NonEmpty (NKeyName r)
forall a b. (a -> b) -> a -> b
$ [Antiquoted Text r] -> NString r
forall r. [Antiquoted Text r] -> NString r
DoubleQuoted [Text -> Antiquoted Text r
forall v r. v -> Antiquoted v r
Plain Text
name]

          in
            [ Text -> Antiquoted Text NExpr
forall v r. v -> Antiquoted v r
Plain Text
"ln -sv "
            , NExpr -> Antiquoted Text NExpr
forall v r. r -> Antiquoted v r
Antiquoted (NExpr -> Antiquoted Text NExpr)
-> (NExprF NExpr -> NExpr) -> NExprF NExpr -> Antiquoted Text NExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NExprF NExpr -> NExpr
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NExprF NExpr -> Antiquoted Text NExpr)
-> NExprF NExpr -> Antiquoted Text NExpr
forall a b. (a -> b) -> a -> b
$ NExpr -> NAttrPath NExpr -> Maybe NExpr -> NExprF NExpr
forall r. r -> NAttrPath r -> Maybe r -> NExprF r
NSelect NExpr
"paths" NAttrPath NExpr
forall r. NonEmpty (NKeyName r)
sourcePath Maybe NExpr
forall a. Maybe a
Nothing
            , Text -> Antiquoted Text NExpr
forall v r. v -> Antiquoted v r
Plain (Text -> Antiquoted Text NExpr) -> Text -> Antiquoted Text NExpr
forall a b. (a -> b) -> a -> b
$ Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
";"
            ]


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

abspathToDerivationName :: Path Abs Dir -> NExpr
abspathToDerivationName :: Path Abs Dir -> NExpr
abspathToDerivationName
  = Text -> NExpr
mkStr
  (Text -> NExpr) -> (Path Abs Dir -> Text) -> Path Abs Dir -> NExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
  (String -> Text)
-> (Path Abs Dir -> String) -> Path Abs Dir -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
replaceLeadingDot
  (String -> String)
-> (Path Abs Dir -> String) -> Path Abs Dir -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Rel Dir -> String
forall b t. Path b t -> String
nixSafeFilePath
  (Path Rel Dir -> String)
-> (Path Abs Dir -> Path Rel Dir) -> Path Abs Dir -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs Dir -> Path Rel Dir
forall b. Path b Dir -> Path Rel Dir
P.dirname

-- | Nix doesn't like trailing slashes in derivation names or paths.
nixSafeFilePath :: Path b t -> FilePath
nixSafeFilePath :: Path b t -> String
nixSafeFilePath = (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/') (String -> String) -> (Path b t -> String) -> Path b t -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path b t -> String
forall b t. Path b t -> String
P.toFilePath