Refactor codebase

src/Options.hs

@@ -1,32 +1,29 @@
 {-# LANGUAGE TemplateHaskell #-}
-module Options (Options(..), OutputForm(..), Package(..), Packages(Packages), parseCommandLine) where
+module Options (Options(..), OutputForm(..), Package(), Packages(Packages), parseCommandLine, setPackages) where
 
-import Constants
-import FlakeTemplate
-import ShellifyTemplate
+import Constants (hlDesc, noPackagesError)
 
 import Control.Lens.Combinators (makeLenses, makePrisms)
 import Data.Default (Default(def))
-import Data.List (isPrefixOf, sort)
-import Data.Maybe (fromMaybe, isJust)
-import Data.Text (pack, Text(), unpack)
+import Data.List (isPrefixOf)
+import Data.Maybe (fromMaybe)
+import Data.Set (Set(), fromList)
+import Data.Text (Text())
 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
      deriving (Eq, Show)
 
-newtype Packages = Packages [ Package ] deriving Show
+newtype Packages = Packages (Set Package)
+        deriving (Eq, Monoid, Semigroup, Show)
 
 type Package = Text
 
-instance Eq Packages where
-  Packages a == Packages b = sort a == sort b
-
 makePrisms ''Packages
+setPackages = Packages . fromList
 
 opts = info (commandParser <**> simpleVersioner (showVersion version)
                            <**> helper) $
@@ -83,8 +80,8 @@ data CommandLineOptions = CommandLineOptions {
 makeLenses ''Options
 
 instance Default Options where
-  def = Options{
-    _packages = Packages [],
+  def = Options {
+    _packages = mempty,
     _command = Nothing,
     _outputForm = Traditional,
     _prioritiseLocalPinnedSystem = False
@@ -99,21 +96,20 @@ parseCommandLine =
       . 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
+          if _packages transformedOptions == mempty then
+            Left noPackagesError
+          else
+            Right transformedOptions
+          where transformedOptions =
+                  (Options <$> setPackages . ((++) <$> fromMaybe mempty . __packages
+                                                   <*> shellArgs . __shellPackages)
+                           <*> __command
+                           <*> \case
+                             f | __withFlake f -> Flake
+                               | (hasShellArg . __shellPackages) f -> Flake
+                             _ | otherwise -> Traditional
+                           <*> __prioritiseLocalPinnedSystem) originalParsedOptions
+                hasShellArg (Just ("shell":_)) = True
                 hasShellArg _ = False
                 shellArgs (Just ("shell": rst)) = rst
                 shellArgs _ = []

src/Shellify.hs

@@ -1,13 +1,10 @@
 module Shellify (printErrorAndReturnFailure, runShellify, calculateExpectedFiles) where
 
 import Prelude hiding (readFile, writeFile)
-import Constants
-import FlakeTemplate
-import Options
-import ShellifyTemplate
-import TemplateGeneration
+import Options (Options())
+import TemplateGeneration ( generateFlakeText, generateShellDotNixText, getRegistryDB)
 
-import Control.Monad (when, (>=>))
+import Control.Monad (guard, when)
 import Data.Bool (bool)
 import Data.Maybe (isNothing)
 import Data.Text (pack, Text(), unpack)
@@ -31,10 +28,9 @@ createAFile (name, content) = do extCde <- createFile (unpack name) content
 
   where createFile :: FilePath -> Text -> IO ExitCode
         createFile fileName expectedContents = do
-          fileContents <-     doesPathExist fileName
-                          >>= bool
-                               (return Nothing)
-                               (Just <$> readFile fileName)
+          fileContents <- traverse readFile . bool Nothing
+                                                   (Just fileName)
+                                                   =<< doesPathExist fileName
           printError $ actionDescription (pack fileName) expectedContents fileContents
           when (isNothing fileContents)
             $ writeFile fileName expectedContents

src/TemplateGeneration.hs

@@ -1,15 +1,16 @@
 module TemplateGeneration (generateShellDotNixText, generateFlakeText, getRegistryDB) where
 
+import Prelude hiding (map)
 import Constants
 import FlakeTemplate
 import Options
 import ShellifyTemplate
 
 import Data.Bifunctor (bimap)
 import Data.Bool (bool)
-import Data.List (find, sort, sortBy, sortOn)
+import Data.List (find, sortBy, sortOn)
 import Data.Maybe (fromMaybe)
-import Data.Set (fromList, toList)
+import Data.Set (Set(), insert, map, toList)
 import Data.Text (Text(), isInfixOf, isPrefixOf, pack, splitOn, unpack)
 import Development.Shake.Command (cmd, Exit(Exit), Stderr(Stderr), Stdout(Stdout))
 import System.Exit (ExitCode (ExitSuccess))
@@ -50,12 +51,12 @@ generateShellDotNixText Options{_packages=Packages packages, _command=command} =
           (setAttribute "shell_hook")
           command
   $ newSTMP shellifyTemplate
-  where pkgs = generateBuildInput <$> sort packages
+  where pkgs = map generateBuildInput packages
         parameters = generateParametersWrapper packages
         generateBuildInput input = (toImportVar . getPackageRepo) input <> "." <> getPackageName input
 
-getPackageRepoWrapper :: [Package] -> [Text]
-getPackageRepoWrapper = uniq . ("nixpkgs" :) . fmap getPackageRepo . sort
+getPackageRepoWrapper :: Set Package -> [Text]
+getPackageRepoWrapper = toList . insert "nixpkgs" . map getPackageRepo
 
 getPackageRepo input | "#" `isInfixOf` input
                         = head $ splitOn "#" input
@@ -75,18 +76,16 @@ toImportVar var | var == "nixpkgs"
 getPackageRepoVarName "nixpkgs" = "pkgs"
 getPackageRepoVarName a = a
 
-generateParametersWrapper :: [Package] -> [Text]
-generateParametersWrapper = uniq . ("pkgs ? import <nixpkgs> {}" :) . fmap generateParameters . sort
+generateParametersWrapper :: Set Package -> Set Text
+generateParametersWrapper = insert "pkgs ? import <nixpkgs> {}"
+                            . map generateParameters
 
 generateParameters :: Package -> Text
 generateParameters package | "#" `isInfixOf` package
                            && not ("nixpkgs#" `isPrefixOf` package)
                            = getPackageRepo package
 generateParameters _ = "pkgs ? import <nixpkgs> {}"
 
-uniq :: Ord a => [a] -> [a]
-uniq = toList . fromList
-
 getRegistryDB :: IO (Either Text Text)
 getRegistryDB =
      do (Stdout out, Stderr err, Exit ex) <- cmd

test/Spec.hs

@@ -32,17 +32,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=setPackages ["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=setPackages ["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=setPackages [ "cowsay", "python" ], _command=Just "cowsay"}
 
       it "fails if command has no argument" $
         shellifyWithArgs "--command"
@@ -81,12 +81,12 @@ 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=setPackages [ "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}
+      Right def{_packages=setPackages [ "python", "cowsay" ], _outputForm=Flake}
 
   describe "When dealing with multiple source repositories it should produce the correct output files for" $ do
 

test/TestHelpers.hs

@@ -12,7 +12,7 @@ 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 Options (Options(..), Packages(Packages), parseCommandLine, setPackages)
 import Shellify ( calculateExpectedFiles )
 
 shouldReturnSubstring :: Either Text b -> [Char] -> Expectation
@@ -155,7 +155,7 @@ shouldResultInPackages :: Text -> [Text] -> Expectation
 shouldResultInPackages parameters packages =
      theOptions parameters
        `shouldBe`
-     Right def{_packages=Packages packages}
+     Right def{_packages=setPackages packages}
 
 readNixTemplate :: FilePath -> IO Text
 readNixTemplate = readFile . ("test/outputs/" <>)