diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,4 +1,10 @@ -## [_Unreleased_](https://github.com/freckle/stackctl/compare/v1.3.0.0...main) +## [_Unreleased_](https://github.com/freckle/stackctl/compare/v1.3.0.1...main) + +## [v1.3.0.1](https://github.com/freckle/stackctl/compare/v1.3.0.0...v1.3.0.1) + +- Fix bug where `LOG_COLOR` was never respected +- Also accept `"required_version: == "` +- Add `Eq`, `ToJSON` instance on `RequiredVersion` ## [v1.3.0.0](https://github.com/freckle/stackctl/compare/v1.2.0.1...v1.3.0.0) diff --git a/src/Stackctl/CLI.hs b/src/Stackctl/CLI.hs --- a/src/Stackctl/CLI.hs +++ b/src/Stackctl/CLI.hs @@ -87,7 +87,7 @@ $ defaultLogSettings logger <- newLogger $ adjustLogSettings - (options ^. colorOptionL . to unColorOption) + (options ^. colorOptionL) (options ^. verboseOptionL) envLogSettings @@ -115,5 +115,7 @@ $ withThreadContext context $ unAppT f -adjustLogSettings :: LogColor -> Verbosity -> LogSettings -> LogSettings -adjustLogSettings lc v = setLogSettingsColor lc . verbositySetLogLevels v +adjustLogSettings + :: Maybe ColorOption -> Verbosity -> LogSettings -> LogSettings +adjustLogSettings mco v = + maybe id (setLogSettingsColor . unColorOption) mco . verbositySetLogLevels v diff --git a/src/Stackctl/ColorOption.hs b/src/Stackctl/ColorOption.hs --- a/src/Stackctl/ColorOption.hs +++ b/src/Stackctl/ColorOption.hs @@ -1,9 +1,7 @@ module Stackctl.ColorOption ( ColorOption(..) - , defaultColorOption , HasColorOption(..) , colorOption - , colorHandle ) where import Stackctl.Prelude @@ -17,30 +15,9 @@ } deriving Semigroup via Last ColorOption -defaultColorOption :: ColorOption -defaultColorOption = ColorOption LogColorAuto - class HasColorOption env where - colorOptionL :: Lens' env ColorOption - -instance HasColorOption ColorOption where - colorOptionL = id + colorOptionL :: Lens' env (Maybe ColorOption) colorOption :: Parser ColorOption colorOption = option (eitherReader $ fmap ColorOption . readLogColor) $ mconcat - [ long "color" - , help "When to colorize output" - , metavar "auto|always|never" - , value defaultColorOption - , showDefaultWith showColorOption - ] - -showColorOption :: ColorOption -> String -showColorOption co = case unColorOption co of - LogColorAuto -> "auto" - LogColorAlways -> "always" - LogColorNever -> "never" - -colorHandle :: MonadIO m => Handle -> ColorOption -> m Bool -colorHandle h co = shouldColorHandle settings h - where settings = setLogSettingsColor (unColorOption co) defaultLogSettings + [long "color", help "When to colorize output", metavar "auto|always|never"] diff --git a/src/Stackctl/Colors.hs b/src/Stackctl/Colors.hs --- a/src/Stackctl/Colors.hs +++ b/src/Stackctl/Colors.hs @@ -1,7 +1,6 @@ -- | Facilities for colorizing output module Stackctl.Colors ( Colors(..) - , HasColorOption , getColorsStdout , getColorsLogger , noColors @@ -11,20 +10,18 @@ import Blammo.Logging.Colors import Blammo.Logging.Logger -import Stackctl.ColorOption (HasColorOption(..), colorHandle) +import Blammo.Logging.LogSettings (shouldColorHandle) -- | Return 'Colors' based on options and 'stdout' -getColorsStdout - :: (MonadIO m, MonadReader env m, HasColorOption env) => m Colors +getColorsStdout :: (MonadIO m, MonadReader env m, HasLogger env) => m Colors getColorsStdout = getColorsHandle stdout -- | Return 'Colors' based on options given 'Handle' getColorsHandle - :: (MonadIO m, MonadReader env m, HasColorOption env) => Handle -> m Colors + :: (MonadIO m, MonadReader env m, HasLogger env) => Handle -> m Colors getColorsHandle h = do - colorOption <- view colorOptionL - c <- colorHandle h colorOption - pure $ getColors c + ls <- view $ loggerL . to getLoggerLogSettings + getColors <$> shouldColorHandle ls h -- | Return 'Colors' consistent with the ambient 'Logger' getColorsLogger :: (MonadReader env m, HasLogger env) => m Colors diff --git a/src/Stackctl/Commands.hs b/src/Stackctl/Commands.hs --- a/src/Stackctl/Commands.hs +++ b/src/Stackctl/Commands.hs @@ -8,7 +8,7 @@ import Stackctl.Prelude -import Stackctl.Colors +import Stackctl.ColorOption import Stackctl.DirectoryOption import Stackctl.FilterOption import Stackctl.Spec.Capture diff --git a/src/Stackctl/Config/RequiredVersion.hs b/src/Stackctl/Config/RequiredVersion.hs --- a/src/Stackctl/Config/RequiredVersion.hs +++ b/src/Stackctl/Config/RequiredVersion.hs @@ -1,5 +1,7 @@ module Stackctl.Config.RequiredVersion ( RequiredVersion(..) + , RequiredVersionOp(..) + , requiredVersionToText , requiredVersionFromText , isRequiredVersionSatisfied @@ -15,22 +17,31 @@ import qualified Data.Text as T import Data.Version hiding (parseVersion) import qualified Data.Version as Version +import Test.QuickCheck import Text.ParserCombinators.ReadP (readP_to_S) data RequiredVersion = RequiredVersion - { requiredVersionOp :: Text - , requiredVersionCompare :: Version -> Version -> Bool + { requiredVersionOp :: RequiredVersionOp , requiredVersionCompareWith :: Version } + deriving stock (Eq, Show) -instance Show RequiredVersion where - show RequiredVersion {..} = - unpack requiredVersionOp <> " " <> showVersion requiredVersionCompareWith +instance Arbitrary RequiredVersion where + arbitrary = RequiredVersion <$> arbitrary <*> arbitrary instance FromJSON RequiredVersion where parseJSON = withText "RequiredVersion" $ either fail pure . requiredVersionFromText +instance ToJSON RequiredVersion where + toJSON = toJSON . requiredVersionToText + toEncoding = toEncoding . requiredVersionToText + +requiredVersionToText :: RequiredVersion -> Text +requiredVersionToText RequiredVersion {..} = + requiredVersionOpToText requiredVersionOp <> " " <> pack + (showVersion requiredVersionCompareWith) + requiredVersionFromText :: Text -> Either String RequiredVersion requiredVersionFromText = fromWords . T.words where @@ -44,21 +55,22 @@ <> " did not parse as optional operator and version string" parseRequiredVersion :: Text -> Text -> Either String RequiredVersion - parseRequiredVersion op w = do - v <- parseVersion w + parseRequiredVersion op w = RequiredVersion <$> parseOp op <*> parseVersion w - case op of - "=" -> Right $ RequiredVersion op (==) v - "<" -> Right $ RequiredVersion op (<) v - "<=" -> Right $ RequiredVersion op (<=) v - ">" -> Right $ RequiredVersion op (>) v - ">=" -> Right $ RequiredVersion op (>=) v - "=~" -> Right $ RequiredVersion op (=~) v - _ -> - Left - $ "Invalid comparison operator (" - <> unpack op - <> "), may only be =, <, <=, >, >=, or =~" + parseOp :: Text -> Either String RequiredVersionOp + parseOp = \case + "=" -> Right RequiredVersionEQ + "==" -> Right RequiredVersionEQ + "<" -> Right RequiredVersionLT + "<=" -> Right RequiredVersionLTE + ">" -> Right RequiredVersionGT + ">=" -> Right RequiredVersionGTE + "=~" -> Right RequiredVersionIsh + op -> + Left + $ "Invalid comparison operator (" + <> unpack op + <> "), may only be =, <, <=, >, >=, or =~" parseVersion :: Text -> Either String Version parseVersion t = @@ -68,6 +80,41 @@ $ readP_to_S Version.parseVersion s where s = unpack t +isRequiredVersionSatisfied :: RequiredVersion -> Version -> Bool +isRequiredVersionSatisfied RequiredVersion {..} = + (`requiredVersionCompare` requiredVersionCompareWith) + where requiredVersionCompare = requiredVersionOpCompare requiredVersionOp + +data RequiredVersionOp + = RequiredVersionEQ + | RequiredVersionLT + | RequiredVersionLTE + | RequiredVersionGT + | RequiredVersionGTE + | RequiredVersionIsh + deriving stock (Eq, Show, Bounded, Enum) + +instance Arbitrary RequiredVersionOp where + arbitrary = arbitraryBoundedEnum + +requiredVersionOpToText :: RequiredVersionOp -> Text +requiredVersionOpToText = \case + RequiredVersionEQ -> "==" + RequiredVersionLT -> "<" + RequiredVersionLTE -> "<=" + RequiredVersionGT -> ">" + RequiredVersionGTE -> ">=" + RequiredVersionIsh -> "=~" + +requiredVersionOpCompare :: RequiredVersionOp -> Version -> Version -> Bool +requiredVersionOpCompare = \case + RequiredVersionEQ -> (==) + RequiredVersionLT -> (<) + RequiredVersionLTE -> (<=) + RequiredVersionGT -> (>) + RequiredVersionGTE -> (>=) + RequiredVersionIsh -> (=~) + (=~) :: Version -> Version -> Bool a =~ b = a >= b && a < incrementVersion b where @@ -75,7 +122,3 @@ onVersion f = makeVersion . f . versionBranch backwards f = reverse . f . reverse onHead f as = maybe as (uncurry (:) . first f) $ uncons as - -isRequiredVersionSatisfied :: RequiredVersion -> Version -> Bool -isRequiredVersionSatisfied RequiredVersion {..} = - (`requiredVersionCompare` requiredVersionCompareWith) diff --git a/src/Stackctl/Options.hs b/src/Stackctl/Options.hs --- a/src/Stackctl/Options.hs +++ b/src/Stackctl/Options.hs @@ -29,9 +29,6 @@ filterL :: Lens' Options (Maybe FilterOption) filterL = lens oFilter $ \x y -> x { oFilter = y } -colorL :: Lens' Options (Maybe ColorOption) -colorL = lens oColor $ \x y -> x { oColor = y } - instance HasDirectoryOption Options where directoryOptionL = directoryL . maybeLens defaultDirectoryOption @@ -39,7 +36,7 @@ filterOptionL = filterL . maybeLens defaultFilterOption instance HasColorOption Options where - colorOptionL = colorL . maybeLens defaultColorOption + colorOptionL = lens oColor $ \x y -> x { oColor = y } instance HasVerboseOption Options where verboseOptionL = lens oVerbose $ \x y -> x { oVerbose = y } @@ -59,5 +56,5 @@ optionsParser = Options <$> optional directoryOption <*> optional (filterOption "specifications") - <*> (Just <$> colorOption) + <*> optional colorOption <*> verboseOption diff --git a/src/Stackctl/Spec/Cat.hs b/src/Stackctl/Spec/Cat.hs --- a/src/Stackctl/Spec/Cat.hs +++ b/src/Stackctl/Spec/Cat.hs @@ -62,7 +62,6 @@ , HasConfig env , HasDirectoryOption env , HasFilterOption env - , HasColorOption env ) => CatOptions -> m () diff --git a/stackctl.cabal b/stackctl.cabal --- a/stackctl.cabal +++ b/stackctl.cabal @@ -1,6 +1,6 @@ cabal-version: 1.18 name: stackctl -version: 1.3.0.0 +version: 1.3.0.1 license: MIT license-file: LICENSE copyright: 2022 Renaissance Learning Inc @@ -81,6 +81,7 @@ build-depends: Blammo >=1.1.1.1, Glob, + QuickCheck, aeson, aeson-casing, aeson-pretty, diff --git a/test/Stackctl/Config/RequiredVersionSpec.hs b/test/Stackctl/Config/RequiredVersionSpec.hs --- a/test/Stackctl/Config/RequiredVersionSpec.hs +++ b/test/Stackctl/Config/RequiredVersionSpec.hs @@ -4,6 +4,7 @@ import Stackctl.Prelude +import Data.Aeson (decode, encode) import Data.Version import Stackctl.Config.RequiredVersion import Test.Hspec @@ -11,6 +12,10 @@ spec :: Spec spec = do + describe "JSON" $ do + it "round-trips" $ property $ \rv -> do + decode (encode @RequiredVersion rv) `shouldBe` Just rv + describe "requiredVersionFromText" $ do it "parses with or without operator" $ do requiredVersionFromText "1.2.3-rc1" `shouldSatisfy` isRight @@ -27,6 +32,7 @@ it "compares exactly" $ prop (==) Nothing it "compares with = " $ prop (==) $ Just "=" + it "compares with ==" $ prop (==) $ Just "==" it "compares with < " $ prop (<) $ Just "<" it "compares with <=" $ prop (<=) $ Just "<=" it "compares with > " $ prop (>) $ Just ">"