{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Looper
( LooperDef (..),
seconds,
minutes,
hours,
LooperFlags (..),
getLooperFlags,
LooperEnvironment (..),
getLooperEnvironment,
readLooperEnvironment,
looperEnvironmentParser,
LooperConfiguration (..),
LooperSettings (..),
deriveLooperSettings,
mkLooperDef,
runLoopers,
runLoopersIgnoreOverrun,
runLoopersRaw,
waitNominalDiffTime,
)
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 UnliftIO
import UnliftIO.Concurrent
data LooperDef m = LooperDef
{
LooperDef m -> Text
looperDefName :: Text,
LooperDef m -> Bool
looperDefEnabled :: Bool,
LooperDef m -> NominalDiffTime
looperDefPeriod :: NominalDiffTime,
LooperDef m -> NominalDiffTime
looperDefPhase :: NominalDiffTime,
LooperDef m -> m ()
looperDefFunc :: m ()
}
deriving ((forall x. LooperDef m -> Rep (LooperDef m) x)
-> (forall x. Rep (LooperDef m) x -> LooperDef m)
-> Generic (LooperDef m)
forall x. Rep (LooperDef m) x -> LooperDef m
forall x. LooperDef m -> Rep (LooperDef m) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (m :: * -> *) x. Rep (LooperDef m) x -> LooperDef m
forall (m :: * -> *) x. LooperDef m -> Rep (LooperDef m) x
$cto :: forall (m :: * -> *) x. Rep (LooperDef m) x -> LooperDef m
$cfrom :: forall (m :: * -> *) x. LooperDef m -> Rep (LooperDef m) x
Generic)
seconds :: Double -> NominalDiffTime
seconds :: Double -> NominalDiffTime
seconds = Double -> NominalDiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac
minutes :: Double -> NominalDiffTime
minutes :: Double -> NominalDiffTime
minutes = Double -> NominalDiffTime
seconds (Double -> NominalDiffTime)
-> (Double -> Double) -> Double -> NominalDiffTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
60)
hours :: Double -> NominalDiffTime
hours :: Double -> NominalDiffTime
hours = Double -> NominalDiffTime
minutes (Double -> NominalDiffTime)
-> (Double -> Double) -> Double -> NominalDiffTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
60)
data LooperFlags = LooperFlags
{ LooperFlags -> Maybe Bool
looperFlagEnabled :: Maybe Bool,
LooperFlags -> Maybe Word
looperFlagPhase :: Maybe Word,
LooperFlags -> Maybe Word
looperFlagPeriod :: Maybe Word
}
deriving (Int -> LooperFlags -> ShowS
[LooperFlags] -> ShowS
LooperFlags -> String
(Int -> LooperFlags -> ShowS)
-> (LooperFlags -> String)
-> ([LooperFlags] -> ShowS)
-> Show LooperFlags
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LooperFlags] -> ShowS
$cshowList :: [LooperFlags] -> ShowS
show :: LooperFlags -> String
$cshow :: LooperFlags -> String
showsPrec :: Int -> LooperFlags -> ShowS
$cshowsPrec :: Int -> LooperFlags -> ShowS
Show, LooperFlags -> LooperFlags -> Bool
(LooperFlags -> LooperFlags -> Bool)
-> (LooperFlags -> LooperFlags -> Bool) -> Eq LooperFlags
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LooperFlags -> LooperFlags -> Bool
$c/= :: LooperFlags -> LooperFlags -> Bool
== :: LooperFlags -> LooperFlags -> Bool
$c== :: LooperFlags -> LooperFlags -> Bool
Eq, (forall x. LooperFlags -> Rep LooperFlags x)
-> (forall x. Rep LooperFlags x -> LooperFlags)
-> Generic LooperFlags
forall x. Rep LooperFlags x -> LooperFlags
forall x. LooperFlags -> Rep LooperFlags x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LooperFlags x -> LooperFlags
$cfrom :: forall x. LooperFlags -> Rep LooperFlags x
Generic)
getLooperFlags ::
String ->
OptParse.Parser LooperFlags
getLooperFlags :: String -> Parser LooperFlags
getLooperFlags String
name =
Maybe Bool -> Maybe Word -> Maybe Word -> LooperFlags
LooperFlags (Maybe Bool -> Maybe Word -> Maybe Word -> LooperFlags)
-> Parser (Maybe Bool)
-> Parser (Maybe Word -> Maybe Word -> LooperFlags)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> Mod FlagFields Bool -> Parser (Maybe Bool)
doubleSwitch String
name ([String] -> String
unwords [String
"enable the", String
name, String
"looper"]) Mod FlagFields Bool
forall a. Monoid a => a
mempty
Parser (Maybe Word -> Maybe Word -> LooperFlags)
-> Parser (Maybe Word) -> Parser (Maybe Word -> LooperFlags)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReadM (Maybe Word)
-> Mod OptionFields (Maybe Word) -> Parser (Maybe Word)
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
(Word -> Maybe Word
forall a. a -> Maybe a
Just (Word -> Maybe Word) -> ReadM Word -> ReadM (Maybe Word)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM Word
forall a. Read a => ReadM a
auto)
( [Mod OptionFields (Maybe Word)] -> Mod OptionFields (Maybe Word)
forall a. Monoid a => [a] -> a
mconcat
[ String -> Mod OptionFields (Maybe Word)
forall (f :: * -> *) a. HasName f => String -> Mod f a
long (String -> Mod OptionFields (Maybe Word))
-> String -> Mod OptionFields (Maybe Word)
forall a b. (a -> b) -> a -> b
$ String
name String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"-phase",
String -> Mod OptionFields (Maybe Word)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"SECONDS",
Maybe Word -> Mod OptionFields (Maybe Word)
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value Maybe Word
forall a. Maybe a
Nothing,
String -> Mod OptionFields (Maybe Word)
forall (f :: * -> *) a. String -> Mod f a
help (String -> Mod OptionFields (Maybe Word))
-> String -> Mod OptionFields (Maybe Word)
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [String
"the phase for the", String
name, String
"looper in seconsd"]
]
)
Parser (Maybe Word -> LooperFlags)
-> Parser (Maybe Word) -> Parser LooperFlags
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReadM (Maybe Word)
-> Mod OptionFields (Maybe Word) -> Parser (Maybe Word)
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
(Word -> Maybe Word
forall a. a -> Maybe a
Just (Word -> Maybe Word) -> ReadM Word -> ReadM (Maybe Word)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM Word
forall a. Read a => ReadM a
auto)
( [Mod OptionFields (Maybe Word)] -> Mod OptionFields (Maybe Word)
forall a. Monoid a => [a] -> a
mconcat
[ String -> Mod OptionFields (Maybe Word)
forall (f :: * -> *) a. HasName f => String -> Mod f a
long (String -> Mod OptionFields (Maybe Word))
-> String -> Mod OptionFields (Maybe Word)
forall a b. (a -> b) -> a -> b
$ String
name String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"-period",
String -> Mod OptionFields (Maybe Word)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"SECONDS",
Maybe Word -> Mod OptionFields (Maybe Word)
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value Maybe Word
forall a. Maybe a
Nothing,
String -> Mod OptionFields (Maybe Word)
forall (f :: * -> *) a. String -> Mod f a
help (String -> Mod OptionFields (Maybe Word))
-> String -> Mod OptionFields (Maybe Word)
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [String
"the period for the", String
name, String
"looper in seconds"]
]
)
doubleSwitch :: String -> String -> Mod FlagFields Bool -> OptParse.Parser (Maybe Bool)
doubleSwitch :: String -> String -> Mod FlagFields Bool -> Parser (Maybe Bool)
doubleSwitch String
name String
helpText Mod FlagFields Bool
mods =
let enabledValue :: Bool
enabledValue = Bool
True
disabledValue :: Bool
disabledValue = Bool
False
defaultValue :: Bool
defaultValue = Bool
True
in ( [Maybe Bool] -> Maybe Bool
forall a. [a] -> a
last ([Maybe Bool] -> Maybe Bool)
-> ([Bool] -> [Maybe Bool]) -> [Bool] -> Maybe Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Maybe Bool) -> [Bool] -> [Maybe Bool]
forall a b. (a -> b) -> [a] -> [b]
map Bool -> Maybe Bool
forall a. a -> Maybe a
Just
([Bool] -> Maybe Bool) -> Parser [Bool] -> Parser (Maybe Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Bool -> Parser [Bool]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some
( ( Bool -> Mod FlagFields Bool -> Parser Bool
forall a. a -> Mod FlagFields a -> Parser a
flag'
Bool
enabledValue
(Mod FlagFields Bool
forall (f :: * -> *) a. Mod f a
hidden Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> Mod FlagFields Bool
forall (f :: * -> *) a. Mod f a
internal Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long (String
"enable-" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name) Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
helpText Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> Mod FlagFields Bool
mods)
Parser Bool -> Parser Bool -> Parser Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Mod FlagFields Bool -> Parser Bool
forall a. a -> Mod FlagFields a -> Parser a
flag'
Bool
disabledValue
(Mod FlagFields Bool
forall (f :: * -> *) a. Mod f a
hidden Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> Mod FlagFields Bool
forall (f :: * -> *) a. Mod f a
internal Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long (String
"disable-" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name) Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
helpText Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> Mod FlagFields Bool
mods)
)
Parser Bool -> Parser Bool -> Parser Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Mod FlagFields Bool -> Parser Bool
forall a. a -> Mod FlagFields a -> Parser a
flag'
Bool
disabledValue
( String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long (String
"(enable|disable)-" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name)
Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help (String
"Enable/disable " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
helpText String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" (default: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Bool -> String
forall a. Show a => a -> String
show Bool
defaultValue String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")")
Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> Mod FlagFields Bool
mods
)
)
)
Parser (Maybe Bool) -> Parser (Maybe Bool) -> Parser (Maybe Bool)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Bool -> Parser (Maybe Bool)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Bool
forall a. Maybe a
Nothing
data LooperEnvironment = LooperEnvironment
{ LooperEnvironment -> Maybe Bool
looperEnvEnabled :: Maybe Bool,
LooperEnvironment -> Maybe Word
looperEnvPhase :: Maybe Word,
LooperEnvironment -> Maybe Word
looperEnvPeriod :: Maybe Word
}
deriving (Int -> LooperEnvironment -> ShowS
[LooperEnvironment] -> ShowS
LooperEnvironment -> String
(Int -> LooperEnvironment -> ShowS)
-> (LooperEnvironment -> String)
-> ([LooperEnvironment] -> ShowS)
-> Show LooperEnvironment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LooperEnvironment] -> ShowS
$cshowList :: [LooperEnvironment] -> ShowS
show :: LooperEnvironment -> String
$cshow :: LooperEnvironment -> String
showsPrec :: Int -> LooperEnvironment -> ShowS
$cshowsPrec :: Int -> LooperEnvironment -> ShowS
Show, LooperEnvironment -> LooperEnvironment -> Bool
(LooperEnvironment -> LooperEnvironment -> Bool)
-> (LooperEnvironment -> LooperEnvironment -> Bool)
-> Eq LooperEnvironment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LooperEnvironment -> LooperEnvironment -> Bool
$c/= :: LooperEnvironment -> LooperEnvironment -> Bool
== :: LooperEnvironment -> LooperEnvironment -> Bool
$c== :: LooperEnvironment -> LooperEnvironment -> Bool
Eq, (forall x. LooperEnvironment -> Rep LooperEnvironment x)
-> (forall x. Rep LooperEnvironment x -> LooperEnvironment)
-> Generic LooperEnvironment
forall x. Rep LooperEnvironment x -> LooperEnvironment
forall x. LooperEnvironment -> Rep LooperEnvironment x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LooperEnvironment x -> LooperEnvironment
$cfrom :: forall x. LooperEnvironment -> Rep LooperEnvironment x
Generic)
getLooperEnvironment ::
String ->
String ->
IO LooperEnvironment
getLooperEnvironment :: String -> String -> IO LooperEnvironment
getLooperEnvironment String
prefix String
name = String -> String -> [(String, String)] -> LooperEnvironment
readLooperEnvironment String
prefix String
name ([(String, String)] -> LooperEnvironment)
-> IO [(String, String)] -> IO LooperEnvironment
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [(String, String)]
System.getEnvironment
readLooperEnvironment ::
String ->
String ->
[(String, String)] ->
LooperEnvironment
readLooperEnvironment :: String -> String -> [(String, String)] -> LooperEnvironment
readLooperEnvironment String
prefix String
name [(String, String)]
env = case Parser Error LooperEnvironment
-> [(String, String)] -> Either [(String, Error)] LooperEnvironment
forall e a.
Parser e a -> [(String, String)] -> Either [(String, e)] a
Env.parsePure (String
-> Parser Error LooperEnvironment -> Parser Error LooperEnvironment
forall e a. String -> Parser e a -> Parser e a
Env.prefixed String
prefix (Parser Error LooperEnvironment -> Parser Error LooperEnvironment)
-> Parser Error LooperEnvironment -> Parser Error LooperEnvironment
forall a b. (a -> b) -> a -> b
$ String -> Parser Error LooperEnvironment
looperEnvironmentParser String
name) [(String, String)]
env of
Left [(String, Error)]
_ -> String -> LooperEnvironment
forall a. HasCallStack => String -> a
error String
"This indicates a bug in looper because all environment variables are optional."
Right LooperEnvironment
r -> LooperEnvironment
r
looperEnvironmentParser ::
String ->
Env.Parser Env.Error LooperEnvironment
looperEnvironmentParser :: String -> Parser Error LooperEnvironment
looperEnvironmentParser String
name =
String
-> Parser Error LooperEnvironment -> Parser Error LooperEnvironment
forall e a. String -> Parser e a -> Parser e a
Env.prefixed (String
name String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"_") (Parser Error LooperEnvironment -> Parser Error LooperEnvironment)
-> Parser Error LooperEnvironment -> Parser Error LooperEnvironment
forall a b. (a -> b) -> a -> b
$
Maybe Bool -> Maybe Word -> Maybe Word -> LooperEnvironment
LooperEnvironment
(Maybe Bool -> Maybe Word -> Maybe Word -> LooperEnvironment)
-> Parser Error (Maybe Bool)
-> Parser Error (Maybe Word -> Maybe Word -> LooperEnvironment)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Reader Error (Maybe Bool)
-> String -> Mod Var (Maybe Bool) -> Parser Error (Maybe Bool)
forall e a.
AsUnset e =>
Reader e a -> String -> Mod Var a -> Parser e a
Env.var ((Bool -> Maybe Bool)
-> Either Error Bool -> Either Error (Maybe Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Maybe Bool
forall a. a -> Maybe a
Just (Either Error Bool -> Either Error (Maybe Bool))
-> (String -> Either Error Bool) -> Reader Error (Maybe Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either Error Bool
forall e a. (AsUnread e, Read a) => Reader e a
Env.auto) String
"ENABLED" (Maybe Bool -> Mod Var (Maybe Bool)
forall a. a -> Mod Var a
Env.def Maybe Bool
forall a. Maybe a
Nothing Mod Var (Maybe Bool)
-> Mod Var (Maybe Bool) -> Mod Var (Maybe Bool)
forall a. Semigroup a => a -> a -> a
<> String -> Mod Var (Maybe Bool)
forall (t :: * -> *) a. HasHelp t => String -> Mod t a
Env.help String
"Whether to enable this looper")
Parser Error (Maybe Word -> Maybe Word -> LooperEnvironment)
-> Parser Error (Maybe Word)
-> Parser Error (Maybe Word -> LooperEnvironment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Reader Error (Maybe Word)
-> String -> Mod Var (Maybe Word) -> Parser Error (Maybe Word)
forall e a.
AsUnset e =>
Reader e a -> String -> Mod Var a -> Parser e a
Env.var ((Word -> Maybe Word)
-> Either Error Word -> Either Error (Maybe Word)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word -> Maybe Word
forall a. a -> Maybe a
Just (Either Error Word -> Either Error (Maybe Word))
-> (String -> Either Error Word) -> Reader Error (Maybe Word)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either Error Word
forall e a. (AsUnread e, Read a) => Reader e a
Env.auto) String
"PHASE" (Maybe Word -> Mod Var (Maybe Word)
forall a. a -> Mod Var a
Env.def Maybe Word
forall a. Maybe a
Nothing Mod Var (Maybe Word)
-> Mod Var (Maybe Word) -> Mod Var (Maybe Word)
forall a. Semigroup a => a -> a -> a
<> String -> Mod Var (Maybe Word)
forall (t :: * -> *) a. HasHelp t => String -> Mod t a
Env.help String
"The amount of time to wait before starting the looper the first time, in seconds")
Parser Error (Maybe Word -> LooperEnvironment)
-> Parser Error (Maybe Word) -> Parser Error LooperEnvironment
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Reader Error (Maybe Word)
-> String -> Mod Var (Maybe Word) -> Parser Error (Maybe Word)
forall e a.
AsUnset e =>
Reader e a -> String -> Mod Var a -> Parser e a
Env.var ((Word -> Maybe Word)
-> Either Error Word -> Either Error (Maybe Word)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word -> Maybe Word
forall a. a -> Maybe a
Just (Either Error Word -> Either Error (Maybe Word))
-> (String -> Either Error Word) -> Reader Error (Maybe Word)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either Error Word
forall e a. (AsUnread e, Read a) => Reader e a
Env.auto) String
"PERIOD" (Maybe Word -> Mod Var (Maybe Word)
forall a. a -> Mod Var a
Env.def Maybe Word
forall a. Maybe a
Nothing Mod Var (Maybe Word)
-> Mod Var (Maybe Word) -> Mod Var (Maybe Word)
forall a. Semigroup a => a -> a -> a
<> String -> Mod Var (Maybe Word)
forall (t :: * -> *) a. HasHelp t => String -> Mod t a
Env.help String
"The amount of time to wait between runs of the looper, in seconds")
data LooperConfiguration = LooperConfiguration
{ LooperConfiguration -> Maybe Bool
looperConfEnabled :: Maybe Bool,
LooperConfiguration -> Maybe Word
looperConfPhase :: Maybe Word,
LooperConfiguration -> Maybe Word
looperConfPeriod :: Maybe Word
}
deriving stock (Int -> LooperConfiguration -> ShowS
[LooperConfiguration] -> ShowS
LooperConfiguration -> String
(Int -> LooperConfiguration -> ShowS)
-> (LooperConfiguration -> String)
-> ([LooperConfiguration] -> ShowS)
-> Show LooperConfiguration
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LooperConfiguration] -> ShowS
$cshowList :: [LooperConfiguration] -> ShowS
show :: LooperConfiguration -> String
$cshow :: LooperConfiguration -> String
showsPrec :: Int -> LooperConfiguration -> ShowS
$cshowsPrec :: Int -> LooperConfiguration -> ShowS
Show, LooperConfiguration -> LooperConfiguration -> Bool
(LooperConfiguration -> LooperConfiguration -> Bool)
-> (LooperConfiguration -> LooperConfiguration -> Bool)
-> Eq LooperConfiguration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LooperConfiguration -> LooperConfiguration -> Bool
$c/= :: LooperConfiguration -> LooperConfiguration -> Bool
== :: LooperConfiguration -> LooperConfiguration -> Bool
$c== :: LooperConfiguration -> LooperConfiguration -> Bool
Eq, (forall x. LooperConfiguration -> Rep LooperConfiguration x)
-> (forall x. Rep LooperConfiguration x -> LooperConfiguration)
-> Generic LooperConfiguration
forall x. Rep LooperConfiguration x -> LooperConfiguration
forall x. LooperConfiguration -> Rep LooperConfiguration x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LooperConfiguration x -> LooperConfiguration
$cfrom :: forall x. LooperConfiguration -> Rep LooperConfiguration x
Generic)
deriving (Value -> Parser [LooperConfiguration]
Value -> Parser LooperConfiguration
(Value -> Parser LooperConfiguration)
-> (Value -> Parser [LooperConfiguration])
-> FromJSON LooperConfiguration
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [LooperConfiguration]
$cparseJSONList :: Value -> Parser [LooperConfiguration]
parseJSON :: Value -> Parser LooperConfiguration
$cparseJSON :: Value -> Parser LooperConfiguration
FromJSON, [LooperConfiguration] -> Encoding
[LooperConfiguration] -> Value
LooperConfiguration -> Encoding
LooperConfiguration -> Value
(LooperConfiguration -> Value)
-> (LooperConfiguration -> Encoding)
-> ([LooperConfiguration] -> Value)
-> ([LooperConfiguration] -> Encoding)
-> ToJSON LooperConfiguration
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [LooperConfiguration] -> Encoding
$ctoEncodingList :: [LooperConfiguration] -> Encoding
toJSONList :: [LooperConfiguration] -> Value
$ctoJSONList :: [LooperConfiguration] -> Value
toEncoding :: LooperConfiguration -> Encoding
$ctoEncoding :: LooperConfiguration -> Encoding
toJSON :: LooperConfiguration -> Value
$ctoJSON :: LooperConfiguration -> Value
ToJSON) via (Autodocodec LooperConfiguration)
instance HasCodec LooperConfiguration where
codec :: JSONCodec LooperConfiguration
codec =
Text
-> JSONCodec LooperConfiguration -> JSONCodec LooperConfiguration
forall input output.
Text -> ValueCodec input output -> ValueCodec input output
named Text
"LooperConfiguration" (JSONCodec LooperConfiguration -> JSONCodec LooperConfiguration)
-> JSONCodec LooperConfiguration -> JSONCodec LooperConfiguration
forall a b. (a -> b) -> a -> b
$
Text
-> ObjectCodec LooperConfiguration LooperConfiguration
-> JSONCodec LooperConfiguration
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
object Text
"LooperConfiguration" (ObjectCodec LooperConfiguration LooperConfiguration
-> JSONCodec LooperConfiguration)
-> ObjectCodec LooperConfiguration LooperConfiguration
-> JSONCodec LooperConfiguration
forall a b. (a -> b) -> a -> b
$
Maybe Bool -> Maybe Word -> Maybe Word -> LooperConfiguration
LooperConfiguration
(Maybe Bool -> Maybe Word -> Maybe Word -> LooperConfiguration)
-> Codec Object LooperConfiguration (Maybe Bool)
-> Codec
Object
LooperConfiguration
(Maybe Word -> Maybe Word -> LooperConfiguration)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Codec Object (Maybe Bool) (Maybe Bool)
-> Codec Object (Maybe Bool) (Maybe Bool)
-> Codec Object (Maybe Bool) (Maybe Bool)
forall context input output input'.
Codec context input output
-> Codec context input' output -> Codec context input output
parseAlternative
(Text -> Text -> Codec Object (Maybe Bool) (Maybe Bool)
forall output.
HasCodec output =>
Text -> Text -> ObjectCodec (Maybe output) (Maybe output)
optionalFieldOrNull Text
"enable" Text
"Enable this looper")
(Text -> Text -> Codec Object (Maybe Bool) (Maybe Bool)
forall output.
HasCodec output =>
Text -> Text -> ObjectCodec (Maybe output) (Maybe output)
optionalFieldOrNull Text
"enabled" Text
"Enable this looper")
Codec Object (Maybe Bool) (Maybe Bool)
-> (LooperConfiguration -> Maybe Bool)
-> Codec Object LooperConfiguration (Maybe Bool)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= LooperConfiguration -> Maybe Bool
looperConfEnabled
Codec
Object
LooperConfiguration
(Maybe Word -> Maybe Word -> LooperConfiguration)
-> Codec Object LooperConfiguration (Maybe Word)
-> Codec
Object LooperConfiguration (Maybe Word -> LooperConfiguration)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Text -> ObjectCodec (Maybe Word) (Maybe Word)
forall output.
HasCodec output =>
Text -> Text -> ObjectCodec (Maybe output) (Maybe output)
optionalFieldOrNull Text
"phase" Text
"The amount of time to wait before starting the looper the first time, in seconds" ObjectCodec (Maybe Word) (Maybe Word)
-> (LooperConfiguration -> Maybe Word)
-> Codec Object LooperConfiguration (Maybe Word)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= LooperConfiguration -> Maybe Word
looperConfPhase
Codec
Object LooperConfiguration (Maybe Word -> LooperConfiguration)
-> Codec Object LooperConfiguration (Maybe Word)
-> ObjectCodec LooperConfiguration LooperConfiguration
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Text -> ObjectCodec (Maybe Word) (Maybe Word)
forall output.
HasCodec output =>
Text -> Text -> ObjectCodec (Maybe output) (Maybe output)
optionalFieldOrNull Text
"period" Text
"The amount of time to wait between runs of the looper, in seconds" ObjectCodec (Maybe Word) (Maybe Word)
-> (LooperConfiguration -> Maybe Word)
-> Codec Object LooperConfiguration (Maybe Word)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= LooperConfiguration -> Maybe Word
looperConfPeriod
data LooperSettings = LooperSettings
{ LooperSettings -> Bool
looperSetEnabled :: Bool,
LooperSettings -> NominalDiffTime
looperSetPhase :: NominalDiffTime,
LooperSettings -> NominalDiffTime
looperSetPeriod :: NominalDiffTime
}
deriving (Int -> LooperSettings -> ShowS
[LooperSettings] -> ShowS
LooperSettings -> String
(Int -> LooperSettings -> ShowS)
-> (LooperSettings -> String)
-> ([LooperSettings] -> ShowS)
-> Show LooperSettings
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LooperSettings] -> ShowS
$cshowList :: [LooperSettings] -> ShowS
show :: LooperSettings -> String
$cshow :: LooperSettings -> String
showsPrec :: Int -> LooperSettings -> ShowS
$cshowsPrec :: Int -> LooperSettings -> ShowS
Show, LooperSettings -> LooperSettings -> Bool
(LooperSettings -> LooperSettings -> Bool)
-> (LooperSettings -> LooperSettings -> Bool) -> Eq LooperSettings
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LooperSettings -> LooperSettings -> Bool
$c/= :: LooperSettings -> LooperSettings -> Bool
== :: LooperSettings -> LooperSettings -> Bool
$c== :: LooperSettings -> LooperSettings -> Bool
Eq, (forall x. LooperSettings -> Rep LooperSettings x)
-> (forall x. Rep LooperSettings x -> LooperSettings)
-> Generic LooperSettings
forall x. Rep LooperSettings x -> LooperSettings
forall x. LooperSettings -> Rep LooperSettings x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LooperSettings x -> LooperSettings
$cfrom :: forall x. LooperSettings -> Rep LooperSettings x
Generic)
deriveLooperSettings ::
NominalDiffTime ->
NominalDiffTime ->
LooperFlags ->
LooperEnvironment ->
Maybe LooperConfiguration ->
LooperSettings
deriveLooperSettings :: NominalDiffTime
-> NominalDiffTime
-> LooperFlags
-> LooperEnvironment
-> Maybe LooperConfiguration
-> LooperSettings
deriveLooperSettings NominalDiffTime
defaultPhase NominalDiffTime
defaultPeriod LooperFlags {Maybe Bool
Maybe Word
looperFlagPeriod :: Maybe Word
looperFlagPhase :: Maybe Word
looperFlagEnabled :: Maybe Bool
looperFlagPeriod :: LooperFlags -> Maybe Word
looperFlagPhase :: LooperFlags -> Maybe Word
looperFlagEnabled :: LooperFlags -> Maybe Bool
..} LooperEnvironment {Maybe Bool
Maybe Word
looperEnvPeriod :: Maybe Word
looperEnvPhase :: Maybe Word
looperEnvEnabled :: Maybe Bool
looperEnvPeriod :: LooperEnvironment -> Maybe Word
looperEnvPhase :: LooperEnvironment -> Maybe Word
looperEnvEnabled :: LooperEnvironment -> Maybe Bool
..} Maybe LooperConfiguration
mlc =
let looperSetEnabled :: Bool
looperSetEnabled =
Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
True (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Maybe Bool
looperFlagEnabled Maybe Bool -> Maybe Bool -> Maybe Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Bool
looperEnvEnabled Maybe Bool -> Maybe Bool -> Maybe Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Maybe LooperConfiguration
mlc Maybe LooperConfiguration
-> (LooperConfiguration -> Maybe Bool) -> Maybe Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= LooperConfiguration -> Maybe Bool
looperConfEnabled)
looperSetPhase :: NominalDiffTime
looperSetPhase =
NominalDiffTime
-> (Word -> NominalDiffTime) -> Maybe Word -> NominalDiffTime
forall b a. b -> (a -> b) -> Maybe a -> b
maybe NominalDiffTime
defaultPhase Word -> NominalDiffTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Maybe Word -> NominalDiffTime) -> Maybe Word -> NominalDiffTime
forall a b. (a -> b) -> a -> b
$
Maybe Word
looperFlagPhase Maybe Word -> Maybe Word -> Maybe Word
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Word
looperEnvPhase Maybe Word -> Maybe Word -> Maybe Word
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Maybe LooperConfiguration
mlc Maybe LooperConfiguration
-> (LooperConfiguration -> Maybe Word) -> Maybe Word
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= LooperConfiguration -> Maybe Word
looperConfPhase)
looperSetPeriod :: NominalDiffTime
looperSetPeriod =
NominalDiffTime
-> (Word -> NominalDiffTime) -> Maybe Word -> NominalDiffTime
forall b a. b -> (a -> b) -> Maybe a -> b
maybe NominalDiffTime
defaultPeriod Word -> NominalDiffTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Maybe Word -> NominalDiffTime) -> Maybe Word -> NominalDiffTime
forall a b. (a -> b) -> a -> b
$
Maybe Word
looperFlagPeriod Maybe Word -> Maybe Word -> Maybe Word
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Word
looperEnvPeriod Maybe Word -> Maybe Word -> Maybe Word
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Maybe LooperConfiguration
mlc Maybe LooperConfiguration
-> (LooperConfiguration -> Maybe Word) -> Maybe Word
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= LooperConfiguration -> Maybe Word
looperConfPeriod)
in LooperSettings :: Bool -> NominalDiffTime -> NominalDiffTime -> LooperSettings
LooperSettings {Bool
NominalDiffTime
looperSetPeriod :: NominalDiffTime
looperSetPhase :: NominalDiffTime
looperSetEnabled :: Bool
looperSetPeriod :: NominalDiffTime
looperSetPhase :: NominalDiffTime
looperSetEnabled :: Bool
..}
mkLooperDef ::
Text ->
LooperSettings ->
m () ->
LooperDef m
mkLooperDef :: Text -> LooperSettings -> m () -> LooperDef m
mkLooperDef Text
name LooperSettings {Bool
NominalDiffTime
looperSetPeriod :: NominalDiffTime
looperSetPhase :: NominalDiffTime
looperSetEnabled :: Bool
looperSetPeriod :: LooperSettings -> NominalDiffTime
looperSetPhase :: LooperSettings -> NominalDiffTime
looperSetEnabled :: LooperSettings -> Bool
..} m ()
func =
LooperDef :: forall (m :: * -> *).
Text
-> Bool
-> NominalDiffTime
-> NominalDiffTime
-> m ()
-> LooperDef m
LooperDef
{ looperDefName :: Text
looperDefName = Text
name,
looperDefEnabled :: Bool
looperDefEnabled = Bool
looperSetEnabled,
looperDefPeriod :: NominalDiffTime
looperDefPeriod = NominalDiffTime
looperSetPeriod,
looperDefPhase :: NominalDiffTime
looperDefPhase = NominalDiffTime
looperSetPhase,
looperDefFunc :: m ()
looperDefFunc = m ()
func
}
runLoopers :: MonadUnliftIO m => [LooperDef m] -> m ()
runLoopers :: [LooperDef m] -> m ()
runLoopers = (LooperDef m -> m ()) -> [LooperDef m] -> m ()
forall (m :: * -> *) (n :: * -> *).
(MonadUnliftIO m, MonadUnliftIO n) =>
(LooperDef m -> n ()) -> [LooperDef m] -> n ()
runLoopersIgnoreOverrun LooperDef m -> m ()
forall (m :: * -> *). LooperDef m -> m ()
looperDefFunc
runLoopersIgnoreOverrun ::
(MonadUnliftIO m, MonadUnliftIO n) =>
(LooperDef m -> n ()) ->
[LooperDef m] ->
n ()
runLoopersIgnoreOverrun :: (LooperDef m -> n ()) -> [LooperDef m] -> n ()
runLoopersIgnoreOverrun = (LooperDef m -> n ())
-> (LooperDef m -> n ()) -> [LooperDef m] -> n ()
forall (m :: * -> *) (n :: * -> *).
(MonadUnliftIO m, MonadUnliftIO n) =>
(LooperDef m -> n ())
-> (LooperDef m -> n ()) -> [LooperDef m] -> n ()
runLoopersRaw (n () -> LooperDef m -> n ()
forall a b. a -> b -> a
const (n () -> LooperDef m -> n ()) -> n () -> LooperDef m -> n ()
forall a b. (a -> b) -> a -> b
$ () -> n ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
runLoopersRaw ::
(MonadUnliftIO m, MonadUnliftIO n) =>
(LooperDef m -> n ()) ->
(LooperDef m -> n ()) ->
[LooperDef m] ->
n ()
runLoopersRaw :: (LooperDef m -> n ())
-> (LooperDef m -> n ()) -> [LooperDef m] -> n ()
runLoopersRaw LooperDef m -> n ()
onOverrun LooperDef m -> n ()
runLooper =
(LooperDef m -> n ()) -> [LooperDef m] -> n ()
forall (m :: * -> *) (f :: * -> *) a b.
(MonadUnliftIO m, Foldable f) =>
(a -> m b) -> f a -> m ()
mapConcurrently_ ((LooperDef m -> n ()) -> [LooperDef m] -> n ())
-> (LooperDef m -> n ()) -> [LooperDef m] -> n ()
forall a b. (a -> b) -> a -> b
$ \ld :: LooperDef m
ld@LooperDef {m ()
Bool
Text
NominalDiffTime
looperDefFunc :: m ()
looperDefPhase :: NominalDiffTime
looperDefPeriod :: NominalDiffTime
looperDefEnabled :: Bool
looperDefName :: Text
looperDefFunc :: forall (m :: * -> *). LooperDef m -> m ()
looperDefPhase :: forall (m :: * -> *). LooperDef m -> NominalDiffTime
looperDefPeriod :: forall (m :: * -> *). LooperDef m -> NominalDiffTime
looperDefEnabled :: forall (m :: * -> *). LooperDef m -> Bool
looperDefName :: forall (m :: * -> *). LooperDef m -> Text
..} ->
Bool -> n () -> n ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
looperDefEnabled (n () -> n ()) -> n () -> n ()
forall a b. (a -> b) -> a -> b
$ do
NominalDiffTime -> n ()
forall (m :: * -> *). MonadIO m => NominalDiffTime -> m ()
waitNominalDiffTime NominalDiffTime
looperDefPhase
let loop :: n b
loop = do
UTCTime
start <- IO UTCTime -> n UTCTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
LooperDef m -> n ()
runLooper LooperDef m
ld
UTCTime
end <- IO UTCTime -> n UTCTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
let elapsed :: NominalDiffTime
elapsed = UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime UTCTime
end UTCTime
start
let nextWait :: NominalDiffTime
nextWait = NominalDiffTime
looperDefPeriod NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
- NominalDiffTime
elapsed
if NominalDiffTime
nextWait NominalDiffTime -> NominalDiffTime -> Bool
forall a. Ord a => a -> a -> Bool
< NominalDiffTime
0
then LooperDef m -> n ()
onOverrun LooperDef m
ld
else NominalDiffTime -> n ()
forall (m :: * -> *). MonadIO m => NominalDiffTime -> m ()
waitNominalDiffTime NominalDiffTime
nextWait
n b
loop
n ()
forall b. n b
loop
waitNominalDiffTime :: MonadIO m => NominalDiffTime -> m ()
waitNominalDiffTime :: NominalDiffTime -> m ()
waitNominalDiffTime NominalDiffTime
ndt = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Int -> IO ()
forall (m :: * -> *). MonadIO m => Int -> m ()
threadDelay (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ Rational -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (NominalDiffTime -> Rational
forall a. Real a => a -> Rational
toRational NominalDiffTime
ndt Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* (Rational
1000 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
1000))