module TemplateGeneration (generateShellDotNixText, generateFlakeText, getRegistryDB) where

import Prelude hiding (lines)

import Constants
import FlakeTemplate
import Options
import ShellifyTemplate

import Data.Bool (bool)
import Data.List (find, sort)
import Data.List.Extra ((!?))
import Data.Maybe (catMaybes, fromMaybe)
import Data.Set (fromList, toList)
import Data.Text (isInfixOf, isPrefixOf, lines, pack, splitOn, Text())
import Development.Shake.Command (cmd, Exit(Exit), Stderr(Stderr), Stdout(Stdout))
import System.Exit (ExitCode (ExitSuccess))
import Text.StringTemplate (newSTMP, render, setAttribute)

generateFlakeText :: Text -> Options -> Maybe Text
generateFlakeText :: Text -> Options -> Maybe Text
generateFlakeText Text
db Options{packages :: Options -> [Text]
packages=[Text]
packages, generateFlake :: Options -> Bool
generateFlake=Bool
shouldGenerateFlake} =
  forall a. a -> a -> Bool -> a
bool
    forall a. Maybe a
Nothing
    (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Stringable a => StringTemplate a -> a
render
          forall a b. (a -> b) -> a -> b
$ forall a b.
(ToSElem a, Stringable b) =>
String -> a -> StringTemplate b -> StringTemplate b
setAttribute String
"repo_inputs" [Text]
repoInputs
          forall a b. (a -> b) -> a -> b
$ forall a b.
(ToSElem a, Stringable b) =>
String -> a -> StringTemplate b -> StringTemplate b
setAttribute String
"repos" [Text]
repos
          forall a b. (a -> b) -> a -> b
$ forall a b.
(ToSElem a, Stringable b) =>
String -> a -> StringTemplate b -> StringTemplate b
setAttribute String
"pkgs_decls" [Text]
pkgsDecls
          forall a b. (a -> b) -> a -> b
$ forall a b.
(ToSElem a, Stringable b) =>
String -> a -> StringTemplate b -> StringTemplate b
setAttribute String
"shell_args" [Text]
shellArgs
          forall a b. (a -> b) -> a -> b
$ forall a. Stringable a => String -> StringTemplate a
newSTMP String
flakeTemplate)
    Bool
shouldGenerateFlake
  where repos :: [Text]
repos = forall a. Ord a => [a] -> [a]
uniq forall a b. (a -> b) -> a -> b
$ Text -> Text
getPackageRepo forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Ord a => [a] -> [a]
sort [Text]
packages
        repoVars :: [Text]
repoVars = forall {a}. (Eq a, IsString a) => a -> a
getPackageRepoVarName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
repos
        repoInputs :: [Text]
repoInputs = Text -> Text
repoInput forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
repos
        repoInputLine :: a -> a -> a
repoInputLine a
repoName a
url = a
repoName forall a. Semigroup a => a -> a -> a
<> a
".url = \"" forall a. Semigroup a => a -> a -> a
<> a
url forall a. Semigroup a => a -> a -> a
<> a
"\";"
        repoInput :: Text -> Text
repoInput Text
repoName = forall {a}. (Semigroup a, IsString a) => a -> a -> a
repoInputLine Text
repoName forall b c a. (b -> c) -> (a -> b) -> a -> c
.
          forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
            (forall a. Partial => String -> a
error String
"Unexpected output from nix registry call: " <>)
            (forall a. a -> Maybe a -> a
fromMaybe Text
"PLEASE ENTER input here")
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Either Text (Maybe Text)
findFlakeRepoUrl Text
db forall a b. (a -> b) -> a -> b
$ Text
repoName
        pkgsVar :: Text -> Text
pkgsVar = (forall a. Semigroup a => a -> a -> a
<> Text
"Pkgs")
        pkgsVars :: [Text]
pkgsVars = Text -> Text
pkgsVar forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
repos
        pkgsDecls :: [Text]
pkgsDecls = (\Text
repo -> forall {a}. (Semigroup a, IsString a) => a -> a -> a
pkgsDecl (Text -> Text
pkgsVar Text
repo) Text
repo) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
repos
        shellArgs :: [Text]
shellArgs = (\(Text
a,Text
b) -> Text
a forall a. Semigroup a => a -> a -> a
<> Text
"=" forall a. Semigroup a => a -> a -> a
<> Text
b forall a. Semigroup a => a -> a -> a
<> Text
";") forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. [a] -> [b] -> [(a, b)]
zip [Text]
repoVars [Text]
pkgsVars 

generateShellDotNixText :: Options -> Text
generateShellDotNixText :: Options -> Text
generateShellDotNixText Options{packages :: Options -> [Text]
packages=[Text]
packages, command :: Options -> Maybe Text
command=Maybe Text
command} =
  forall a. Stringable a => StringTemplate a -> a
render
  forall a b. (a -> b) -> a -> b
$ forall a b.
(ToSElem a, Stringable b) =>
String -> a -> StringTemplate b -> StringTemplate b
setAttribute String
"build_inputs" [Text]
pkgs
  forall a b. (a -> b) -> a -> b
$ forall a b.
(ToSElem a, Stringable b) =>
String -> a -> StringTemplate b -> StringTemplate b
setAttribute String
"parameters" [Text]
parameters
  forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id
          (forall a b.
(ToSElem a, Stringable b) =>
String -> a -> StringTemplate b -> StringTemplate b
setAttribute String
"shell_hook")
          Maybe Text
command
  forall a b. (a -> b) -> a -> b
$ forall a. Stringable a => String -> StringTemplate a
newSTMP String
shellifyTemplate
  where pkgs :: [Text]
pkgs = Text -> Text
generateBuildInput forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Ord a => [a] -> [a]
sort [Text]
packages
        parameters :: [Text]
parameters = forall a. Ord a => [a] -> [a]
uniq forall a b. (a -> b) -> a -> b
$ Text -> Text
generateParameters forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Ord a => [a] -> [a]
sort [Text]
packages
        generateBuildInput :: Text -> Text
generateBuildInput Text
input = (forall {a}. (Eq a, IsString a) => a -> a
toImportVar forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
getPackageRepo) Text
input forall a. Semigroup a => a -> a -> a
<> Text
"." forall a. Semigroup a => a -> a -> a
<> Text -> Text
getPackageName Text
input

getPackageRepo :: Text -> Text
getPackageRepo Text
input | Text
"#" Text -> Text -> Bool
`isInfixOf` Text
input
                        = forall a. [a] -> a
head forall a b. (a -> b) -> a -> b
$ Text -> Text -> [Text]
splitOn Text
"#" Text
input
                     | Bool
otherwise
                        = Text
"nixpkgs"

getPackageName :: Text -> Text
getPackageName Text
input | Text
"#" Text -> Text -> Bool
`isInfixOf` Text
input
                        = forall a. [a] -> a
head forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
tail forall a b. (a -> b) -> a -> b
$ Text -> Text -> [Text]
splitOn Text
"#" Text
input
                     | Bool
otherwise
                        = Text
input

toImportVar :: a -> a
toImportVar a
var | a
var forall a. Eq a => a -> a -> Bool
== a
"nixpkgs"
                  = a
"pkgs"
                | Bool
otherwise
                  = a
var

getPackageRepoVarName :: a -> a
getPackageRepoVarName a
"nixpkgs" = a
"pkgs"
getPackageRepoVarName a
a = a
a

generateParameters :: Package -> Text
generateParameters :: Text -> Text
generateParameters Text
package | Text
"#" Text -> Text -> Bool
`isInfixOf` Text
package
                           Bool -> Bool -> Bool
&& Bool -> Bool
not (Text
"nixpkgs#" Text -> Text -> Bool
`isPrefixOf` Text
package)
                           = Text -> Text
getPackageRepo Text
package
generateParameters Text
_ = Text
"pkgs ? import <nixpkgs> {}"

uniq :: Ord a => [a] -> [a]
uniq :: forall a. Ord a => [a] -> [a]
uniq = forall a. Set a -> [a]
toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> Set a
fromList

getRegistryDB :: IO (Either Text Text)
getRegistryDB :: IO (Either Text Text)
getRegistryDB =
     do (Stdout String
out, Stderr String
err, Exit ExitCode
ex) <- forall args r. (Partial, CmdArguments args) => args
cmd
          (String
"nix --extra-experimental-features nix-command --extra-experimental-features flakes registry list" :: String)
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> Bool -> a
bool (forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String -> Text
pack String
err)
                      (forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ String -> Text
pack String
out)
                      (ExitCode
ex forall a. Eq a => a -> a -> Bool
== ExitCode
ExitSuccess)

findFlakeRepoUrl :: Text -> Text -> Either Text (Maybe Text)
findFlakeRepoUrl :: Text -> Text -> Either Text (Maybe Text)
findFlakeRepoUrl Text
haystack Text
needle =
       forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FlakeRepo -> Text
repoUrl forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((Text
needle ==) forall b c a. (b -> c) -> (a -> b) -> a -> c
. FlakeRepo -> Text
repoName) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Maybe a] -> [a]
catMaybes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Text -> Either Text (Maybe FlakeRepo)
getFlakeRepo (Text -> [Text]
lines Text
haystack)

data FlakeRepo = FlakeRepo {
    FlakeRepo -> Text
repoName :: Text
  , FlakeRepo -> Text
repoUrl :: Text
}

getFlakeRepo :: Text -> Either Text (Maybe FlakeRepo)
getFlakeRepo :: Text -> Either Text (Maybe FlakeRepo)
getFlakeRepo Text
line = let expectedField :: Int -> Either Text Text
expectedField = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> Either a b
Left Text
"unexepected nix registry command format")
                                              forall a b. b -> Either a b
Right
                                        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Int -> Maybe a
(!?) (Text -> Text -> [Text]
splitOn Text
" " Text
line)
                        urlField :: Either Text Text
urlField = Int -> Either Text Text
expectedField Int
2
                        splitRepoField :: Either Text [Text]
splitRepoField = Text -> Text -> [Text]
splitOn Text
":" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Either Text Text
expectedField Int
1
                        potentialFlakeName :: [a] -> Maybe a
potentialFlakeName [a
"flake", a
b] = forall a. a -> Maybe a
Just a
b
                        potentialFlakeName [a]
_ = forall a. Maybe a
Nothing
                        f :: [Text] -> Text -> Maybe FlakeRepo
f [Text]
x Text
y = (Text -> Text -> FlakeRepo
`FlakeRepo` Text
y) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {a}. (Eq a, IsString a) => [a] -> Maybe a
potentialFlakeName [Text]
x
                     in [Text] -> Text -> Maybe FlakeRepo
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either Text [Text]
splitRepoField forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Either Text Text
urlField