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} =
  Maybe Text -> Maybe Text -> Bool -> Maybe Text
forall a. a -> a -> Bool -> a
bool
    Maybe Text
forall a. Maybe a
Nothing
    (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ StringTemplate Text -> Text
forall a. Stringable a => StringTemplate a -> a
render
          (StringTemplate Text -> Text) -> StringTemplate Text -> Text
forall a b. (a -> b) -> a -> b
$ String -> [Text] -> StringTemplate Text -> StringTemplate Text
forall a b.
(ToSElem a, Stringable b) =>
String -> a -> StringTemplate b -> StringTemplate b
setAttribute String
"repo_inputs" [Text]
repoInputs
          (StringTemplate Text -> StringTemplate Text)
-> StringTemplate Text -> StringTemplate Text
forall a b. (a -> b) -> a -> b
$ String -> [Text] -> StringTemplate Text -> StringTemplate Text
forall a b.
(ToSElem a, Stringable b) =>
String -> a -> StringTemplate b -> StringTemplate b
setAttribute String
"repos" [Text]
repos
          (StringTemplate Text -> StringTemplate Text)
-> StringTemplate Text -> StringTemplate Text
forall a b. (a -> b) -> a -> b
$ String -> [Text] -> StringTemplate Text -> StringTemplate Text
forall a b.
(ToSElem a, Stringable b) =>
String -> a -> StringTemplate b -> StringTemplate b
setAttribute String
"pkgs_decls" [Text]
pkgsDecls
          (StringTemplate Text -> StringTemplate Text)
-> StringTemplate Text -> StringTemplate Text
forall a b. (a -> b) -> a -> b
$ String -> [Text] -> StringTemplate Text -> StringTemplate Text
forall a b.
(ToSElem a, Stringable b) =>
String -> a -> StringTemplate b -> StringTemplate b
setAttribute String
"shell_args" [Text]
shellArgs
          (StringTemplate Text -> StringTemplate Text)
-> StringTemplate Text -> StringTemplate Text
forall a b. (a -> b) -> a -> b
$ String -> StringTemplate Text
forall a. Stringable a => String -> StringTemplate a
newSTMP String
flakeTemplate)
    Bool
shouldGenerateFlake
  where repos :: [Text]
repos = [Text] -> [Text]
forall a. Ord a => [a] -> [a]
uniq ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> Text
getPackageRepo (Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text] -> [Text]
forall a. Ord a => [a] -> [a]
sort [Text]
packages
        repoVars :: [Text]
repoVars = Text -> Text
forall {a}. (Eq a, IsString a) => a -> a
getPackageRepoVarName (Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
repos
        repoInputs :: [Text]
repoInputs = Text -> Text
repoInput (Text -> Text) -> [Text] -> [Text]
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 a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
".url = \"" a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
url a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
"\";"
        repoInput :: Text -> Text
repoInput Text
repoName = Text -> Text -> Text
forall {a}. (Semigroup a, IsString a) => a -> a -> a
repoInputLine Text
repoName (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
          (Text -> Text)
-> (Maybe Text -> Text) -> Either Text (Maybe Text) -> Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
            (String -> Text
forall a. Partial => String -> a
error String
"Unexpected output from nix registry call: " <>)
            (Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"PLEASE ENTER input here")
            (Either Text (Maybe Text) -> Text)
-> (Text -> Either Text (Maybe Text)) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Either Text (Maybe Text)
findFlakeRepoUrl Text
db (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text
repoName
        pkgsVar :: Text -> Text
pkgsVar = (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"Pkgs")
        pkgsVars :: [Text]
pkgsVars = Text -> Text
pkgsVar (Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
repos
        pkgsDecls :: [Text]
pkgsDecls = (\Text
repo -> Text -> Text -> Text
forall {a}. (Semigroup a, IsString a) => a -> a -> a
pkgsDecl (Text -> Text
pkgsVar Text
repo) Text
repo) (Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
repos
        shellArgs :: [Text]
shellArgs = (\(Text
a,Text
b) -> Text
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
";") ((Text, Text) -> Text) -> [(Text, Text)] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text] -> [Text] -> [(Text, Text)]
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} =
  StringTemplate Text -> Text
forall a. Stringable a => StringTemplate a -> a
render
  (StringTemplate Text -> Text) -> StringTemplate Text -> Text
forall a b. (a -> b) -> a -> b
$ String -> [Text] -> StringTemplate Text -> StringTemplate Text
forall a b.
(ToSElem a, Stringable b) =>
String -> a -> StringTemplate b -> StringTemplate b
setAttribute String
"build_inputs" [Text]
pkgs
  (StringTemplate Text -> StringTemplate Text)
-> StringTemplate Text -> StringTemplate Text
forall a b. (a -> b) -> a -> b
$ String -> [Text] -> StringTemplate Text -> StringTemplate Text
forall a b.
(ToSElem a, Stringable b) =>
String -> a -> StringTemplate b -> StringTemplate b
setAttribute String
"parameters" [Text]
parameters
  (StringTemplate Text -> StringTemplate Text)
-> StringTemplate Text -> StringTemplate Text
forall a b. (a -> b) -> a -> b
$ (StringTemplate Text -> StringTemplate Text)
-> (Text -> StringTemplate Text -> StringTemplate Text)
-> Maybe Text
-> StringTemplate Text
-> StringTemplate Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe StringTemplate Text -> StringTemplate Text
forall a. a -> a
id
          (String -> Text -> StringTemplate Text -> StringTemplate Text
forall a b.
(ToSElem a, Stringable b) =>
String -> a -> StringTemplate b -> StringTemplate b
setAttribute String
"shell_hook")
          Maybe Text
command
  (StringTemplate Text -> StringTemplate Text)
-> StringTemplate Text -> StringTemplate Text
forall a b. (a -> b) -> a -> b
$ String -> StringTemplate Text
forall a. Stringable a => String -> StringTemplate a
newSTMP String
shellifyTemplate
  where pkgs :: [Text]
pkgs = Text -> Text
generateBuildInput (Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text] -> [Text]
forall a. Ord a => [a] -> [a]
sort [Text]
packages
        parameters :: [Text]
parameters = [Text] -> [Text]
forall a. Ord a => [a] -> [a]
uniq ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> Text
generateParameters (Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text] -> [Text]
forall a. Ord a => [a] -> [a]
sort [Text]
packages
        generateBuildInput :: Text -> Text
generateBuildInput Text
input = (Text -> Text
forall {a}. (Eq a, IsString a) => a -> a
toImportVar (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
getPackageRepo) Text
input Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> 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
                        = [Text] -> Text
forall a. Partial => [a] -> a
head ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Partial => Text -> Text -> [Text]
Text -> Text -> [Text]
splitOn Text
"#" Text
input
                     | Bool
otherwise
                        = Text
"nixpkgs"

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

toImportVar :: a -> a
toImportVar a
var | a
var a -> a -> Bool
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 = Set a -> [a]
forall a. Set a -> [a]
toList (Set a -> [a]) -> ([a] -> Set a) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Set a
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) <- String -> IO (Stdout String, Stderr String, Exit)
forall args r. (Partial, CmdArguments args) => args
cmd
          (String
"nix --extra-experimental-features nix-command --extra-experimental-features flakes registry list" :: String)
        Either Text Text -> IO (Either Text Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text Text -> IO (Either Text Text))
-> Either Text Text -> IO (Either Text Text)
forall a b. (a -> b) -> a -> b
$ Either Text Text -> Either Text Text -> Bool -> Either Text Text
forall a. a -> a -> Bool -> a
bool (Text -> Either Text Text
forall a b. a -> Either a b
Left (Text -> Either Text Text) -> Text -> Either Text Text
forall a b. (a -> b) -> a -> b
$ String -> Text
pack String
err)
                      (Text -> Either Text Text
forall a b. b -> Either a b
Right (Text -> Either Text Text) -> Text -> Either Text Text
forall a b. (a -> b) -> a -> b
$ String -> Text
pack String
out)
                      (ExitCode
ex ExitCode -> ExitCode -> Bool
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 =
       (FlakeRepo -> Text) -> Maybe FlakeRepo -> Maybe Text
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FlakeRepo -> Text
repoUrl (Maybe FlakeRepo -> Maybe Text)
-> ([Maybe FlakeRepo] -> Maybe FlakeRepo)
-> [Maybe FlakeRepo]
-> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FlakeRepo -> Bool) -> [FlakeRepo] -> Maybe FlakeRepo
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((Text
needle ==) (Text -> Bool) -> (FlakeRepo -> Text) -> FlakeRepo -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FlakeRepo -> Text
repoName) ([FlakeRepo] -> Maybe FlakeRepo)
-> ([Maybe FlakeRepo] -> [FlakeRepo])
-> [Maybe FlakeRepo]
-> Maybe FlakeRepo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe FlakeRepo] -> [FlakeRepo]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe FlakeRepo] -> Maybe Text)
-> Either Text [Maybe FlakeRepo] -> Either Text (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Either Text (Maybe FlakeRepo))
-> [Text] -> Either Text [Maybe FlakeRepo]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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 = Either Text Text
-> (Text -> Either Text Text) -> Maybe Text -> Either Text Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> Either Text Text
forall a b. a -> Either a b
Left Text
"unexepected nix registry command format")
                                              Text -> Either Text Text
forall a b. b -> Either a b
Right
                                        (Maybe Text -> Either Text Text)
-> (Int -> Maybe Text) -> Int -> Either Text Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Int -> Maybe Text
forall a. [a] -> Int -> Maybe a
(!?) (Partial => Text -> Text -> [Text]
Text -> Text -> [Text]
splitOn Text
" " Text
line)
                        urlField :: Either Text Text
urlField = Int -> Either Text Text
expectedField Int
2
                        splitRepoField :: Either Text [Text]
splitRepoField = Partial => Text -> Text -> [Text]
Text -> Text -> [Text]
splitOn Text
":" (Text -> [Text]) -> Either Text Text -> Either Text [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] = a -> Maybe a
forall a. a -> Maybe a
Just a
b
                        potentialFlakeName [a]
_ = Maybe a
forall a. Maybe a
Nothing
                        f :: [Text] -> Text -> Maybe FlakeRepo
f [Text]
x Text
y = (Text -> Text -> FlakeRepo
`FlakeRepo` Text
y) (Text -> FlakeRepo) -> Maybe Text -> Maybe FlakeRepo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text] -> Maybe Text
forall {a}. (Eq a, IsString a) => [a] -> Maybe a
potentialFlakeName [Text]
x
                     in [Text] -> Text -> Maybe FlakeRepo
f ([Text] -> Text -> Maybe FlakeRepo)
-> Either Text [Text] -> Either Text (Text -> Maybe FlakeRepo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either Text [Text]
splitRepoField Either Text (Text -> Maybe FlakeRepo)
-> Either Text Text -> Either Text (Maybe FlakeRepo)
forall a b. Either Text (a -> b) -> Either Text a -> Either Text b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Either Text Text
urlField