{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ViewPatterns #-}

-- | Copyright: (c) 2021-2022 berberman
-- SPDX-License-Identifier: MIT
-- Maintainer: berberman <[email protected]>
-- Stability: experimental
-- Portability: portable
--
-- This module contains a type class 'ToNixExpr' and some its instances associated with either Haskell
-- primitive types or our "NvFetcher.Types".
module NvFetcher.NixExpr
  ( NixExpr,
    ToNixExpr (..),
    fetcherToDrv,
  )
where

import Data.Coerce (coerce)
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HMap
import qualified Data.List.NonEmpty as NE
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import qualified Data.Text as T
import NeatInterpolation (trimming)
import NvFetcher.Types
import NvFetcher.Utils (quote, quoteIfNeeds)

-- | Types can be converted into nix expr
class ToNixExpr a where
  toNixExpr :: a -> NixExpr

instance ToNixExpr (NixFetcher Fetched) where
  toNixExpr :: NixFetcher 'Fetched -> Text
toNixExpr = NixFetcher 'Fetched -> Text
nixFetcher

instance ToNixExpr Bool where
  toNixExpr :: Bool -> Text
toNixExpr Bool
True = Text
"true"
  toNixExpr Bool
False = Text
"false"

instance ToNixExpr a => ToNixExpr [a] where
  toNixExpr :: [a] -> Text
toNixExpr [a]
xs = (Text -> a -> Text) -> Text -> [a] -> Text
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Text
acc a
x -> Text
acc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> a -> Text
forall a. ToNixExpr a => a -> Text
toNixExpr a
x) Text
"[" [a]
xs Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" ]"

instance ToNixExpr a => ToNixExpr (NE.NonEmpty a) where
  toNixExpr :: NonEmpty a -> Text
toNixExpr = [a] -> Text
forall a. ToNixExpr a => a -> Text
toNixExpr ([a] -> Text) -> (NonEmpty a -> [a]) -> NonEmpty a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty a -> [a]
forall a. NonEmpty a -> [a]
NE.toList

instance {-# OVERLAPS #-} ToNixExpr String where
  toNixExpr :: String -> Text
toNixExpr = String -> Text
T.pack (String -> Text) -> (String -> String) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. Show a => a -> String
show

instance ToNixExpr NixExpr where
  toNixExpr :: Text -> Text
toNixExpr = Text -> Text
forall a. a -> a
id

instance ToNixExpr Version where
  toNixExpr :: Version -> Text
toNixExpr = Version -> Text
forall a b. Coercible a b => a -> b
coerce

nixFetcher :: NixFetcher Fetched -> NixExpr
nixFetcher :: NixFetcher 'Fetched -> Text
nixFetcher = \case
  FetchGit
    { _sha256 :: forall (k :: FetchStatus). NixFetcher k -> FetchResult Checksum k
_sha256 = (Text -> Text) -> Checksum -> Text
forall a b. Coercible a b => a -> b
coerce Text -> Text
quote -> Text
sha256,
      _rev :: forall (k :: FetchStatus). NixFetcher k -> Version
_rev = Text -> Text
quote (Text -> Text) -> (Version -> Text) -> Version -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> Text
forall a. ToNixExpr a => a -> Text
toNixExpr -> Text
rev,
      _fetchSubmodules :: forall (k :: FetchStatus). NixFetcher k -> Bool
_fetchSubmodules = Bool -> Text
forall a. ToNixExpr a => a -> Text
toNixExpr -> Text
fetchSubmodules,
      _deepClone :: forall (k :: FetchStatus). NixFetcher k -> Bool
_deepClone = Bool -> Text
forall a. ToNixExpr a => a -> Text
toNixExpr -> Text
deepClone,
      _leaveDotGit :: forall (k :: FetchStatus). NixFetcher k -> Bool
_leaveDotGit = Bool -> Text
forall a. ToNixExpr a => a -> Text
toNixExpr -> Text
leaveDotGit,
      _sparseCheckout :: forall (k :: FetchStatus). NixFetcher k -> [Text]
_sparseCheckout = [Text] -> Text
forall a. ToNixExpr a => a -> Text
toNixExpr ([Text] -> Text) -> ([Text] -> [Text]) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
quote -> Text
sparseCheckout,
      _furl :: forall (k :: FetchStatus). NixFetcher k -> Text
_furl = Text -> Text
quote -> Text
url,
      _name :: forall (k :: FetchStatus). NixFetcher k -> Maybe Text
_name = Maybe Text -> Text
nameField -> Text
n
    } ->
      [trimming|
          fetchgit {
            url = $url;
            rev = $rev;
            fetchSubmodules = $fetchSubmodules;
            deepClone = $deepClone;
            leaveDotGit = $leaveDotGit;
            sparseCheckout = $sparseCheckout;$n
            sha256 = $sha256;
          }
    |]
  FetchGitHub
    { _sha256 :: forall (k :: FetchStatus). NixFetcher k -> FetchResult Checksum k
_sha256 = (Text -> Text) -> Checksum -> Text
forall a b. Coercible a b => a -> b
coerce Text -> Text
quote -> Text
sha256,
      _rev :: forall (k :: FetchStatus). NixFetcher k -> Version
_rev = Text -> Text
quote (Text -> Text) -> (Version -> Text) -> Version -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> Text
forall a. ToNixExpr a => a -> Text
toNixExpr -> Text
rev,
      _fetchSubmodules :: forall (k :: FetchStatus). NixFetcher k -> Bool
_fetchSubmodules = Bool -> Text
forall a. ToNixExpr a => a -> Text
toNixExpr -> Text
fetchSubmodules,
      _deepClone :: forall (k :: FetchStatus). NixFetcher k -> Bool
_deepClone = Bool -> Text
forall a. ToNixExpr a => a -> Text
toNixExpr -> Text
deepClone,
      _leaveDotGit :: forall (k :: FetchStatus). NixFetcher k -> Bool
_leaveDotGit = Bool -> Text
forall a. ToNixExpr a => a -> Text
toNixExpr -> Text
leaveDotGit,
      _sparseCheckout :: forall (k :: FetchStatus). NixFetcher k -> [Text]
_sparseCheckout = [Text] -> Text
forall a. ToNixExpr a => a -> Text
toNixExpr ([Text] -> Text) -> ([Text] -> [Text]) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
quote -> Text
sparseCheckout,
      _fowner :: forall (k :: FetchStatus). NixFetcher k -> Text
_fowner = Text -> Text
quote -> Text
owner,
      _frepo :: forall (k :: FetchStatus). NixFetcher k -> Text
_frepo = Text -> Text
quote -> Text
repo,
      _name :: forall (k :: FetchStatus). NixFetcher k -> Maybe Text
_name = Maybe Text -> Text
nameField -> Text
n
    } ->
      -- TODO: fix fetchFromGitHub in Nixpkgs so that deepClone, leaveDotGit
      -- and sparseCheckout won't get passed to fetchzip
      if (Text
deepClone Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"true") Bool -> Bool -> Bool
|| (Text
leaveDotGit Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"true") Bool -> Bool -> Bool
|| (Text
sparseCheckout Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"[ ]")
        then
          [trimming|
               fetchFromGitHub {
                 owner = $owner;
                 repo = $repo;
                 rev = $rev;
                 fetchSubmodules = $fetchSubmodules;
                 deepClone = $deepClone;
                 leaveDotGit = $leaveDotGit;
                 sparseCheckout = $sparseCheckout;$n
                 sha256 = $sha256;
               }
         |]
        else
          [trimming|
               fetchFromGitHub {
                 owner = $owner;
                 repo = $repo;
                 rev = $rev;
                 fetchSubmodules = $fetchSubmodules;$n
                 sha256 = $sha256;
               }
         |]
  (FetchUrl (Text -> Text
quote -> Text
url) (Maybe Text -> Text
nameField -> Text
n) ((Text -> Text) -> Checksum -> Text
forall a b. Coercible a b => a -> b
coerce Text -> Text
quote -> Text
sha256)) ->
    [trimming|
          fetchurl {
            url = $url;$n
            sha256 = $sha256;
          }
    |]
  (FetchTarball (Text -> Text
quote -> Text
url) ((Text -> Text) -> Checksum -> Text
forall a b. Coercible a b => a -> b
coerce Text -> Text
quote -> Text
sha256)) ->
    [trimming|
          fetchTarball {
            url = $url;
            sha256 = $sha256;
          }
    |]
  FetchDocker
    { _imageName :: forall (k :: FetchStatus). NixFetcher k -> Text
_imageName = Text -> Text
quote (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
forall a. ToNixExpr a => a -> Text
toNixExpr -> Text
imageName,
      _imageTag :: forall (k :: FetchStatus). NixFetcher k -> Text
_imageTag = Text -> Text
quote (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
forall a. ToNixExpr a => a -> Text
toNixExpr -> Text
imageTag,
      _imageDigest :: forall (k :: FetchStatus).
NixFetcher k -> FetchResult ContainerDigest k
_imageDigest = ContainerDigest (Text -> Text
quote (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
forall a. ToNixExpr a => a -> Text
toNixExpr -> Text
imageDigest),
      _sha256 :: forall (k :: FetchStatus). NixFetcher k -> FetchResult Checksum k
_sha256 = (Text -> Text) -> Checksum -> Text
forall a b. Coercible a b => a -> b
coerce Text -> Text
quote -> Text
sha256,
      _fos :: forall (k :: FetchStatus). NixFetcher k -> Maybe Text
_fos = Text -> Maybe Text -> Text
optionalStr Text
"os" -> Text
os,
      _farch :: forall (k :: FetchStatus). NixFetcher k -> Maybe Text
_farch = Text -> Maybe Text -> Text
optionalStr Text
"arch" -> Text
arch,
      _finalImageName :: forall (k :: FetchStatus). NixFetcher k -> Maybe Text
_finalImageName = Text -> Maybe Text -> Text
optionalStr Text
"finalImageName" -> Text
finalImageName,
      _finalImageTag :: forall (k :: FetchStatus). NixFetcher k -> Maybe Text
_finalImageTag = Text -> (Text -> Text) -> Maybe Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
imageTag (Text -> Text
quote (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
forall a. ToNixExpr a => a -> Text
toNixExpr) -> Text
finalImageTag,
      _tlsVerify :: forall (k :: FetchStatus). NixFetcher k -> Maybe Bool
_tlsVerify = Text -> Maybe Bool -> Text
forall {a}. ToNixExpr a => Text -> Maybe a -> Text
optionalField Text
"tlsVerify" -> Text
tlsVerify
    } ->
      [trimming|
            dockerTools.pullImage {
              imageName = $imageName;
              imageDigest = $imageDigest;
              sha256 = $sha256;
              finalImageTag = $finalImageTag;$os$arch$finalImageName$tlsVerify
            }
      |]
  where
    optionalField :: Text -> Maybe a -> Text
optionalField Text
n = Text -> (a -> Text) -> Maybe a -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (\a
x -> Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" = " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> a -> Text
forall a. ToNixExpr a => a -> Text
toNixExpr a
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
";")
    optionalStr :: Text -> Maybe Text -> Text
optionalStr Text
n = Text -> Maybe Text -> Text
forall {a}. ToNixExpr a => Text -> Maybe a -> Text
optionalField Text
n (Maybe Text -> Text)
-> (Maybe Text -> Maybe Text) -> Maybe Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> Maybe Text -> Maybe Text
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
quote
    nameField :: Maybe Text -> Text
nameField = Text -> Maybe Text -> Text
optionalStr Text
"name"

-- | Create a trivial drv that extracts the source from a fetcher
-- TODO: Avoid using @NIX_PATH@
fetcherToDrv :: NixFetcher Fetched -> Text -> NixExpr
fetcherToDrv :: NixFetcher 'Fetched -> Text -> Text
fetcherToDrv (NixFetcher 'Fetched -> Text
forall a. ToNixExpr a => a -> Text
toNixExpr -> Text
fetcherExpr) (Text -> Text
quote -> Text
drvName) =
  [trimming|
    with import <nixpkgs> { };
    stdenv.mkDerivation {
      name = $drvName;
      src = $fetcherExpr;
      nativeBuildInputs = [ unzip ];
      dontBuild = true;
      installPhase = ''
        mkdir $$out
        cp -r * $$out
      '';
    }
  |]

-- | nix expr snippet like:
--
-- @
-- feeluown-core = {
--     pname = "feeluown-core";
--     version = "3.7.7";
--     src = fetchurl {
--       sha256 = "06d3j39ff9znqxkhp9ly81lcgajkhg30hyqxy2809yn23xixg3x2";
--       url = "https://pypi.io/packages/source/f/feeluown/feeluown-3.7.7.tar.gz";
--     };
--     a = "B";
--   };
-- @
instance ToNixExpr PackageResult where
  toNixExpr :: PackageResult -> Text
toNixExpr PackageResult {Maybe (HashMap String (Text, HashMap Text Checksum))
Maybe (HashMap String Text)
Maybe (HashMap Text Text)
Maybe Text
Text
UseStaleVersion
NixFetcher 'Fetched
NvcheckerResult
_prname :: Text
_prversion :: NvcheckerResult
_prfetched :: NixFetcher 'Fetched
_prpassthru :: Maybe (HashMap Text Text)
_prextract :: Maybe (HashMap String Text)
_prcargolock :: Maybe (HashMap String (Text, HashMap Text Checksum))
_prpinned :: UseStaleVersion
_prgitdate :: Maybe Text
_prname :: PackageResult -> Text
_prversion :: PackageResult -> NvcheckerResult
_prfetched :: PackageResult -> NixFetcher 'Fetched
_prpassthru :: PackageResult -> Maybe (HashMap Text Text)
_prextract :: PackageResult -> Maybe (HashMap String Text)
_prcargolock :: PackageResult
-> Maybe (HashMap String (Text, HashMap Text Checksum))
_prpinned :: PackageResult -> UseStaleVersion
_prgitdate :: PackageResult -> Maybe Text
..} =
    [trimming|
        $name = {
          pname = $nameString;
          version = $version;
          src = $src;$appending
        };
    |]
    where
      name :: Text
name = Text -> Text
quoteIfNeeds Text
_prname
      nameString :: Text
nameString = Text -> Text
quote Text
_prname
      version :: Text
version = Text -> Text
quote (Text -> Text)
-> (NvcheckerResult -> Text) -> NvcheckerResult -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> Text
forall a b. Coercible a b => a -> b
coerce (Version -> Text)
-> (NvcheckerResult -> Version) -> NvcheckerResult -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NvcheckerResult -> Version
nvNow (NvcheckerResult -> Text) -> NvcheckerResult -> Text
forall a b. (a -> b) -> a -> b
$ NvcheckerResult
_prversion
      src :: Text
src = NixFetcher 'Fetched -> Text
forall a. ToNixExpr a => a -> Text
toNixExpr NixFetcher 'Fetched
_prfetched
      extract :: Text
extract =
        Text
-> (HashMap String Text -> Text)
-> Maybe (HashMap String Text)
-> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
          Text
""
          ( \HashMap String Text
ex ->
              [Text] -> Text
T.unlines
                [ Text -> Text
quoteIfNeeds (String -> Text
T.pack String
name)
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" = builtins.readFile "
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fp
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
";"
                  | (String
name, Text
fp) <- HashMap String Text -> [(String, Text)]
forall k v. HashMap k v -> [(k, v)]
HMap.toList HashMap String Text
ex
                ]
          )
          Maybe (HashMap String Text)
_prextract
      cargo :: Text
cargo = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ do
        HashMap String (Text, HashMap Text Checksum)
cargoLocks <- Maybe (HashMap String (Text, HashMap Text Checksum))
_prcargolock
        let depsSnippet :: HashMap Text Checksum -> Text
depsSnippet (HashMap Text Checksum
deps :: HashMap Text Checksum) =
              [Text] -> Text
T.unlines
                [ Text -> Text
quoteIfNeeds Text
name
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" = "
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
quote (Checksum -> Text
forall a b. Coercible a b => a -> b
coerce Checksum
sum)
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
";"
                  | (Text
name, Checksum
sum) <- HashMap Text Checksum -> [(Text, Checksum)]
forall k v. HashMap k v -> [(k, v)]
HMap.toList HashMap Text Checksum
deps
                ]
            lockSnippet :: (String, (Text, HashMap Text Checksum)) -> Text
lockSnippet ((String -> Text
T.pack -> Text
fp) :: FilePath, (Text
nixFP :: NixExpr, HashMap Text Checksum
deps :: HashMap Text Checksum)) =
              let hashes :: Text
hashes = HashMap Text Checksum -> Text
depsSnippet HashMap Text Checksum
deps
               in [trimming|
                    cargoLock."$fp" = {
                      lockFile = $nixFP;
                      outputHashes = {
                        $hashes
                      };
                    };
                |]
        Text -> Maybe Text
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Maybe Text) -> ([Text] -> Text) -> [Text] -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.unlines ([Text] -> Maybe Text) -> [Text] -> Maybe Text
forall a b. (a -> b) -> a -> b
$ (String, (Text, HashMap Text Checksum)) -> Text
lockSnippet ((String, (Text, HashMap Text Checksum)) -> Text)
-> [(String, (Text, HashMap Text Checksum))] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashMap String (Text, HashMap Text Checksum)
-> [(String, (Text, HashMap Text Checksum))]
forall k v. HashMap k v -> [(k, v)]
HMap.toList HashMap String (Text, HashMap Text Checksum)
cargoLocks
      passthru :: Text
passthru =
        Text
-> (HashMap Text Text -> Text) -> Maybe (HashMap Text Text) -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
          Text
""
          ( \HashMap Text Text
pt ->
              [Text] -> Text
T.unlines
                [ Text -> Text
quoteIfNeeds Text
k
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" = "
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
v
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
";"
                  | (Text
k, Text -> Text
quote -> Text
v) <- HashMap Text Text -> [(Text, Text)]
forall k v. HashMap k v -> [(k, v)]
HMap.toList HashMap Text Text
pt
                ]
          )
          Maybe (HashMap Text Text)
_prpassthru
      date :: Text
date = Text -> (Text -> Text) -> Maybe Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (\Text
d -> Text
"date = " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
quote Text
d Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
";") Maybe Text
_prgitdate
      joined :: Text
joined = Text
extract Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
cargo Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
passthru Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
date
      appending :: Text
appending = if Text -> Bool
T.null Text
joined then Text
"" else Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
joined