From 0125ab2472a9b145f385a0bc3ca2c28db0458755 Mon Sep 17 00:00:00 2001 From: Daniel Rolls Date: Sat, 22 Mar 2025 08:35:11 +0000 Subject: [PATCH] refactor codebase --- src/Options.hs | 54 ++++++++++++++++++--------------------- src/Shellify.hs | 16 +++++------- src/TemplateGeneration.hs | 19 +++++++------- test/Spec.hs | 10 ++++---- test/TestHelpers.hs | 4 +-- 5 files changed, 47 insertions(+), 56 deletions(-) diff --git a/src/Options.hs b/src/Options.hs index 4051fcd..9d726a9 100644 --- a/src/Options.hs +++ b/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 _ = [] diff --git a/src/Shellify.hs b/src/Shellify.hs index a06021d..bcd9748 100644 --- a/src/Shellify.hs +++ b/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 diff --git a/src/TemplateGeneration.hs b/src/TemplateGeneration.hs index 6f7bf16..2c613c5 100644 --- a/src/TemplateGeneration.hs +++ b/src/TemplateGeneration.hs @@ -1,5 +1,6 @@ module TemplateGeneration (generateShellDotNixText, generateFlakeText, getRegistryDB) where +import Prelude hiding (map) import Constants import FlakeTemplate import Options @@ -7,9 +8,9 @@ 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,8 +76,9 @@ toImportVar var | var == "nixpkgs" getPackageRepoVarName "nixpkgs" = "pkgs" getPackageRepoVarName a = a -generateParametersWrapper :: [Package] -> [Text] -generateParametersWrapper = uniq . ("pkgs ? import {}" :) . fmap generateParameters . sort +generateParametersWrapper :: Set Package -> Set Text +generateParametersWrapper = insert "pkgs ? import {}" + . map generateParameters generateParameters :: Package -> Text generateParameters package | "#" `isInfixOf` package @@ -84,9 +86,6 @@ generateParameters package | "#" `isInfixOf` package = getPackageRepo package generateParameters _ = "pkgs ? import {}" -uniq :: Ord a => [a] -> [a] -uniq = toList . fromList - getRegistryDB :: IO (Either Text Text) getRegistryDB = do (Stdout out, Stderr err, Exit ex) <- cmd diff --git a/test/Spec.hs b/test/Spec.hs index ba6ac96..4051feb 100644 --- a/test/Spec.hs +++ b/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 diff --git a/test/TestHelpers.hs b/test/TestHelpers.hs index a457366..cf172f5 100644 --- a/test/TestHelpers.hs +++ b/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/" <>)