{-# 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

-- | A looper definition
data LooperDef m = LooperDef
  { -- | The name of the looper, can be useful for logging
    LooperDef m -> Text
looperDefName :: Text,
    -- | Whether this looper is enabled
    LooperDef m -> Bool
looperDefEnabled :: Bool,
    -- | The time between the start of each run
    LooperDef m -> NominalDiffTime
looperDefPeriod :: NominalDiffTime,
    -- | The time before the first run
    LooperDef m -> NominalDiffTime
looperDefPhase :: NominalDiffTime,
    -- | The function to run
    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)

-- | Construct a 'NominalDiffTime' from a number of seconds
seconds :: Double -> NominalDiffTime
seconds :: Double -> NominalDiffTime
seconds = Double -> NominalDiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac

-- | Construct a 'NominalDiffTime' from a number of minutes
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)

-- | Construct a 'NominalDiffTime' from a number of hours
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)

-- | A structure to parse command-line flags for a looper into
data LooperFlags = LooperFlags
  { LooperFlags -> Maybe Bool
looperFlagEnabled :: Maybe Bool,
    LooperFlags -> Maybe Word
looperFlagPhase :: Maybe Word, -- Seconds
    LooperFlags -> Maybe Word
looperFlagPeriod :: Maybe Word -- Seconds
  }
  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)

-- | An optparse applicative parser for 'LooperFlags'
getLooperFlags ::
  -- | The name of the looper (best to make this all-lowercase)
  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

-- | A structure to parse environment variables for a looper into
data LooperEnvironment = LooperEnvironment
  { LooperEnvironment -> Maybe Bool
looperEnvEnabled :: Maybe Bool,
    LooperEnvironment -> Maybe Word
looperEnvPhase :: Maybe Word, -- Seconds
    LooperEnvironment -> Maybe Word
looperEnvPeriod :: Maybe Word -- Seconds
  }
  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)

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

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

-- | An 'envparse' parser for a 'LooperEnvironment'
looperEnvironmentParser ::
  -- | Name of the looper (best to make this all-caps)
  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")

-- | A structure to configuration for a looper into
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

-- | Settings that you might want to pass into a looper using 'mkLooperDef'
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 ::
  -- | Default phase
  NominalDiffTime ->
  -- | Default period
  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 ::
  -- | Name
  Text ->
  LooperSettings ->
  -- | The function to loop
  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
    }

-- | Simply run loopers
--
-- > runLoopers = runLoopersIgnoreOverrun looperDefFunc
--
-- see 'runLoopersIgnoreOverrun'
--
-- Note that this function will loop forever, you need to wrap it using 'async' yourself.
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

-- | Run loopers with a custom runner, ignoring any overruns
--
-- > runLoopersIgnoreOverrun = runLoopersRaw (pure ())
--
-- see 'runLoopersRaw'
--
-- Note that this function will loop forever, you need to wrap it using 'async' yourself.
runLoopersIgnoreOverrun ::
  (MonadUnliftIO m, MonadUnliftIO n) =>
  -- | Custom runner
  (LooperDef m -> n ()) ->
  -- | Loopers
  [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 ())

-- | Run loopers, with a custom runner and overrun handler
--
-- * The overrun handler is run when the looper function takes longer than its period.
--   You can use this to log a warning, for example.
--
-- * The runner function is used to run the looper function
--   You can use 'looperDefFunc' @ :: LooperDef m -> m ()@ to run a 'LooperDef', and you
--   can wrap this function in some custom logic before you pass it into 'runLoopersRaw'
--   In this manner you can add logging or metrics, for example.
--
-- Note that this function will loop forever, you need to wrap it using 'async' yourself.
runLoopersRaw ::
  (MonadUnliftIO m, MonadUnliftIO n) =>
  -- | Overrun handler
  (LooperDef m -> n ()) ->
  -- | Runner
  (LooperDef m -> n ()) ->
  -- | Loopers
  [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

-- | Wait for a given 'NominalDiffTime'
--
-- 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 :: 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))