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