Lens refactor

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,

src/Options.hs

@@ -1,52 +1,44 @@
+{-# 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
      deriving (Eq, Show)
 
 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])

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

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
 

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")