diff --git a/shellify.cabal b/shellify.cabal index 4f6869c..6c9af65 100644 --- a/shellify.cabal +++ b/shellify.cabal @@ -56,6 +56,7 @@ library directory >=1.3.6.2 && <1.4, extra >=1.7.13 && <1.9, HStringTemplate >=0.8.8 && <0.9, + lens >=5.1.1 && <5.2, mtl >=2.2.2 && <2.4, parsec >=3.1.15.0 && <3.2, shake >=0.19.7 && <0.20, diff --git a/src/Options.hs b/src/Options.hs index af74f91..b6483ed 100644 --- a/src/Options.hs +++ b/src/Options.hs @@ -1,27 +1,17 @@ +{-# LANGUAGE TemplateHaskell #-} module Options (Package(..), Options(..), OutputForm(..), def, Packages(Packages), options) where -import Prelude hiding (takeWhile, writeFile) import Constants import FlakeTemplate import ShellifyTemplate -import Control.Applicative ((<|>)) -import Control.Arrow ((+++)) -import Control.Monad (when) -import Data.Bool (bool) +import Control.Lens.Combinators (makeLenses, makePrisms, set, over, view) import Data.Default (Default(def)) -import Data.List (find, sort) +import Data.List (sort) import Data.Maybe (fromMaybe) -import Data.Text (isInfixOf, isPrefixOf, pack, replace, splitOn, stripPrefix, takeWhile, Text(), unpack) -import Data.Text.IO (hPutStrLn, writeFile) +import Data.Text (isPrefixOf, pack, Text()) import Data.Version (showVersion) -import qualified Data.Text.IO as Text -import GHC.IO.Exception (ExitCode(ExitSuccess, ExitFailure)) import Paths_shellify (version) -import System.Directory (doesPathExist) -import System.Exit (exitWith) -import System.IO (stderr) -import Text.StringTemplate (newSTMP, render, setAttribute, StringTemplate) data OutputForm = Traditional | Flake @@ -29,24 +19,26 @@ data OutputForm = Traditional newtype Packages = Packages [ Package ] deriving Show - type Package = Text instance Eq Packages where Packages a == Packages b = sort a == sort b -packageList = toPackageList . packages - where toPackageList (Packages p) = p +makePrisms ''Packages data Options = Options { - packages :: Packages - , command :: Maybe Text - , outputForm :: !OutputForm - , prioritiseLocalPinnedSystem :: Bool + _packages :: !Packages + , _command :: !(Maybe Text) + , _outputForm :: !OutputForm + , _prioritiseLocalPinnedSystem :: !Bool } deriving (Eq, Show) -data OptionsParser = OptionsParser [Text] -- remainingOptions - (Either Text (Options -> Options)) -- result +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 = @@ -71,9 +63,9 @@ options progName args = oldStyleOption "-p" = handlePackageSwitch oldStyleOption "--packages" = handlePackageSwitch oldStyleOption opt = baseOption opt - newStyleOption "-p" = returnError "-p not supported with new style commands" - newStyleOption "--packages" = returnError "--packages not supported with new style commands" - newStyleOption "--allow-local-pinned-registries-to-be-prioritized" = transformOptionsWith setPrioritiseLocalPinnedSystem + 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 @@ -84,22 +76,17 @@ options progName args = baseOption "--run" = handleCommandSwitch baseOption "--with-flake" = transformOptionsWith setFlakeGeneration baseOption _ = transformOptionsWith id - --doNothing = 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 (setCommand hd) tl + = transformOptionsWith (set Options.command (Just hd)) tl handleCommandSwitch [] = returnError "Argument missing to switch" [] - appendPackages ps opts = opts{ - packages = Packages (ps ++ packageList opts) - } - setCommand cmd opts = opts{command=Just cmd} - setFlakeGeneration opts = opts{outputForm=Flake} - setPrioritiseLocalPinnedSystem opts = opts {prioritiseLocalPinnedSystem=True} + appendPackages = over (packages. _Packages) . (++) + setFlakeGeneration = set outputForm Flake returnError errorText remaining = OptionsParser remaining $ Left errorText consumePackageArgs :: [Text] -> ([Package], [Text]) diff --git a/src/TemplateGeneration.hs b/src/TemplateGeneration.hs index 1574120..6f7bf16 100644 --- a/src/TemplateGeneration.hs +++ b/src/TemplateGeneration.hs @@ -17,7 +17,7 @@ import Text.ParserCombinators.Parsec (Parser, char, endBy, eof, many1, noneOf, p import Text.StringTemplate (newSTMP, render, setAttribute) generateFlakeText :: Text -> Options -> Maybe Text -generateFlakeText db Options{packages=Packages packages, outputForm=outputForm, prioritiseLocalPinnedSystem=prioritiseLocalPinnedSystem} = +generateFlakeText db Options{_packages=Packages packages, _outputForm=outputForm, _prioritiseLocalPinnedSystem=_prioritiseLocalPinnedSystem} = bool Nothing (Just $ render @@ -35,14 +35,14 @@ generateFlakeText db Options{packages=Packages packages, outputForm=outputForm, either (error . ("Unexpected output from nix registry call: " <>)) (fromMaybe "PLEASE ENTER input here") - . findFlakeRepoUrl prioritiseLocalPinnedSystem db $ repoName + . findFlakeRepoUrl _prioritiseLocalPinnedSystem db $ repoName pkgsVar = (<> "Pkgs") pkgsVars = pkgsVar <$> repos pkgsDecls = (\repo -> pkgsDecl (pkgsVar repo) repo) <$> repos shellArgs = (\(a,b) -> a <> "=" <> b <> ";") <$> zip repoVars pkgsVars generateShellDotNixText :: Options -> Text -generateShellDotNixText Options{packages=Packages packages, command=command} = +generateShellDotNixText Options{_packages=Packages packages, _command=command} = render $ setAttribute "build_inputs" pkgs $ setAttribute "parameters" parameters diff --git a/test/Spec.hs b/test/Spec.hs index 45d048a..b9532b2 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -30,10 +30,10 @@ main = hspec $ do it "should not support -p with shell" $ do shellifyWithArgs "shell -p cowsay" `shouldBe` - Left "-p not supported with new style commands" + Left "-p and --packages are not supported with new style commands" shellifyWithArgs "shell nixpkgs#python --packages foo nixpkgs#cowsay" `shouldBe` - Left "--packages not supported with new style commands" + Left "-p and --packages are not supported with new style commands" describe "When using the --command option" $ do @@ -45,17 +45,17 @@ main = hspec $ do it "allows a command to be specified with a package" $ theOptions "-p python --command cowsay" `shouldBe` - Right def{packages=Packages ["python"], command=Just "cowsay"} + Right def{_packages=Packages ["python"], _command=Just "cowsay"} it "allows a command to be specified before a package" $ theOptions "--run cowsay -p python" `shouldBe` - Right def{packages=Packages ["python"], command=Just "cowsay"} + Right def{_packages=Packages ["python"], _command=Just "cowsay"} it "allows a command to be specified before and after a package" $ theOptions "-p cowsay --command cowsay -p python" `shouldBe` - Right def{packages=Packages [ "cowsay", "python" ], command=Just "cowsay"} + Right def{_packages=Packages [ "cowsay", "python" ], _command=Just "cowsay"} it "fails if command has no argument" $ do shellifyWithArgs "--command -p python" @@ -96,7 +96,7 @@ main = hspec $ do it "supports new shell commands" $ theOptions "shell nixpkgs#python nixpkgs#cowsay" `shouldBe` - Right def{packages=Packages [ "nixpkgs#python", "nixpkgs#cowsay" ], outputForm=Flake} + Right def{_packages=Packages [ "nixpkgs#python", "nixpkgs#cowsay" ], _outputForm=Flake} describe "When dealing with multiple source repositories it should produce the correct output files for" $ do diff --git a/test/TestHelpers.hs b/test/TestHelpers.hs index 50fc151..8c2d00c 100644 --- a/test/TestHelpers.hs +++ b/test/TestHelpers.hs @@ -128,12 +128,12 @@ shouldResultInPackages :: Text -> [Text] -> Expectation shouldResultInPackages parameters packages = theOptions parameters `shouldBe` - Right def{packages=Packages packages} + Right def{_packages=Packages packages} theOptions = options "nix-shellify" . words readNixTemplate :: FilePath -> IO Text -readNixTemplate fileName = readFile ("test/outputs/" <> fileName) +readNixTemplate = readFile . ("test/outputs/" <>) flakeFile = (<> "-flake.nix") shellFile = (<> "-shell.nix")