diff --git a/app/Main.hs b/app/Main.hs index b4e97be..97c9e81 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -1,13 +1,13 @@ module Main where -import Data.Text (pack) -import Shellify (runShellify) -import System.Environment (getArgs, getProgName) +import Shellify (runShellify, printErrorAndReturnFailure) +import System.Environment (getArgs) +import Options(parseCommandLine) +import Options.Applicative (handleParseResult) +import Control.Monad ((>=>)) main :: IO () -main = do - progName <- pack <$> getProgName - getTextArgs - >>= runShellify . (<>) [progName] - -getTextArgs = fmap pack <$> getArgs +main = getArgs >>= + either printErrorAndReturnFailure + (handleParseResult >=> runShellify ) + . parseCommandLine \ No newline at end of file diff --git a/flake.lock b/flake.lock index f71f9e3..dd02916 100644 --- a/flake.lock +++ b/flake.lock @@ -2,11 +2,11 @@ "nodes": { "nixpkgs": { "locked": { - "lastModified": 1689444953, - "narHash": "sha256-0o56bfb2LC38wrinPdCGLDScd77LVcr7CrH1zK7qvDg=", + "lastModified": 1741513245, + "narHash": "sha256-7rTAMNTY1xoBwz0h7ZMtEcd8LELk9R5TzBPoHuhNSCk=", "owner": "NixOS", "repo": "nixpkgs", - "rev": "8acef304efe70152463a6399f73e636bcc363813", + "rev": "e3e32b642a31e6714ec1b712de8c91a3352ce7e1", "type": "github" }, "original": { diff --git a/shellify.cabal b/shellify.cabal index fb5225b..fdaad32 100644 --- a/shellify.cabal +++ b/shellify.cabal @@ -29,6 +29,7 @@ common deps default-language: GHC2021 build-depends: base >=4.16 && <4.21, + optparse-applicative >=0.18.1.0 && <0.19, raw-strings-qq >=1.1 && <1.2, text >=1.2.5.0 && <2.2 @@ -54,7 +55,6 @@ library containers >=0.6.5.1 && <0.8, data-default >=0.7 && <0.9, directory >=1.3.6.2 && <1.4, - extra >=1.7.13 && <1.9, HStringTemplate >=0.8.8 && <0.9, lens >=5.1.1 && <5.4, mtl >=2.2.2 && <2.4, @@ -65,7 +65,7 @@ library executable nix-shellify import: deps main-is: Main.hs - build-depends: + build-depends: shellify >=0 hs-source-dirs: app @@ -81,6 +81,8 @@ test-suite haskelltest-test Paths_shellify ghc-options: -threaded -rtsopts -with-rtsopts=-N build-depends: + data-default >=0.7 && <0.9, + extra >=1.7.16 && <1.8, hspec >=2.9.7 && <2.12, hspec-core >=2.9.7 && <2.12, shellify >=0 diff --git a/src/Constants.hs b/src/Constants.hs index 412ddc7..cf5fe30 100644 --- a/src/Constants.hs +++ b/src/Constants.hs @@ -3,37 +3,12 @@ module Constants where import Data.Text (Text()) import Text.RawString.QQ (r) -helpText :: Text -> Text -helpText progName = "USAGE: " <> progName <> [r| -p [PACKAGES] [--with-flakes] - |] <> progName <> [r| shell [PACKAGES] - -Pass nix-shell arguments to nix-shellify to have it generate a shell.nix in -the current directory. You can then just run nix develop or nix-shell in that -directory to have those packages in your environment. To run nix commands -you must first install Nix. - -Options - - -p / --packages - Specify packages for nix-shell compatability - - --command / --run - Command to run after creating the shell - - --with-flake - When using the -p option to specify packages, use this switch to have a - flake.nix created in addition to a shell.nix. This is recommended to ensure - the versions of dependencies are kept for reproducibility and so that - shells are cached to load faster. - - --allow-local-pinned-registries-to-be-prioritized - Pinned local repoisitory URLs are usually taken last when looking for URLs for - generated flake.nix files. This is usually desired. If you do however want - to see these pinned entries in the flake file as specified in your registry, - then set this flag. - - --version - Show the version number +hlDesc :: String +hlDesc = [r| + Pass nix-shell arguments to nix-shellify to have it generate a shell.nix in + the current directory. You can then just run nix develop or nix-shell in that + directory to have those packages in your environment. To run nix commands + you must first install Nix. |] noPackagesError = [r|I can't write out a shell file without any packages specified. diff --git a/src/Options.hs b/src/Options.hs index b6483ed..4051fcd 100644 --- a/src/Options.hs +++ b/src/Options.hs @@ -1,17 +1,19 @@ {-# LANGUAGE TemplateHaskell #-} -module Options (Package(..), Options(..), OutputForm(..), def, Packages(Packages), options) where +module Options (Options(..), OutputForm(..), Package(..), Packages(Packages), parseCommandLine) where import Constants import FlakeTemplate import ShellifyTemplate -import Control.Lens.Combinators (makeLenses, makePrisms, set, over, view) +import Control.Lens.Combinators (makeLenses, makePrisms) import Data.Default (Default(def)) -import Data.List (sort) -import Data.Maybe (fromMaybe) -import Data.Text (isPrefixOf, pack, Text()) +import Data.List (isPrefixOf, sort) +import Data.Maybe (fromMaybe, isJust) +import Data.Text (pack, Text(), unpack) import Data.Version (showVersion) +import Options.Applicative ((<**>), Parser, ParserResult(Success, Failure, CompletionInvoked), argument, command, defaultPrefs, execParserPure, fullDesc, header, help, helper, hidden, info, long, metavar, option, optional, progDesc, short, simpleVersioner, some, str, strOption, switch) import Paths_shellify (version) +import System.Environment (getArgs) data OutputForm = Traditional | Flake @@ -26,6 +28,42 @@ instance Eq Packages where makePrisms ''Packages +opts = info (commandParser <**> simpleVersioner (showVersion version) + <**> helper) $ + fullDesc + <> progDesc hlDesc + <> header "Quickly generate shell.nix files once you have a working shell" + +commandParser :: Parser CommandLineOptions +commandParser = CommandLineOptions + <$> optional (some (option str ( + long "packages" + <> short 'p' + <> metavar "PACKAGE" + <> help "Packages to install in the shell.nix file. This option can be used multiple times to specify multiple packages" + ))) + <*> optional (option str ( + long "command" + <> long "run" + <> short 'c' + <> metavar "COMMAND" + <> help "Command to run on initial shell startup" + )) + <*> switch ( + long "with-flake" + <> help "When using the -p option to specify packages, use this switch to have a flake.nix created in addition to a shell.nix. This is recommended to ensure the versions of dependencies are kept for reproducibility and so that shells are cached to load faster." + ) + <*> switch ( + long "allow-local-pinned-registries-to-be-prioritized" + <> help "Pinned local repoisitory URLs are usually taken last when looking for URLs for generated flake.nix files. This is usually desired. If you do however want to see these pinned entries in the flake file as specified in your registry, then set this flag." + ) + <*> optional (some (option str ( + long "arg" + <> long "argstr" + <> hidden + ))) + <*> optional (some (argument str (metavar "shell PACKAGES..."))) + data Options = Options { _packages :: !Packages , _command :: !(Maybe Text) @@ -33,75 +71,56 @@ data Options = Options { , _prioritiseLocalPinnedSystem :: !Bool } deriving (Eq, Show) -makeLenses ''Options - -packageList = view (packages . _Packages) - -data OptionsParser = OptionsParser [Text] -- | remainingOptions - (Either Text (Options -> Options)) -- | result - -options :: Text -> [Text] -> Either Text Options -options progName args = - let optionsHandler | hasShellArg args = newStyleOption - | otherwise = oldStyleOption - shellArgFilter | hasShellArg args = filter (/= "shell") - | otherwise = id - optionsCaller f = worker - where worker (OptionsParser [] t) = t - worker (OptionsParser (hd:tl) res) = - let (OptionsParser newRemaining newRes) = f hd tl - in worker $ OptionsParser newRemaining ((.) <$> newRes <*> res) - - screenForNoPackages (Right opts) | null (packageList opts) = Left noPackagesError - screenForNoPackages anyThingElse = anyThingElse - initialArgumentsToParse = shellArgFilter args - initialModifier = Right $ if hasShellArg args then setFlakeGeneration else id - initialOptionParser = OptionsParser initialArgumentsToParse initialModifier - in screenForNoPackages $ ($ def) <$> optionsCaller optionsHandler initialOptionParser +data CommandLineOptions = CommandLineOptions { + __packages :: !(Maybe [Text]) + , __command :: !(Maybe Text) + , __withFlake :: !Bool + , __prioritiseLocalPinnedSystem :: Bool + , __discard :: !(Maybe [String]) + , __shellPackages :: Maybe [Package] +} deriving (Show) - where oldStyleOption :: Text -> [Text] -> OptionsParser - oldStyleOption "-p" = handlePackageSwitch - oldStyleOption "--packages" = handlePackageSwitch - oldStyleOption opt = baseOption opt - newStyleOption "-p" = returnError "-p and --packages are not supported with new style commands" - newStyleOption "--packages" = returnError "-p and --packages are not supported with new style commands" - newStyleOption "--allow-local-pinned-registries-to-be-prioritized" = transformOptionsWith $ set prioritiseLocalPinnedSystem True - newStyleOption arg | isSwitch arg = baseOption arg - | otherwise = transformOptionsWith $ appendPackages [arg] - baseOption :: Text -> [Text] -> OptionsParser - baseOption "-h" = returnError $ helpText progName - baseOption "--help" = returnError $ helpText progName - baseOption "--version" = returnError $ "Shellify " <> pack ( showVersion version) - baseOption "--command" = handleCommandSwitch - baseOption "--run" = handleCommandSwitch - baseOption "--with-flake" = transformOptionsWith setFlakeGeneration - baseOption _ = transformOptionsWith id - transformOptionsWith fun wds = OptionsParser wds (Right fun) - handlePackageSwitch wds = let (pkgs, remainingOptions) = consumePackageArgs wds - in transformOptionsWith (appendPackages pkgs) remainingOptions - handleCommandSwitch (hd:tl) | isSwitch hd - = returnError "Argument missing to switch" tl - | otherwise - = transformOptionsWith (set Options.command (Just hd)) tl - handleCommandSwitch [] = returnError "Argument missing to switch" [] - - appendPackages = over (packages. _Packages) . (++) - setFlakeGeneration = set outputForm Flake - returnError errorText remaining = OptionsParser remaining $ Left errorText - -consumePackageArgs :: [Text] -> ([Package], [Text]) -consumePackageArgs = worker [] - where worker pkgs [] = (pkgs, []) - worker pkgs options@(hd:_) | isSwitch hd - = (pkgs, options) - worker pkgs (hd:tl) = worker (hd:pkgs) tl - -hasShellArg [] = False -hasShellArg ("shell":_) = True -hasShellArg (hd:tl) | isSwitch hd = hasShellArg tl - | otherwise = False - -isSwitch = isPrefixOf "-" +makeLenses ''Options instance Default Options where - def = Options (Packages []) Nothing Traditional False + def = Options{ + _packages = Packages [], + _command = Nothing, + _outputForm = Traditional, + _prioritiseLocalPinnedSystem = False + } + +parseCommandLine :: [String] -> Either Text (ParserResult Options) +parseCommandLine = + (\case + Success res -> fmap Success (parseCommandLineOptions res) + Failure failure -> Right $ Failure failure + CompletionInvoked f -> Right $ CompletionInvoked f) + . execParserPure defaultPrefs opts . fixupRequest + where parseCommandLineOptions :: CommandLineOptions -> Either Text Options + parseCommandLineOptions originalParsedOptions = + let transformedOptions = + (Options <$> Packages . ((++) <$> fromMaybe [] . __packages + <*> shellArgs . __shellPackages) + <*> __command + <*> \case + f | __withFlake f -> Flake + | (hasShellArg . __shellPackages) f -> Flake + _ | otherwise -> Traditional + <*> __prioritiseLocalPinnedSystem) originalParsedOptions + + in if _packages transformedOptions == Packages [] then + Left noPackagesError + else + Right transformedOptions + where hasShellArg (Just ("shell":_)) = True + hasShellArg _ = False + shellArgs (Just ("shell": rst)) = rst + shellArgs _ = [] + fixupRequest (a : b : c : d) | (a == "-p" || a == "--packages") + && isNotASwitch b + && isNotASwitch c = + a : b : fixupRequest ("-p" : c : d) + where isNotASwitch = not . isPrefixOf "-" + fixupRequest (a : b) = a : fixupRequest b + fixupRequest [] = [] diff --git a/src/Shellify.hs b/src/Shellify.hs index 8c84a8d..a06021d 100644 --- a/src/Shellify.hs +++ b/src/Shellify.hs @@ -1,6 +1,6 @@ -module Shellify (parseOptionsAndCalculateExpectedFiles, runShellify) where +module Shellify (printErrorAndReturnFailure, runShellify, calculateExpectedFiles) where -import Prelude hiding (writeFile) +import Prelude hiding (readFile, writeFile) import Constants import FlakeTemplate import Options @@ -9,49 +9,44 @@ import TemplateGeneration import Control.Monad (when, (>=>)) import Data.Bool (bool) +import Data.Maybe (isNothing) import Data.Text (pack, Text(), unpack) -import Data.Text.IO (hPutStrLn, writeFile) -import qualified Data.Text.IO as Text +import Data.Text.IO (hPutStrLn, readFile, writeFile) import GHC.IO.Exception (ExitCode(ExitSuccess, ExitFailure)) import System.Directory (doesPathExist) import System.Exit (exitWith) import System.IO (stderr) +runShellify :: Options -> IO () +runShellify opts = + getRegistryDB >>= + either + (printErrorAndReturnFailure . ("Error calling nix registry: " <>)) + (mapM_ createAFile . (`calculateExpectedFiles` opts)) + +createAFile :: (Text, Text) -> IO () createAFile (name, content) = do extCde <- createFile (unpack name) content when (extCde /= ExitSuccess) $ exitWith extCde - -runShellify :: [Text] -> IO () -runShellify(pName:args) = getRegistryDB - >>= either - (printErrorAndReturnFailure . ("Error calling nix registry: " <>)) - (\registryDB -> either printErrorAndReturnFailure - (mapM_ createAFile) - $ parseOptionsAndCalculateExpectedFiles registryDB pName args) - - -parseOptionsAndCalculateExpectedFiles :: Text -> Text -> [Text] -> Either Text [(Text,Text)] -parseOptionsAndCalculateExpectedFiles registry programName = - fmap - (\opts -> - ("shell.nix", generateShellDotNixText opts) + where createFile :: FilePath -> Text -> IO ExitCode + createFile fileName expectedContents = do + fileContents <- doesPathExist fileName + >>= bool + (return Nothing) + (Just <$> readFile fileName) + printError $ actionDescription (pack fileName) expectedContents fileContents + when (isNothing fileContents) + $ writeFile fileName expectedContents + return $ returnCode expectedContents fileContents + +calculateExpectedFiles :: Text -> Options -> [(Text,Text)] +calculateExpectedFiles registry options = + ("shell.nix", generateShellDotNixText options) : maybe [] (pure . ("flake.nix",)) - (generateFlakeText registry opts)) - . options programName - -createFile :: FilePath -> Text -> IO ExitCode -createFile fileName expectedContents = do - fileContents <- doesPathExist fileName - >>= bool - (return Nothing) - (Just <$> Text.readFile fileName) - printError $ actionDescription (pack fileName) expectedContents fileContents - when (shouldGenerateNewFile fileContents) - $ writeFile fileName expectedContents - return $ returnCode expectedContents fileContents + (generateFlakeText registry options) actionDescription :: Text -> Text -> Maybe Text -> Text actionDescription fName _ Nothing = fName <> " does not exist. Creating one" @@ -63,9 +58,5 @@ returnCode _ Nothing = ExitSuccess returnCode a (Just b) | a == b = ExitSuccess returnCode _ _ = ExitFailure 1 -shouldGenerateNewFile :: Maybe Text -> Bool -shouldGenerateNewFile = (== Nothing) - printErrorAndReturnFailure err = printError err >> exitWith (ExitFailure 1) printError = hPutStrLn stderr - diff --git a/test/Spec.hs b/test/Spec.hs index b9532b2..ba6ac96 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -1,9 +1,9 @@ +import Data.Default (Default(def)) import Test.Hspec (describe, hspec, it, shouldBe, specify) import Options import TestHelpers - main = hspec $ do describe "When passing option combinations" $ do @@ -18,22 +18,9 @@ main = hspec $ do `shouldReturnSubstring` "without any packages specified" - it "shows help text when requested" $ do - shellifyWithArgs "-h" - `shouldReturnSubstring` "USAGE:" - shellifyWithArgs "--help" - `shouldReturnSubstring` "USAGE:" it "shows the version number when requested" $ do shellifyWithArgs "--version" - `shouldReturnSubstring` "Shellify 0." - - it "should not support -p with shell" $ do - shellifyWithArgs "shell -p cowsay" - `shouldBe` - Left "-p and --packages are not supported with new style commands" - shellifyWithArgs "shell nixpkgs#python --packages foo nixpkgs#cowsay" - `shouldBe` - Left "-p and --packages are not supported with new style commands" + `shouldReturnSubstring` "0." describe "When using the --command option" $ do @@ -57,11 +44,9 @@ main = hspec $ do `shouldBe` Right def{_packages=Packages [ "cowsay", "python" ], _command=Just "cowsay"} - it "fails if command has no argument" $ do - shellifyWithArgs "--command -p python" - `shouldReturnSubstring` "Argument missing to switch" + it "fails if command has no argument" $ shellifyWithArgs "--command" - `shouldReturnSubstring` "Argument missing to switch" + `shouldReturnSubstring` "expects an argument" it "supports specifying one program to install after other arguments" $ "foo -p python" @@ -84,7 +69,7 @@ main = hspec $ do [ "python", "cowsay" ] it "supports separated -p switches" $ - "-p cowsay --foo -p python" + "-p cowsay --arg 4 cowsay -p python" `shouldResultInPackages` [ "cowsay", "python" ] @@ -98,6 +83,11 @@ main = hspec $ do `shouldBe` Right def{_packages=Packages [ "nixpkgs#python", "nixpkgs#cowsay" ], _outputForm=Flake} + it "supports the --with-flake option" $ + theOptions "--with-flake -p python -p cowsay" + `shouldBe` + Right def{_packages=Packages [ "python", "cowsay" ], _outputForm=Flake} + describe "When dealing with multiple source repositories it should produce the correct output files for" $ do specify "one buildInput required from an unknown source" $ @@ -176,4 +166,3 @@ main = hspec $ do whereOnlyAGlobalNixpkgsExistsShellifyWithArgs "shell nixpkgs#cowsay" `shouldReturnShellAndFlakeTextDefinedBy` "cowsay-from-global-nixpkgs" - diff --git a/test/TestHelpers.hs b/test/TestHelpers.hs index 8c2d00c..a457366 100644 --- a/test/TestHelpers.hs +++ b/test/TestHelpers.hs @@ -1,13 +1,21 @@ module TestHelpers where import Prelude hiding (readFile, unlines, words) -import Data.Text (Text(), unpack, unlines, words) +import Control.Monad ((>=>)) +import Data.Default (Default(def)) +import Data.Text (Text(), pack, unpack, unlines, words) import Data.Text.IO (readFile) +import Data.Tuple.Extra (fst3) import Test.Hspec (Expectation(), expectationFailure, shouldBe, shouldContain) -import Options -import Shellify -import TemplateGeneration +import Options.Applicative (ParserResult(Success, Failure, CompletionInvoked), ParserFailure (ParserFailure)) +import Options.Applicative.Help.Pretty (prettyString) +import Options.Applicative.Help.Types (ParserHelp(helpError)) +import Options.Applicative.Extra (ParserFailure(execFailure)) +import Options (Options(..), Packages(Packages), parseCommandLine) +import Shellify ( calculateExpectedFiles ) + +shouldReturnSubstring :: Either Text b -> [Char] -> Expectation shouldReturnSubstring shellifyOutput expectedSubstring = either ((`shouldContain` expectedSubstring) . unpack) @@ -17,6 +25,7 @@ shouldReturnSubstring shellifyOutput expectedSubstring = shellifyWithArgs :: Text -> Either Text [(Text, Text)] shellifyWithArgs = shellifyWithArgsWithDb realDbExample +realDbExample :: [Text] realDbExample = [ "global flake:agda github:agda/agda" , "global flake:arion github:hercules-ci/arion" @@ -56,7 +65,25 @@ realDbExample = ] shellifyWithArgsWithDb :: [Text] -> Text -> Either Text [(Text, Text)] -shellifyWithArgsWithDb customDb = parseOptionsAndCalculateExpectedFiles (unlines customDb) "nix-shellify" . words +shellifyWithArgsWithDb customDb = + parsedOptions >=> handleParse (calculateExpectedFiles (unlines customDb)) + + +theOptions :: Text -> Either Text Options +theOptions = either + Left + (handleParse id) + . parsedOptions + +parsedOptions :: Text -> Either Text (ParserResult Options) +parsedOptions = parseCommandLine . fmap unpack . words + +handleParse :: (t -> b) -> ParserResult t -> Either Text b +handleParse succF = \case + Success opts -> Right (succF opts) + Failure (ParserFailure help) -> + Left . ("parse Error: " <>) . pack . show . helpError . fst3 . help $ "" + CompletionInvoked _-> Left "completion invoked" whereAUserNixpkgsExistsShellifyWithArgs :: Text -> Either Text [(Text, Text)] whereAUserNixpkgsExistsShellifyWithArgs = shellifyWithArgsWithDb @@ -130,11 +157,10 @@ shouldResultInPackages parameters packages = `shouldBe` Right def{_packages=Packages packages} -theOptions = options "nix-shellify" . words - readNixTemplate :: FilePath -> IO Text readNixTemplate = readFile . ("test/outputs/" <>) +flakeFile :: FilePath -> FilePath flakeFile = (<> "-flake.nix") shellFile = (<> "-shell.nix")