stackctl 1.3.0.0 → 1.3.0.1

raw patch · 10 files changed

+96/−68 lines, 10 files

Files

• CHANGELOG.md +7/−1
• src/Stackctl/CLI.hs +5/−3
• src/Stackctl/ColorOption.hs +2/−25
• src/Stackctl/Colors.hs +5/−8
• src/Stackctl/Commands.hs +1/−1
• src/Stackctl/Config/RequiredVersion.hs +66/−23
• src/Stackctl/Options.hs +2/−5
• src/Stackctl/Spec/Cat.hs +0/−1
• stackctl.cabal +2/−1
• test/Stackctl/Config/RequiredVersionSpec.hs +6/−0

@@ -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: == <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) 

@@ -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

@@ -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"]

@@ -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

@@ -8,7 +8,7 @@  import Stackctl.Prelude -import Stackctl.Colors+import Stackctl.ColorOption import Stackctl.DirectoryOption import Stackctl.FilterOption import Stackctl.Spec.Capture

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

@@ -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

@@ -62,7 +62,6 @@      , HasConfig env      , HasDirectoryOption env      , HasFilterOption env-     , HasColorOption env      )   => CatOptions   -> m ()

@@ -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,

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