looper 0.2.0.1 → 0.3.0.0

raw patch · 6 files changed

+162/−245 lines, 6 filesdep +opt-env-confdep +opt-env-conf-testdep −aesondep −autodocodecdep −autodocodec-yamlPVP ok

version bump matches the API change (PVP)

Dependencies added: opt-env-conf, opt-env-conf-test

Dependencies removed: aeson, autodocodec, autodocodec-yaml, envparse, optparse-applicative

API changes (from Hackage documentation)

Files

• ChangeLog.md +46/−0
• looper.cabal +9/−11
• src/Looper.hs +54/−159
• test/LooperSpec.hs +4/−55
• test_resources/configuration.txt +0/−20
• test_resources/documentation.txt +49/−0

@@ -0,0 +1,46 @@+# Changelog+  +## [0.3.0.0] - 2024-07-18++### Changed++* Moved over to `opt-env-conf`.+  +## [0.2.0.1] - 2022-05-07++### Changed++* Made the runner function types more general.++## [0.2.0.0] - 2021-11-18++### Changed++* Started using `autodocodec` instead of `yamlparse-applicative`.++## [0.1.0.1] - 2020-05-10++### Added++* `looperEnvironmentParser`++### Changed++* Environment parsing via `envparse`++## [0.0.0.2] - 2019-05-15++### Changed++* Exposed 'readLooperEnvironment'+* Doc fix++## [0.0.0.1] - 2019-05-15++### Changed++* Better docs++## [0.0.0.0] - 2019-05-15++Initial version

@@ -1,11 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.34.7.+-- This file has been generated from package.yaml by hpack version 0.36.0. -- -- see: https://github.com/sol/hpack  name:           looper-version:        0.2.0.1+version:        0.3.0.0 description:    Configure and run recurring jobs indefinitely homepage:       https://github.com/NorfairKing/looper#readme bug-reports:    https://github.com/NorfairKing/looper/issues@@ -16,7 +16,8 @@ license-file:   LICENSE build-type:     Simple extra-source-files:-    test_resources/configuration.txt+    ChangeLog.md+    test_resources/documentation.txt  source-repository head   type: git@@ -30,11 +31,8 @@   hs-source-dirs:       src   build-depends:-      aeson-    , autodocodec-    , base >=4.7 && <5-    , envparse-    , optparse-applicative+      base >=4.7 && <5+    , opt-env-conf     , text     , time     , unliftio@@ -52,10 +50,10 @@   build-tool-depends:       sydtest-discover:sydtest-discover   build-depends:-      autodocodec-yaml-    , base >=4.7 && <5+      base >=4.7 && <5     , looper-    , optparse-applicative+    , opt-env-conf+    , opt-env-conf-test     , sydtest     , unliftio   default-language: Haskell2010

@@ -1,22 +1,18 @@+{-# LANGUAGE ApplicativeDo #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DerivingVia #-}+{-# LANGUAGE NumericUnderscores #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-}  module Looper   ( LooperDef (..),+    milliseconds,     seconds,     minutes,     hours,-    LooperFlags (..),-    getLooperFlags,-    LooperEnvironment (..),-    getLooperEnvironment,-    readLooperEnvironment,-    looperEnvironmentParser,-    LooperConfiguration (..),     LooperSettings (..),-    deriveLooperSettings,+    parseLooperSettings,     mkLooperDef,     runLoopers,     runLoopersIgnoreOverrun,@@ -25,17 +21,11 @@   ) where -import Autodocodec-import Control.Applicative import Control.Monad-import Data.Aeson (FromJSON, ToJSON)-import Data.Maybe import Data.Text (Text) import Data.Time-import qualified Env import GHC.Generics (Generic)-import Options.Applicative as OptParse-import qualified System.Environment as System (getEnvironment)+import OptEnvConf import UnliftIO import UnliftIO.Concurrent @@ -54,6 +44,13 @@   }   deriving (Generic) +-- | Construct a 'NominalDiffTime' from a number of milliseconds+--+-- Note that scheduling can easily get in the way of accuracy at this+-- level of granularity.+milliseconds :: Double -> NominalDiffTime+milliseconds = seconds . (/ 60)+ -- | Construct a 'NominalDiffTime' from a number of seconds seconds :: Double -> NominalDiffTime seconds = realToFrac@@ -66,126 +63,6 @@ hours :: Double -> NominalDiffTime hours = minutes . (* 60) --- | A structure to parse command-line flags for a looper into-data LooperFlags = LooperFlags-  { looperFlagEnabled :: Maybe Bool,-    looperFlagPhase :: Maybe Word, -- Seconds-    looperFlagPeriod :: Maybe Word -- Seconds-  }-  deriving (Show, Eq, Generic)---- | An optparse applicative parser for 'LooperFlags'-getLooperFlags ::-  -- | The name of the looper (best to make this all-lowercase)-  String ->-  OptParse.Parser LooperFlags-getLooperFlags name =-  LooperFlags <$> doubleSwitch name (unwords ["enable the", name, "looper"]) mempty-    <*> option-      (Just <$> auto)-      ( mconcat-          [ long $ name <> "-phase",-            metavar "SECONDS",-            value Nothing,-            help $ unwords ["the phase for the", name, "looper in seconsd"]-          ]-      )-    <*> option-      (Just <$> auto)-      ( mconcat-          [ long $ name <> "-period",-            metavar "SECONDS",-            value Nothing,-            help $ unwords ["the period for the", name, "looper in seconds"]-          ]-      )--doubleSwitch :: String -> String -> Mod FlagFields Bool -> OptParse.Parser (Maybe Bool)-doubleSwitch name helpText mods =-  let enabledValue = True-      disabledValue = False-      defaultValue = True-   in ( last . map Just-          <$> some-            ( ( flag'-                  enabledValue-                  (hidden <> internal <> long ("enable-" ++ name) <> help helpText <> mods)-                  <|> flag'-                    disabledValue-                    (hidden <> internal <> long ("disable-" ++ name) <> help helpText <> mods)-              )-                <|> flag'-                  disabledValue-                  ( long ("(enable|disable)-" ++ name)-                      <> help ("Enable/disable " ++ helpText ++ " (default: " ++ show defaultValue ++ ")")-                      <> mods-                  )-            )-      )-        <|> pure Nothing---- | A structure to parse environment variables for a looper into-data LooperEnvironment = LooperEnvironment-  { looperEnvEnabled :: Maybe Bool,-    looperEnvPhase :: Maybe Word, -- Seconds-    looperEnvPeriod :: Maybe Word -- Seconds-  }-  deriving (Show, Eq, Generic)---- | Get a 'LooperEnvironment' from the environment-getLooperEnvironment ::-  -- | Prefix for each variable (best to make this all-caps)-  String ->-  -- | Name of the looper (best to make this all-caps too)-  String ->-  IO LooperEnvironment-getLooperEnvironment prefix name = readLooperEnvironment prefix name <$> System.getEnvironment---- | Get a 'LooperEnvironment' from a pure environment-readLooperEnvironment ::-  -- | Prefix for each variable (best to make this all-caps)-  String ->-  -- | Name of the looper (best to make this all-caps too)-  String ->-  [(String, String)] ->-  LooperEnvironment-readLooperEnvironment prefix name env = case Env.parsePure (Env.prefixed prefix $ looperEnvironmentParser name) env of-  Left _ -> error "This indicates a bug in looper because all environment variables are optional."-  Right r -> r---- | An 'envparse' parser for a 'LooperEnvironment'-looperEnvironmentParser ::-  -- | Name of the looper (best to make this all-caps)-  String ->-  Env.Parser Env.Error LooperEnvironment-looperEnvironmentParser name =-  Env.prefixed (name <> "_") $-    LooperEnvironment-      <$> Env.var (fmap Just . Env.auto) "ENABLED" (Env.def Nothing <> Env.help "Whether to enable this looper")-      <*> Env.var (fmap Just . Env.auto) "PHASE" (Env.def Nothing <> Env.help "The amount of time to wait before starting the looper the first time, in seconds")-      <*> Env.var (fmap Just . Env.auto) "PERIOD" (Env.def Nothing <> Env.help "The amount of time to wait between runs of the looper, in seconds")---- | A structure to configuration for a looper into-data LooperConfiguration = LooperConfiguration-  { looperConfEnabled :: Maybe Bool,-    looperConfPhase :: Maybe Word,-    looperConfPeriod :: Maybe Word-  }-  deriving stock (Show, Eq, Generic)-  deriving (FromJSON, ToJSON) via (Autodocodec LooperConfiguration)--instance HasCodec LooperConfiguration where-  codec =-    named "LooperConfiguration" $-      object "LooperConfiguration" $-        LooperConfiguration-          <$> parseAlternative-            (optionalFieldOrNull "enable" "Enable this looper")-            (optionalFieldOrNull "enabled" "Enable this looper")-            .= looperConfEnabled-          <*> optionalFieldOrNull "phase" "The amount of time to wait before starting the looper the first time, in seconds" .= looperConfPhase-          <*> optionalFieldOrNull "period" "The amount of time to wait between runs of the looper, in seconds" .= looperConfPeriod- -- | Settings that you might want to pass into a looper using 'mkLooperDef' data LooperSettings = LooperSettings   { looperSetEnabled :: Bool,@@ -194,25 +71,43 @@   }   deriving (Show, Eq, Generic) -deriveLooperSettings ::-  -- | Default phase+parseLooperSettings ::+  String ->   NominalDiffTime ->-  -- | Default period   NominalDiffTime ->-  LooperFlags ->-  LooperEnvironment ->-  Maybe LooperConfiguration ->-  LooperSettings-deriveLooperSettings defaultPhase defaultPeriod LooperFlags {..} LooperEnvironment {..} mlc =-  let looperSetEnabled =-        fromMaybe True $ looperFlagEnabled <|> looperEnvEnabled <|> (mlc >>= looperConfEnabled)-      looperSetPhase =-        maybe defaultPhase fromIntegral $-          looperFlagPhase <|> looperEnvPhase <|> (mlc >>= looperConfPhase)-      looperSetPeriod =-        maybe defaultPeriod fromIntegral $-          looperFlagPeriod <|> looperEnvPeriod <|> (mlc >>= looperConfPeriod)-   in LooperSettings {..}+  Parser LooperSettings+parseLooperSettings looperName defaultPhase defaultPeriod = do+  looperSetEnabled <-+    subConfig (toConfigCase looperName) $+      subEnv (toEnvCase looperName <> "_") $+        enableDisableSwitch+          True+          [ help $ unwords ["enable the", looperName, "looper"],+            option,+            long looperName,+            env "ENABLE",+            conf "enable"+          ]+  (looperSetPhase, looperSetPeriod) <- subAll looperName $ do+    ph <-+      setting+        [ help $ unwords ["phase of the", looperName, "looper in seconds"],+          reader (fromInteger <$> auto),+          option,+          name "phase",+          metavar "SECONDS",+          value defaultPhase+        ]+    pe <-+      setting+        [ help $ unwords ["period of the", looperName, "looper in seconds"],+          reader (fromInteger <$> auto),+          name "period",+          metavar "SECONDS",+          value defaultPeriod+        ]+    pure (ph, pe)+  pure LooperSettings {..}  mkLooperDef ::   -- | Name@@ -221,9 +116,9 @@   -- | The function to loop   m () ->   LooperDef m-mkLooperDef name LooperSettings {..} func =+mkLooperDef n LooperSettings {..} func =   LooperDef-    { looperDefName = name,+    { looperDefName = n,       looperDefEnabled = looperSetEnabled,       looperDefPeriod = looperSetPeriod,       looperDefPhase = looperSetPhase,@@ -237,7 +132,7 @@ -- see 'runLoopersIgnoreOverrun' -- -- Note that this function will loop forever, you need to wrap it using 'async' yourself.-runLoopers :: MonadUnliftIO m => [LooperDef m] -> m ()+runLoopers :: (MonadUnliftIO m) => [LooperDef m] -> m () runLoopers = runLoopersIgnoreOverrun looperDefFunc  -- | Run loopers with a custom runner, ignoring any overruns@@ -248,7 +143,7 @@ -- -- Note that this function will loop forever, you need to wrap it using 'async' yourself. runLoopersIgnoreOverrun ::-  (MonadUnliftIO m, MonadUnliftIO n) =>+  (MonadUnliftIO n) =>   -- | Custom runner   (LooperDef m -> n ()) ->   -- | Loopers@@ -268,7 +163,7 @@ -- -- Note that this function will loop forever, you need to wrap it using 'async' yourself. runLoopersRaw ::-  (MonadUnliftIO m, MonadUnliftIO n) =>+  (MonadUnliftIO n) =>   -- | Overrun handler   (LooperDef m -> n ()) ->   -- | Runner@@ -297,5 +192,5 @@ -- This takes care of the conversion to microseconds to pass to 'threadDelay' for you. -- -- > waitNominalDiffTime ndt = liftIO $ threadDelay $ round (toRational ndt * (1000 * 1000))-waitNominalDiffTime :: MonadIO m => NominalDiffTime -> m ()-waitNominalDiffTime ndt = liftIO $ threadDelay $ round (toRational ndt * (1000 * 1000))+waitNominalDiffTime :: (MonadIO m) => NominalDiffTime -> m ()+waitNominalDiffTime ndt = liftIO $ threadDelay $ round (toRational ndt * 1_000_000)

@@ -1,54 +1,20 @@ {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeApplications #-}  module LooperSpec   ( spec,   ) where -import Autodocodec.Yaml import Looper-import Options.Applicative as AP+import OptEnvConf+import OptEnvConf.Test import Test.Syd import UnliftIO  spec :: Spec spec = do-  describe "getLooperFlags" $ do-    it "parses default values for an empty list of arguments" $ do-      parserSucceedsWith-        (getLooperFlags "test")-        []-        ( LooperFlags-            { looperFlagEnabled = Nothing,-              looperFlagPhase = Nothing,-              looperFlagPeriod = Nothing-            }-        )-    it "parses an enable flag correctly" $ do-      parserSucceedsWith-        (getLooperFlags "test")-        ["--enable-test"]-        ( LooperFlags-            { looperFlagEnabled = Just True,-              looperFlagPhase = Nothing,-              looperFlagPeriod = Nothing-            }-        )-    it "parses an disable flag correctly" $ do-      parserSucceedsWith-        (getLooperFlags "test")-        ["--disable-test"]-        ( LooperFlags-            { looperFlagEnabled = Just False,-              looperFlagPhase = Nothing,-              looperFlagPeriod = Nothing-            }-        )--  describe "Configuration" $ do-    it "has the same schema as before" $-      pureGoldenByteStringFile "test_resources/configuration.txt" (renderColouredSchemaViaCodec @LooperConfiguration)+  parserLintSpec $ withLocalYamlConfig $ parseLooperSettings "example" (minutes 1) (minutes 60)+  goldenParserReferenceDocumentationSpec (parseLooperSettings "example" (minutes 1) (minutes 60)) "test_resources/documentation.txt" "looper"    describe "runLoopers" $ do     it "runs one looper as intended" $ do@@ -153,20 +119,3 @@       r1 <- readTVarIO v1       r2 <- readTVarIO v2       (r1, r2) `shouldBe` (3, 2)--parserSucceedsWith :: (Show a, Eq a) => Parser a -> [String] -> a -> Expectation-parserSucceedsWith parser args expectedValue =-  case execParserPure parserPrefs (info parser mempty) args of-    AP.Success r -> r `shouldBe` expectedValue-    AP.Failure fp ->-      let (err, ec) = renderFailure fp "test"-       in expectationFailure $-            unlines ["Failed to parse:", err, "would have resulted in exit code", show ec]-    AP.CompletionInvoked _ -> expectationFailure "Tried to invoke a completion, should not happen"-  where-    parserPrefs :: ParserPrefs-    parserPrefs =-      defaultPrefs-        { prefShowHelpOnError = True,-          prefShowHelpOnEmpty = True-        }

@@ -1,20 +0,0 @@-[36mdef: LooperConfiguration[m-# LooperConfiguration-# [32many of[m-[ [37menable[m: # [34moptional[m-    # Enable this looper-    # [32mor null[m-    [33m<boolean>[m-, [37menabled[m: # [34moptional[m-    # Enable this looper-    # [32mor null[m-    [33m<boolean>[m-]-[37mphase[m: # [34moptional[m-  # The amount of time to wait before starting the looper the first time, in seconds-  # [32mor null[m-  [33m<number>[m # between [32m0[m and [32m18446744073709551615[m-[37mperiod[m: # [34moptional[m-  # The amount of time to wait between runs of the looper, in seconds-  # [32mor null[m-  [33m<number>[m # between [32m0[m and [32m18446744073709551615[m

@@ -0,0 +1,49 @@+[36mUsage: [m[33mlooper[m [37m--(enable|disable)-example[m [37m--example-phase[m [33mSECONDS[m [37m--example-period[m [33mSECONDS[m++[36mAll settings[m:+  [34menable the example looper[m+  switch: [37m--(enable|disable)-example[m+  env: [37mEXAMPLE_ENABLE[m [33mBOOL[m+  config:+    [37mexample.enable[m: # [32mor null[m+      [33m<boolean>[m++  [34mphase of the example looper in seconds[m+  option: [37m--example-phase[m [33mSECONDS[m+  env: [37mEXAMPLE_PHASE[m [33mSECONDS[m+  config:+    [37mexample.phase[m: # [32mor null[m+      [33m<number>[m+  +  [34mperiod of the example looper in seconds[m+  option: [37m--example-period[m [33mSECONDS[m+  env: [37mEXAMPLE_PERIOD[m [33mSECONDS[m+  config:+    [37mexample.period[m: # [32mor null[m+      [33m<number>[m+  ++[36mOptions[m:+  [37m--(enable|disable)-example[m [34menable the example looper[m                             +  [37m--example-phase[m            [34mphase of the example looper in seconds[m  default: [33m60s[m  +  [37m--example-period[m           [34mperiod of the example looper in seconds[m default: [33m3600s[m++[36mEnvironment Variables[m:+  [37mEXAMPLE_ENABLE[m [33mBOOL[m      [34menable the example looper[m              +  [37mEXAMPLE_PHASE[m [33mSECONDS[m    [34mphase of the example looper in seconds[m +  [37mEXAMPLE_PERIOD[m [33mSECONDS[m   [34mperiod of the example looper in seconds[m++[36mConfiguration Values[m:+  [34menable the example looper[m+  [37mexample.enable[m:+    # [32mor null[m+    [33m<boolean>[m+  [34mphase of the example looper in seconds[m+  [37mexample.phase[m:+    # [32mor null[m+    [33m<number>[m+  [34mperiod of the example looper in seconds[m+  [37mexample.period[m:+    # [32mor null[m+    [33m<number>[m+