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

-- | Copyright: (c) 2021 berberman
-- SPDX-License-Identifier: MIT
-- Maintainer: berberman <berberman@yandex.com>
-- Stability: experimental
-- Portability: portable
--
-- 'NixFetcher' is used to describe how to fetch package sources.
--
-- There are two types of fetchers overall:
--
-- 1. 'FetchGit' -- nix-prefetch-git
-- 2. 'FetchUrl' -- nix-prefetch-url
--
-- As you can see the type signature of 'prefetch':
-- a fetcher will be filled with the fetch result (hash) after the prefetch.
module NvFetcher.NixFetcher
  ( -- * Types
    NixFetcher (..),
    Prefetch (..),
    ToNixExpr (..),
    PrefetchResult,

    -- * Rules
    prefetchRule,
    prefetch,

    -- * Functions
    gitHubFetcher,
    pypiFetcher,
    gitHubReleaseFetcher,
    gitFetcher,
    urlFetcher,
  )
where

import Control.Monad (void, (<=<))
import qualified Data.Aeson as A
import qualified Data.Aeson.Types as A
import Data.Coerce (coerce)
import Data.Maybe (maybeToList)
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Development.Shake
import NeatInterpolation (trimming)
import NvFetcher.Types

--------------------------------------------------------------------------------

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

instance ToNixExpr (NixFetcher Fresh) where
  toNixExpr :: NixFetcher 'Fresh -> NixExpr
toNixExpr = NixExpr -> NixFetcher 'Fresh -> NixExpr
forall (k :: Prefetch). NixExpr -> NixFetcher k -> NixExpr
buildNixFetcher NixExpr
"lib.fakeSha256"

instance ToNixExpr (NixFetcher Prefetched) where
  -- add quotation marks
  toNixExpr :: NixFetcher 'Prefetched -> NixExpr
toNixExpr NixFetcher 'Prefetched
f = NixExpr -> NixFetcher 'Prefetched -> NixExpr
forall (k :: Prefetch). NixExpr -> NixFetcher k -> NixExpr
buildNixFetcher (String -> NixExpr
T.pack (String -> NixExpr) -> String -> NixExpr
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. Show a => a -> String
show (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ NixExpr -> String
T.unpack (NixExpr -> String) -> NixExpr -> String
forall a b. (a -> b) -> a -> b
$ SHA256 -> NixExpr
coerce (SHA256 -> NixExpr) -> SHA256 -> NixExpr
forall a b. (a -> b) -> a -> b
$ NixFetcher 'Prefetched -> PrefetchResult 'Prefetched
forall (k :: Prefetch). NixFetcher k -> PrefetchResult k
sha256 NixFetcher 'Prefetched
f) NixFetcher 'Prefetched
f

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

instance ToNixExpr Version where
  toNixExpr :: Version -> NixExpr
toNixExpr = Version -> NixExpr
coerce

runFetcher :: NixFetcher Fresh -> Action SHA256
runFetcher :: NixFetcher 'Fresh -> Action SHA256
runFetcher = \case
  FetchGit {Bool
Maybe NixExpr
NixExpr
PrefetchResult 'Fresh
Version
leaveDotGit :: forall (k :: Prefetch). NixFetcher k -> Bool
fetchSubmodules :: forall (k :: Prefetch). NixFetcher k -> Bool
deepClone :: forall (k :: Prefetch). NixFetcher k -> Bool
branch :: forall (k :: Prefetch). NixFetcher k -> Maybe NixExpr
rev :: forall (k :: Prefetch). NixFetcher k -> Version
furl :: forall (k :: Prefetch). NixFetcher k -> NixExpr
sha256 :: PrefetchResult 'Fresh
leaveDotGit :: Bool
fetchSubmodules :: Bool
deepClone :: Bool
branch :: Maybe NixExpr
rev :: Version
furl :: NixExpr
sha256 :: forall (k :: Prefetch). NixFetcher k -> PrefetchResult k
..} -> do
    let parser :: Value -> Parser SHA256
parser = String -> (Object -> Parser SHA256) -> Value -> Parser SHA256
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"nix-prefetch-git" ((Object -> Parser SHA256) -> Value -> Parser SHA256)
-> (Object -> Parser SHA256) -> Value -> Parser SHA256
forall a b. (a -> b) -> a -> b
$ \Object
o -> NixExpr -> SHA256
SHA256 (NixExpr -> SHA256) -> Parser NixExpr -> Parser SHA256
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> NixExpr -> Parser NixExpr
forall a. FromJSON a => Object -> NixExpr -> Parser a
A..: NixExpr
"sha256"
    (CmdTime Double
t, Stdout ByteString
out, CmdLine String
c) <-
      [CmdOption]
-> String
-> [String]
-> Action (CmdTime, Stdout ByteString, CmdLine)
forall r.
(Partial, CmdResult r) =>
[CmdOption] -> String -> [String] -> Action r
command [Bool -> CmdOption
EchoStderr Bool
False] String
"nix-prefetch-git" ([String] -> Action (CmdTime, Stdout ByteString, CmdLine))
-> [String] -> Action (CmdTime, Stdout ByteString, CmdLine)
forall a b. (a -> b) -> a -> b
$
        [NixExpr -> String
T.unpack NixExpr
furl]
          [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String
"--rev", NixExpr -> String
T.unpack (NixExpr -> String) -> NixExpr -> String
forall a b. (a -> b) -> a -> b
$ Version -> NixExpr
coerce Version
rev]
          [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String
"--fetch-submodules" | Bool
fetchSubmodules]
          [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String
"--branch-name " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> NixExpr -> String
T.unpack NixExpr
b | NixExpr
b <- Maybe NixExpr -> [NixExpr]
forall a. Maybe a -> [a]
maybeToList Maybe NixExpr
branch]
          [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String
"--deepClone" | Bool
deepClone]
          [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String
"--leave-dotGit" | Bool
leaveDotGit]
    String -> Action ()
putInfo (String -> Action ()) -> String -> Action ()
forall a b. (a -> b) -> a -> b
$ String
"Finishing running " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
c String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
", took " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Double -> String
forall a. Show a => a -> String
show Double
t String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"s"
    let result :: Maybe SHA256
result = (Value -> Parser SHA256) -> Value -> Maybe SHA256
forall a b. (a -> Parser b) -> a -> Maybe b
A.parseMaybe Value -> Parser SHA256
parser (Value -> Maybe SHA256)
-> (ByteString -> Maybe Value) -> ByteString -> Maybe SHA256
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< ByteString -> Maybe Value
forall a. FromJSON a => ByteString -> Maybe a
A.decodeStrict (ByteString -> Maybe SHA256) -> ByteString -> Maybe SHA256
forall a b. (a -> b) -> a -> b
$ ByteString
out
    case Maybe SHA256
result of
      Just SHA256
x -> SHA256 -> Action SHA256
forall (f :: * -> *) a. Applicative f => a -> f a
pure SHA256
x
      Maybe SHA256
_ -> String -> Action SHA256
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Action SHA256) -> String -> Action SHA256
forall a b. (a -> b) -> a -> b
$ String
"Failed to parse output from nix-prefetch-git: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> NixExpr -> String
T.unpack (ByteString -> NixExpr
T.decodeUtf8 ByteString
out)
  FetchUrl {NixExpr
PrefetchResult 'Fresh
sha256 :: PrefetchResult 'Fresh
furl :: NixExpr
furl :: forall (k :: Prefetch). NixFetcher k -> NixExpr
sha256 :: forall (k :: Prefetch). NixFetcher k -> PrefetchResult k
..} -> do
    (CmdTime Double
t, Stdout (ByteString -> NixExpr
T.decodeUtf8 -> NixExpr
out), CmdLine String
c) <- [CmdOption]
-> String
-> [String]
-> Action (CmdTime, Stdout ByteString, CmdLine)
forall r.
(Partial, CmdResult r) =>
[CmdOption] -> String -> [String] -> Action r
command [Bool -> CmdOption
EchoStderr Bool
False] String
"nix-prefetch-url" [NixExpr -> String
T.unpack NixExpr
furl]
    String -> Action ()
putInfo (String -> Action ()) -> String -> Action ()
forall a b. (a -> b) -> a -> b
$ String
"Finishing running " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
c String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
", took " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Double -> String
forall a. Show a => a -> String
show Double
t String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"s"
    case (NixExpr -> Bool) -> [NixExpr] -> [NixExpr]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not (Bool -> Bool) -> (NixExpr -> Bool) -> NixExpr -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NixExpr -> Bool
T.null) ([NixExpr] -> [NixExpr]) -> [NixExpr] -> [NixExpr]
forall a b. (a -> b) -> a -> b
$ [NixExpr] -> [NixExpr]
forall a. [a] -> [a]
reverse ([NixExpr] -> [NixExpr]) -> [NixExpr] -> [NixExpr]
forall a b. (a -> b) -> a -> b
$ NixExpr -> [NixExpr]
T.lines NixExpr
out of
      [NixExpr
x] -> SHA256 -> Action SHA256
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SHA256 -> Action SHA256) -> SHA256 -> Action SHA256
forall a b. (a -> b) -> a -> b
$ NixExpr -> SHA256
coerce NixExpr
x
      [NixExpr]
_ -> String -> Action SHA256
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Action SHA256) -> String -> Action SHA256
forall a b. (a -> b) -> a -> b
$ String
"Failed to parse output from nix-prefetch-url: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> NixExpr -> String
T.unpack NixExpr
out

buildNixFetcher :: Text -> NixFetcher k -> Text
buildNixFetcher :: NixExpr -> NixFetcher k -> NixExpr
buildNixFetcher NixExpr
sha256 = \case
  FetchGit
    { sha256 :: forall (k :: Prefetch). NixFetcher k -> PrefetchResult k
sha256 = PrefetchResult k
_,
      rev :: forall (k :: Prefetch). NixFetcher k -> Version
rev = Version -> NixExpr
forall a. ToNixExpr a => a -> NixExpr
toNixExpr -> NixExpr
rev,
      fetchSubmodules :: forall (k :: Prefetch). NixFetcher k -> Bool
fetchSubmodules = Bool -> NixExpr
forall a. ToNixExpr a => a -> NixExpr
toNixExpr -> NixExpr
fetchSubmodules,
      deepClone :: forall (k :: Prefetch). NixFetcher k -> Bool
deepClone = Bool -> NixExpr
forall a. ToNixExpr a => a -> NixExpr
toNixExpr -> NixExpr
deepClone,
      leaveDotGit :: forall (k :: Prefetch). NixFetcher k -> Bool
leaveDotGit = Bool -> NixExpr
forall a. ToNixExpr a => a -> NixExpr
toNixExpr -> NixExpr
leaveDotGit,
      Maybe NixExpr
NixExpr
branch :: Maybe NixExpr
furl :: NixExpr
branch :: forall (k :: Prefetch). NixFetcher k -> Maybe NixExpr
furl :: forall (k :: Prefetch). NixFetcher k -> NixExpr
..
    } ->
      [trimming|
          fetchgit {
            url = "$furl";
            rev = "$rev";
            fetchSubmodules = $fetchSubmodules;
            deepClone = $deepClone;
            leaveDotGit = $leaveDotGit;
            sha256 = $sha256;
          }
    |]
  (FetchUrl NixExpr
url PrefetchResult k
_) ->
    [trimming|
          fetchurl {
            sha256 = $sha256;
            url = "$url";
          }
    |]

pypiUrl :: Text -> Version -> Text
pypiUrl :: NixExpr -> Version -> NixExpr
pypiUrl NixExpr
pypi (Version -> NixExpr
coerce -> NixExpr
ver) =
  let h :: NixExpr
h = Char -> NixExpr -> NixExpr
T.cons (NixExpr -> Char
T.head NixExpr
pypi) NixExpr
""
   in [trimming|https://pypi.io/packages/source/$h/$pypi/$pypi-$ver.tar.gz|]

--------------------------------------------------------------------------------

-- | Rules of nix fetcher
prefetchRule :: Rules ()
prefetchRule :: Rules ()
prefetchRule = Rules (NixFetcher 'Fresh -> Action (NixFetcher 'Prefetched))
-> Rules ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Rules (NixFetcher 'Fresh -> Action (NixFetcher 'Prefetched))
 -> Rules ())
-> Rules (NixFetcher 'Fresh -> Action (NixFetcher 'Prefetched))
-> Rules ()
forall a b. (a -> b) -> a -> b
$
  (NixFetcher 'Fresh -> Action (NixFetcher 'Prefetched))
-> Rules (NixFetcher 'Fresh -> Action (NixFetcher 'Prefetched))
forall q a.
(RuleResult q ~ a, ShakeValue q, ShakeValue a, Partial) =>
(q -> Action a) -> Rules (q -> Action a)
addOracleCache ((NixFetcher 'Fresh -> Action (NixFetcher 'Prefetched))
 -> Rules (NixFetcher 'Fresh -> Action (NixFetcher 'Prefetched)))
-> (NixFetcher 'Fresh -> Action (NixFetcher 'Prefetched))
-> Rules (NixFetcher 'Fresh -> Action (NixFetcher 'Prefetched))
forall a b. (a -> b) -> a -> b
$ \(NixFetcher 'Fresh
f :: NixFetcher Fresh) -> do
    SHA256
sha256 <- NixFetcher 'Fresh -> Action SHA256
runFetcher NixFetcher 'Fresh
f
    NixFetcher 'Prefetched -> Action (NixFetcher 'Prefetched)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NixFetcher 'Prefetched -> Action (NixFetcher 'Prefetched))
-> NixFetcher 'Prefetched -> Action (NixFetcher 'Prefetched)
forall a b. (a -> b) -> a -> b
$ NixFetcher 'Fresh
f {sha256 :: PrefetchResult 'Prefetched
sha256 = PrefetchResult 'Prefetched
SHA256
sha256}

-- | Run nix fetcher
prefetch :: NixFetcher Fresh -> Action (NixFetcher Prefetched)
prefetch :: NixFetcher 'Fresh -> Action (NixFetcher 'Prefetched)
prefetch = NixFetcher 'Fresh -> Action (NixFetcher 'Prefetched)
forall q a.
(RuleResult q ~ a, ShakeValue q, ShakeValue a) =>
q -> Action a
askOracle

--------------------------------------------------------------------------------

-- | Create a fetcher from git url
gitFetcher :: Text -> PackageFetcher
gitFetcher :: NixExpr -> PackageFetcher
gitFetcher NixExpr
furl Version
rev = NixExpr
-> Version
-> Maybe NixExpr
-> Bool
-> Bool
-> Bool
-> PrefetchResult 'Fresh
-> NixFetcher 'Fresh
forall (k :: Prefetch).
NixExpr
-> Version
-> Maybe NixExpr
-> Bool
-> Bool
-> Bool
-> PrefetchResult k
-> NixFetcher k
FetchGit NixExpr
furl Version
rev Maybe NixExpr
forall a. Maybe a
Nothing Bool
False Bool
False Bool
False ()

-- | Create a fetcher from github repo
gitHubFetcher ::
  -- | owner and repo
  (Text, Text) ->
  PackageFetcher
gitHubFetcher :: (NixExpr, NixExpr) -> PackageFetcher
gitHubFetcher (NixExpr
owner, NixExpr
repo) = NixExpr -> PackageFetcher
gitFetcher [trimming|https://github.com/$owner/$repo|]

-- | Create a fetcher from pypi
pypiFetcher :: Text -> PackageFetcher
pypiFetcher :: NixExpr -> PackageFetcher
pypiFetcher NixExpr
p Version
v = NixExpr -> NixFetcher 'Fresh
urlFetcher (NixExpr -> NixFetcher 'Fresh) -> NixExpr -> NixFetcher 'Fresh
forall a b. (a -> b) -> a -> b
$ NixExpr -> Version -> NixExpr
pypiUrl NixExpr
p Version
v

-- | Create a fetcher from github release
gitHubReleaseFetcher ::
  -- | owner and repo
  (Text, Text) ->
  -- | file name
  Text ->
  PackageFetcher
gitHubReleaseFetcher :: (NixExpr, NixExpr) -> NixExpr -> PackageFetcher
gitHubReleaseFetcher (NixExpr
owner, NixExpr
repo) NixExpr
fp (Version -> NixExpr
coerce -> NixExpr
ver) =
  NixExpr -> NixFetcher 'Fresh
urlFetcher
    [trimming|https://github.com/$owner/$repo/releases/download/$ver/$fp|]

-- | Create a fetcher from url
urlFetcher :: Text -> NixFetcher Fresh
urlFetcher :: NixExpr -> NixFetcher 'Fresh
urlFetcher = (NixExpr -> () -> NixFetcher 'Fresh)
-> () -> NixExpr -> NixFetcher 'Fresh
forall a b c. (a -> b -> c) -> b -> a -> c
flip NixExpr -> () -> NixFetcher 'Fresh
forall (k :: Prefetch). NixExpr -> PrefetchResult k -> NixFetcher k
FetchUrl ()