module Postgres.Settings
  ( Settings
      ( Settings,
        pgConnection,
        pgPool,
        pgQueryTimeout
      ),
    ConnectionSettings
      ( ConnectionSettings,
        pgDatabase,
        pgUser,
        pgHost,
        pgPassword,
        pgPort
      ),
    PoolSettings
      ( PoolSettings,
        pgPoolStripes,
        pgPoolMaxIdleTime,
        pgPoolSize
      ),
    decoder,
    decoderWithPrefix,
    PgDatabase (PgDatabase, unPgDatabase),
    PgUser (PgUser, unPgUser),
    PgHost (PgHost, unPgHost),
    PgPassword (PgPassword, unPgPassword),
    PgPort (PgPort, unPgPort),
    PgPoolStripes (PgPoolStripes, unPgPoolStripes),
    PgPoolMaxIdleTime (PgPoolMaxIdleTime, unPgPoolMaxIdleTime),
    PgPoolSize (PgPoolSize, unPgPoolSize),
    defaultSettings,
    toPGDatabase,
  )
where

import qualified Data.ByteString.Char8
import qualified Data.Text.Encoding
import qualified Data.Time
import Database.PostgreSQL.Typed
  ( PGDatabase,
    defaultPGDatabase,
    pgDBAddr,
    pgDBName,
    pgDBParams,
    pgDBPass,
    pgDBUser,
  )
import qualified Environment
import qualified Log
import Network.Socket (SockAddr (SockAddrUnix))
import qualified Postgres.Time as Time
import System.FilePath ((</>))
import Prelude (Either (Left, Right), pure, realToFrac, round, show)

-- | Postgres connection details. You can use 'decoder' to create one of these.
data Settings = Settings
  { Settings -> ConnectionSettings
pgConnection :: ConnectionSettings,
    Settings -> PoolSettings
pgPool :: PoolSettings,
    Settings -> Interval
pgQueryTimeout :: Time.Interval
  }
  deriving (Settings -> Settings -> Bool
(Settings -> Settings -> Bool)
-> (Settings -> Settings -> Bool) -> Eq Settings
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Settings -> Settings -> Bool
$c/= :: Settings -> Settings -> Bool
== :: Settings -> Settings -> Bool
$c== :: Settings -> Settings -> Bool
Eq, Int -> Settings -> ShowS
[Settings] -> ShowS
Settings -> String
(Int -> Settings -> ShowS)
-> (Settings -> String) -> ([Settings] -> ShowS) -> Show Settings
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Settings] -> ShowS
$cshowList :: [Settings] -> ShowS
show :: Settings -> String
$cshow :: Settings -> String
showsPrec :: Int -> Settings -> ShowS
$cshowsPrec :: Int -> Settings -> ShowS
Show)

defaultSettings :: Settings
defaultSettings :: Settings
defaultSettings =
  Settings :: ConnectionSettings -> PoolSettings -> Interval -> Settings
Settings
    { pgConnection :: ConnectionSettings
pgConnection =
        ConnectionSettings :: PgDatabase
-> PgUser -> PgHost -> PgPassword -> PgPort -> ConnectionSettings
ConnectionSettings
          { pgDatabase :: PgDatabase
pgDatabase = Text -> PgDatabase
PgDatabase Text
"postgres",
            pgUser :: PgUser
pgUser = Text -> PgUser
PgUser Text
"postgres",
            pgHost :: PgHost
pgHost = Text -> PgHost
PgHost Text
"localhost",
            pgPassword :: PgPassword
pgPassword = Secret Text -> PgPassword
PgPassword (Text -> Secret Text
forall a. a -> Secret a
Log.mkSecret Text
""),
            pgPort :: PgPort
pgPort = Int -> PgPort
PgPort Int
5432
          },
      pgPool :: PoolSettings
pgPool =
        PoolSettings :: PgPoolSize -> PgPoolMaxIdleTime -> PgPoolStripes -> PoolSettings
PoolSettings
          { pgPoolSize :: PgPoolSize
pgPoolSize =
              -- Connections in the pool are allocated on demand, so we won't
              -- create all these connections unless the application can make use
              -- of them.
              Int -> PgPoolSize
PgPoolSize Int
500,
            pgPoolMaxIdleTime :: PgPoolMaxIdleTime
pgPoolMaxIdleTime = NominalDiffTime -> PgPoolMaxIdleTime
PgPoolMaxIdleTime (Int -> NominalDiffTime
toNominalDiffTime Int
3600),
            pgPoolStripes :: PgPoolStripes
pgPoolStripes = Int -> PgPoolStripes
PgPoolStripes Int
1
          },
      pgQueryTimeout :: Interval
pgQueryTimeout = Float -> Interval
Time.fromSeconds Float
5
    }

data ConnectionSettings = ConnectionSettings
  { ConnectionSettings -> PgDatabase
pgDatabase :: PgDatabase,
    ConnectionSettings -> PgUser
pgUser :: PgUser,
    ConnectionSettings -> PgHost
pgHost :: PgHost,
    ConnectionSettings -> PgPassword
pgPassword :: PgPassword,
    ConnectionSettings -> PgPort
pgPort :: PgPort
  }
  deriving (ConnectionSettings -> ConnectionSettings -> Bool
(ConnectionSettings -> ConnectionSettings -> Bool)
-> (ConnectionSettings -> ConnectionSettings -> Bool)
-> Eq ConnectionSettings
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConnectionSettings -> ConnectionSettings -> Bool
$c/= :: ConnectionSettings -> ConnectionSettings -> Bool
== :: ConnectionSettings -> ConnectionSettings -> Bool
$c== :: ConnectionSettings -> ConnectionSettings -> Bool
Eq, Int -> ConnectionSettings -> ShowS
[ConnectionSettings] -> ShowS
ConnectionSettings -> String
(Int -> ConnectionSettings -> ShowS)
-> (ConnectionSettings -> String)
-> ([ConnectionSettings] -> ShowS)
-> Show ConnectionSettings
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConnectionSettings] -> ShowS
$cshowList :: [ConnectionSettings] -> ShowS
show :: ConnectionSettings -> String
$cshow :: ConnectionSettings -> String
showsPrec :: Int -> ConnectionSettings -> ShowS
$cshowsPrec :: Int -> ConnectionSettings -> ShowS
Show)

data PoolSettings = PoolSettings
  { PoolSettings -> PgPoolSize
pgPoolSize :: PgPoolSize,
    PoolSettings -> PgPoolMaxIdleTime
pgPoolMaxIdleTime :: PgPoolMaxIdleTime,
    PoolSettings -> PgPoolStripes
pgPoolStripes :: PgPoolStripes
  }
  deriving (PoolSettings -> PoolSettings -> Bool
(PoolSettings -> PoolSettings -> Bool)
-> (PoolSettings -> PoolSettings -> Bool) -> Eq PoolSettings
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PoolSettings -> PoolSettings -> Bool
$c/= :: PoolSettings -> PoolSettings -> Bool
== :: PoolSettings -> PoolSettings -> Bool
$c== :: PoolSettings -> PoolSettings -> Bool
Eq, Int -> PoolSettings -> ShowS
[PoolSettings] -> ShowS
PoolSettings -> String
(Int -> PoolSettings -> ShowS)
-> (PoolSettings -> String)
-> ([PoolSettings] -> ShowS)
-> Show PoolSettings
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PoolSettings] -> ShowS
$cshowList :: [PoolSettings] -> ShowS
show :: PoolSettings -> String
$cshow :: PoolSettings -> String
showsPrec :: Int -> PoolSettings -> ShowS
$cshowsPrec :: Int -> PoolSettings -> ShowS
Show)

-- | Create a 'Settings' value by reading settings from environment values.
--
-- [@environment variable@] PGHOST
-- [@default value@] localhost
--
-- [@environment variable@] PGPORT
-- [@default value@] 5432
--
-- [@environment variable@] PGDATABASE
-- [@default value@] postgresql
--
-- [@environment variable@] PGUSER
-- [@default value@] postgresql
--
-- [@environment variable@] PGPASSWORD
-- [@default value@]
--
-- [@environment variable@] PG_POOL_SIZE
-- [@default value@] 500
--
-- [@environment variable@] PG_POOL_STRIPES
-- [@default value@] 1
--
-- [@environment variable@] PG_POOL_MAX_IDLE_TIME
-- [@default value@] 3600
--
-- [@environment variable@] PG_QUERY_TIMEOUT_SECONDS
-- [@default value@] 5
decoder :: Environment.Decoder Settings
decoder :: Decoder Settings
decoder = Text -> Decoder Settings
decoderWithPrefix Text
""

decoderWithPrefix :: Text -> Environment.Decoder Settings
decoderWithPrefix :: Text -> Decoder Settings
decoderWithPrefix Text
prefix =
  (ConnectionSettings -> PoolSettings -> Interval -> Settings)
-> Decoder
     (ConnectionSettings -> PoolSettings -> Interval -> Settings)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ConnectionSettings -> PoolSettings -> Interval -> Settings
Settings
    Decoder
  (ConnectionSettings -> PoolSettings -> Interval -> Settings)
-> (Decoder
      (ConnectionSettings -> PoolSettings -> Interval -> Settings)
    -> Decoder (PoolSettings -> Interval -> Settings))
-> Decoder (PoolSettings -> Interval -> Settings)
forall a b. a -> (a -> b) -> b
|> Decoder ConnectionSettings
-> Decoder
     (ConnectionSettings -> PoolSettings -> Interval -> Settings)
-> Decoder (PoolSettings -> Interval -> Settings)
forall (m :: * -> *) a b. Applicative m => m a -> m (a -> b) -> m b
andMap (Text -> Decoder ConnectionSettings
connectionDecoder Text
prefix)
    Decoder (PoolSettings -> Interval -> Settings)
-> (Decoder (PoolSettings -> Interval -> Settings)
    -> Decoder (Interval -> Settings))
-> Decoder (Interval -> Settings)
forall a b. a -> (a -> b) -> b
|> Decoder PoolSettings
-> Decoder (PoolSettings -> Interval -> Settings)
-> Decoder (Interval -> Settings)
forall (m :: * -> *) a b. Applicative m => m a -> m (a -> b) -> m b
andMap Decoder PoolSettings
poolDecoder
    Decoder (Interval -> Settings)
-> (Decoder (Interval -> Settings) -> Decoder Settings)
-> Decoder Settings
forall a b. a -> (a -> b) -> b
|> Decoder Interval
-> Decoder (Interval -> Settings) -> Decoder Settings
forall (m :: * -> *) a b. Applicative m => m a -> m (a -> b) -> m b
andMap Decoder Interval
queryTimeoutDecoder

connectionDecoder :: Text -> Environment.Decoder ConnectionSettings
connectionDecoder :: Text -> Decoder ConnectionSettings
connectionDecoder Text
prefix =
  (PgDatabase
 -> PgUser -> PgHost -> PgPassword -> PgPort -> ConnectionSettings)
-> Decoder
     (PgDatabase
      -> PgUser -> PgHost -> PgPassword -> PgPort -> ConnectionSettings)
forall (f :: * -> *) a. Applicative f => a -> f a
pure PgDatabase
-> PgUser -> PgHost -> PgPassword -> PgPort -> ConnectionSettings
ConnectionSettings
    Decoder
  (PgDatabase
   -> PgUser -> PgHost -> PgPassword -> PgPort -> ConnectionSettings)
-> (Decoder
      (PgDatabase
       -> PgUser -> PgHost -> PgPassword -> PgPort -> ConnectionSettings)
    -> Decoder
         (PgUser -> PgHost -> PgPassword -> PgPort -> ConnectionSettings))
-> Decoder
     (PgUser -> PgHost -> PgPassword -> PgPort -> ConnectionSettings)
forall a b. a -> (a -> b) -> b
|> Decoder PgDatabase
-> Decoder
     (PgDatabase
      -> PgUser -> PgHost -> PgPassword -> PgPort -> ConnectionSettings)
-> Decoder
     (PgUser -> PgHost -> PgPassword -> PgPort -> ConnectionSettings)
forall (m :: * -> *) a b. Applicative m => m a -> m (a -> b) -> m b
andMap (Text -> Decoder PgDatabase
pgDatabaseDecoder Text
prefix)
    Decoder
  (PgUser -> PgHost -> PgPassword -> PgPort -> ConnectionSettings)
-> (Decoder
      (PgUser -> PgHost -> PgPassword -> PgPort -> ConnectionSettings)
    -> Decoder (PgHost -> PgPassword -> PgPort -> ConnectionSettings))
-> Decoder (PgHost -> PgPassword -> PgPort -> ConnectionSettings)
forall a b. a -> (a -> b) -> b
|> Decoder PgUser
-> Decoder
     (PgUser -> PgHost -> PgPassword -> PgPort -> ConnectionSettings)
-> Decoder (PgHost -> PgPassword -> PgPort -> ConnectionSettings)
forall (m :: * -> *) a b. Applicative m => m a -> m (a -> b) -> m b
andMap (Text -> Decoder PgUser
pgUserDecoder Text
prefix)
    Decoder (PgHost -> PgPassword -> PgPort -> ConnectionSettings)
-> (Decoder (PgHost -> PgPassword -> PgPort -> ConnectionSettings)
    -> Decoder (PgPassword -> PgPort -> ConnectionSettings))
-> Decoder (PgPassword -> PgPort -> ConnectionSettings)
forall a b. a -> (a -> b) -> b
|> Decoder PgHost
-> Decoder (PgHost -> PgPassword -> PgPort -> ConnectionSettings)
-> Decoder (PgPassword -> PgPort -> ConnectionSettings)
forall (m :: * -> *) a b. Applicative m => m a -> m (a -> b) -> m b
andMap (Text -> Decoder PgHost
pgHostDecoder Text
prefix)
    Decoder (PgPassword -> PgPort -> ConnectionSettings)
-> (Decoder (PgPassword -> PgPort -> ConnectionSettings)
    -> Decoder (PgPort -> ConnectionSettings))
-> Decoder (PgPort -> ConnectionSettings)
forall a b. a -> (a -> b) -> b
|> Decoder PgPassword
-> Decoder (PgPassword -> PgPort -> ConnectionSettings)
-> Decoder (PgPort -> ConnectionSettings)
forall (m :: * -> *) a b. Applicative m => m a -> m (a -> b) -> m b
andMap (Text -> Decoder PgPassword
pgPasswordDecoder Text
prefix)
    Decoder (PgPort -> ConnectionSettings)
-> (Decoder (PgPort -> ConnectionSettings)
    -> Decoder ConnectionSettings)
-> Decoder ConnectionSettings
forall a b. a -> (a -> b) -> b
|> Decoder PgPort
-> Decoder (PgPort -> ConnectionSettings)
-> Decoder ConnectionSettings
forall (m :: * -> *) a b. Applicative m => m a -> m (a -> b) -> m b
andMap (Text -> Decoder PgPort
pgPortDecoder Text
prefix)

poolDecoder :: Environment.Decoder PoolSettings
poolDecoder :: Decoder PoolSettings
poolDecoder =
  (PgPoolSize -> PgPoolMaxIdleTime -> PgPoolStripes -> PoolSettings)
-> Decoder
     (PgPoolSize -> PgPoolMaxIdleTime -> PgPoolStripes -> PoolSettings)
forall (f :: * -> *) a. Applicative f => a -> f a
pure PgPoolSize -> PgPoolMaxIdleTime -> PgPoolStripes -> PoolSettings
PoolSettings
    Decoder
  (PgPoolSize -> PgPoolMaxIdleTime -> PgPoolStripes -> PoolSettings)
-> (Decoder
      (PgPoolSize -> PgPoolMaxIdleTime -> PgPoolStripes -> PoolSettings)
    -> Decoder (PgPoolMaxIdleTime -> PgPoolStripes -> PoolSettings))
-> Decoder (PgPoolMaxIdleTime -> PgPoolStripes -> PoolSettings)
forall a b. a -> (a -> b) -> b
|> Decoder PgPoolSize
-> Decoder
     (PgPoolSize -> PgPoolMaxIdleTime -> PgPoolStripes -> PoolSettings)
-> Decoder (PgPoolMaxIdleTime -> PgPoolStripes -> PoolSettings)
forall (m :: * -> *) a b. Applicative m => m a -> m (a -> b) -> m b
andMap Decoder PgPoolSize
pgPoolSizeDecoder
    Decoder (PgPoolMaxIdleTime -> PgPoolStripes -> PoolSettings)
-> (Decoder (PgPoolMaxIdleTime -> PgPoolStripes -> PoolSettings)
    -> Decoder (PgPoolStripes -> PoolSettings))
-> Decoder (PgPoolStripes -> PoolSettings)
forall a b. a -> (a -> b) -> b
|> Decoder PgPoolMaxIdleTime
-> Decoder (PgPoolMaxIdleTime -> PgPoolStripes -> PoolSettings)
-> Decoder (PgPoolStripes -> PoolSettings)
forall (m :: * -> *) a b. Applicative m => m a -> m (a -> b) -> m b
andMap Decoder PgPoolMaxIdleTime
pgPoolMaxIdleTimeDecoder
    Decoder (PgPoolStripes -> PoolSettings)
-> (Decoder (PgPoolStripes -> PoolSettings)
    -> Decoder PoolSettings)
-> Decoder PoolSettings
forall a b. a -> (a -> b) -> b
|> Decoder PgPoolStripes
-> Decoder (PgPoolStripes -> PoolSettings) -> Decoder PoolSettings
forall (m :: * -> *) a b. Applicative m => m a -> m (a -> b) -> m b
andMap Decoder PgPoolStripes
pgPoolStripesDecoder

newtype PgPort = PgPort {PgPort -> Int
unPgPort :: Int}
  deriving (PgPort -> PgPort -> Bool
(PgPort -> PgPort -> Bool)
-> (PgPort -> PgPort -> Bool) -> Eq PgPort
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PgPort -> PgPort -> Bool
$c/= :: PgPort -> PgPort -> Bool
== :: PgPort -> PgPort -> Bool
$c== :: PgPort -> PgPort -> Bool
Eq, Int -> PgPort -> ShowS
[PgPort] -> ShowS
PgPort -> String
(Int -> PgPort -> ShowS)
-> (PgPort -> String) -> ([PgPort] -> ShowS) -> Show PgPort
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PgPort] -> ShowS
$cshowList :: [PgPort] -> ShowS
show :: PgPort -> String
$cshow :: PgPort -> String
showsPrec :: Int -> PgPort -> ShowS
$cshowsPrec :: Int -> PgPort -> ShowS
Show)

pgPortDecoder :: Text -> Environment.Decoder PgPort
pgPortDecoder :: Text -> Decoder PgPort
pgPortDecoder Text
prefix =
  Variable -> Parser PgPort -> Decoder PgPort
forall a. Variable -> Parser a -> Decoder a
Environment.variable
    Variable :: Text -> Text -> Text -> Variable
Environment.Variable
      { name :: Text
Environment.name = Text
prefix Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
"PGPORT",
        description :: Text
Environment.description = Text
"The port postgres is running on.",
        defaultValue :: Text
Environment.defaultValue =
          Settings
defaultSettings Settings -> (Settings -> ConnectionSettings) -> ConnectionSettings
forall a b. a -> (a -> b) -> b
|> Settings -> ConnectionSettings
pgConnection ConnectionSettings -> (ConnectionSettings -> PgPort) -> PgPort
forall a b. a -> (a -> b) -> b
|> ConnectionSettings -> PgPort
pgPort PgPort -> (PgPort -> Int) -> Int
forall a b. a -> (a -> b) -> b
|> PgPort -> Int
unPgPort Int -> (Int -> String) -> String
forall a b. a -> (a -> b) -> b
|> Int -> String
forall a. Show a => a -> String
show String -> (String -> Text) -> Text
forall a b. a -> (a -> b) -> b
|> String -> Text
Text.fromList
      }
    (Parser Int
forall a. Integral a => Parser a
Environment.int Parser Int -> (Parser Int -> Parser PgPort) -> Parser PgPort
forall a b. a -> (a -> b) -> b
|> (Int -> PgPort) -> Parser Int -> Parser PgPort
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map Int -> PgPort
PgPort)

newtype PgPassword = PgPassword {PgPassword -> Secret Text
unPgPassword :: Log.Secret Text}
  deriving (PgPassword -> PgPassword -> Bool
(PgPassword -> PgPassword -> Bool)
-> (PgPassword -> PgPassword -> Bool) -> Eq PgPassword
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PgPassword -> PgPassword -> Bool
$c/= :: PgPassword -> PgPassword -> Bool
== :: PgPassword -> PgPassword -> Bool
$c== :: PgPassword -> PgPassword -> Bool
Eq, Int -> PgPassword -> ShowS
[PgPassword] -> ShowS
PgPassword -> String
(Int -> PgPassword -> ShowS)
-> (PgPassword -> String)
-> ([PgPassword] -> ShowS)
-> Show PgPassword
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PgPassword] -> ShowS
$cshowList :: [PgPassword] -> ShowS
show :: PgPassword -> String
$cshow :: PgPassword -> String
showsPrec :: Int -> PgPassword -> ShowS
$cshowsPrec :: Int -> PgPassword -> ShowS
Show)

pgPasswordDecoder :: Text -> Environment.Decoder PgPassword
pgPasswordDecoder :: Text -> Decoder PgPassword
pgPasswordDecoder Text
prefix =
  Variable -> Parser PgPassword -> Decoder PgPassword
forall a. Variable -> Parser a -> Decoder a
Environment.variable
    Variable :: Text -> Text -> Text -> Variable
Environment.Variable
      { name :: Text
Environment.name = Text
prefix Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
"PGPASSWORD",
        description :: Text
Environment.description = Text
"The postgres user password.",
        defaultValue :: Text
Environment.defaultValue =
          Settings
defaultSettings Settings -> (Settings -> ConnectionSettings) -> ConnectionSettings
forall a b. a -> (a -> b) -> b
|> Settings -> ConnectionSettings
pgConnection ConnectionSettings
-> (ConnectionSettings -> PgPassword) -> PgPassword
forall a b. a -> (a -> b) -> b
|> ConnectionSettings -> PgPassword
pgPassword PgPassword -> (PgPassword -> Secret Text) -> Secret Text
forall a b. a -> (a -> b) -> b
|> PgPassword -> Secret Text
unPgPassword Secret Text -> (Secret Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
|> Secret Text -> Text
forall a. Secret a -> a
Log.unSecret
      }
    (Parser Text -> Parser (Secret Text)
forall a. Parser a -> Parser (Secret a)
Environment.secret Parser Text
Environment.text Parser (Secret Text)
-> (Parser (Secret Text) -> Parser PgPassword) -> Parser PgPassword
forall a b. a -> (a -> b) -> b
|> (Secret Text -> PgPassword)
-> Parser (Secret Text) -> Parser PgPassword
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map Secret Text -> PgPassword
PgPassword)

newtype PgHost = PgHost {PgHost -> Text
unPgHost :: Text}
  deriving (PgHost -> PgHost -> Bool
(PgHost -> PgHost -> Bool)
-> (PgHost -> PgHost -> Bool) -> Eq PgHost
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PgHost -> PgHost -> Bool
$c/= :: PgHost -> PgHost -> Bool
== :: PgHost -> PgHost -> Bool
$c== :: PgHost -> PgHost -> Bool
Eq, Int -> PgHost -> ShowS
[PgHost] -> ShowS
PgHost -> String
(Int -> PgHost -> ShowS)
-> (PgHost -> String) -> ([PgHost] -> ShowS) -> Show PgHost
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PgHost] -> ShowS
$cshowList :: [PgHost] -> ShowS
show :: PgHost -> String
$cshow :: PgHost -> String
showsPrec :: Int -> PgHost -> ShowS
$cshowsPrec :: Int -> PgHost -> ShowS
Show)

pgHostDecoder :: Text -> Environment.Decoder PgHost
pgHostDecoder :: Text -> Decoder PgHost
pgHostDecoder Text
prefix =
  Variable -> Parser PgHost -> Decoder PgHost
forall a. Variable -> Parser a -> Decoder a
Environment.variable
    Variable :: Text -> Text -> Text -> Variable
Environment.Variable
      { name :: Text
Environment.name = Text
prefix Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
"PGHOST",
        description :: Text
Environment.description = Text
"The hostname of the postgres server to connect to.",
        defaultValue :: Text
Environment.defaultValue =
          Settings
defaultSettings Settings -> (Settings -> ConnectionSettings) -> ConnectionSettings
forall a b. a -> (a -> b) -> b
|> Settings -> ConnectionSettings
pgConnection ConnectionSettings -> (ConnectionSettings -> PgHost) -> PgHost
forall a b. a -> (a -> b) -> b
|> ConnectionSettings -> PgHost
pgHost PgHost -> (PgHost -> Text) -> Text
forall a b. a -> (a -> b) -> b
|> PgHost -> Text
unPgHost
      }
    (Parser Text
Environment.text Parser Text -> (Parser Text -> Parser PgHost) -> Parser PgHost
forall a b. a -> (a -> b) -> b
|> (Text -> PgHost) -> Parser Text -> Parser PgHost
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map Text -> PgHost
PgHost)

newtype PgUser = PgUser {PgUser -> Text
unPgUser :: Text}
  deriving (PgUser -> PgUser -> Bool
(PgUser -> PgUser -> Bool)
-> (PgUser -> PgUser -> Bool) -> Eq PgUser
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PgUser -> PgUser -> Bool
$c/= :: PgUser -> PgUser -> Bool
== :: PgUser -> PgUser -> Bool
$c== :: PgUser -> PgUser -> Bool
Eq, Int -> PgUser -> ShowS
[PgUser] -> ShowS
PgUser -> String
(Int -> PgUser -> ShowS)
-> (PgUser -> String) -> ([PgUser] -> ShowS) -> Show PgUser
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PgUser] -> ShowS
$cshowList :: [PgUser] -> ShowS
show :: PgUser -> String
$cshow :: PgUser -> String
showsPrec :: Int -> PgUser -> ShowS
$cshowsPrec :: Int -> PgUser -> ShowS
Show)

pgUserDecoder :: Text -> Environment.Decoder PgUser
pgUserDecoder :: Text -> Decoder PgUser
pgUserDecoder Text
prefix =
  Variable -> Parser PgUser -> Decoder PgUser
forall a. Variable -> Parser a -> Decoder a
Environment.variable
    Variable :: Text -> Text -> Text -> Variable
Environment.Variable
      { name :: Text
Environment.name = Text
prefix Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
"PGUSER",
        description :: Text
Environment.description = Text
"The postgres user to connect with.",
        defaultValue :: Text
Environment.defaultValue =
          Settings
defaultSettings Settings -> (Settings -> ConnectionSettings) -> ConnectionSettings
forall a b. a -> (a -> b) -> b
|> Settings -> ConnectionSettings
pgConnection ConnectionSettings -> (ConnectionSettings -> PgUser) -> PgUser
forall a b. a -> (a -> b) -> b
|> ConnectionSettings -> PgUser
pgUser PgUser -> (PgUser -> Text) -> Text
forall a b. a -> (a -> b) -> b
|> PgUser -> Text
unPgUser
      }
    (Parser Text
Environment.text Parser Text -> (Parser Text -> Parser PgUser) -> Parser PgUser
forall a b. a -> (a -> b) -> b
|> (Text -> PgUser) -> Parser Text -> Parser PgUser
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map Text -> PgUser
PgUser)

newtype PgDatabase = PgDatabase {PgDatabase -> Text
unPgDatabase :: Text}
  deriving (PgDatabase -> PgDatabase -> Bool
(PgDatabase -> PgDatabase -> Bool)
-> (PgDatabase -> PgDatabase -> Bool) -> Eq PgDatabase
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PgDatabase -> PgDatabase -> Bool
$c/= :: PgDatabase -> PgDatabase -> Bool
== :: PgDatabase -> PgDatabase -> Bool
$c== :: PgDatabase -> PgDatabase -> Bool
Eq, Int -> PgDatabase -> ShowS
[PgDatabase] -> ShowS
PgDatabase -> String
(Int -> PgDatabase -> ShowS)
-> (PgDatabase -> String)
-> ([PgDatabase] -> ShowS)
-> Show PgDatabase
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PgDatabase] -> ShowS
$cshowList :: [PgDatabase] -> ShowS
show :: PgDatabase -> String
$cshow :: PgDatabase -> String
showsPrec :: Int -> PgDatabase -> ShowS
$cshowsPrec :: Int -> PgDatabase -> ShowS
Show)

pgDatabaseDecoder :: Text -> Environment.Decoder PgDatabase
pgDatabaseDecoder :: Text -> Decoder PgDatabase
pgDatabaseDecoder Text
prefix =
  Variable -> Parser PgDatabase -> Decoder PgDatabase
forall a. Variable -> Parser a -> Decoder a
Environment.variable
    Variable :: Text -> Text -> Text -> Variable
Environment.Variable
      { name :: Text
Environment.name = Text
prefix Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
"PGDATABASE",
        description :: Text
Environment.description = Text
"The postgres database to connect to.",
        defaultValue :: Text
Environment.defaultValue =
          Settings
defaultSettings Settings -> (Settings -> ConnectionSettings) -> ConnectionSettings
forall a b. a -> (a -> b) -> b
|> Settings -> ConnectionSettings
pgConnection ConnectionSettings
-> (ConnectionSettings -> PgDatabase) -> PgDatabase
forall a b. a -> (a -> b) -> b
|> ConnectionSettings -> PgDatabase
pgDatabase PgDatabase -> (PgDatabase -> Text) -> Text
forall a b. a -> (a -> b) -> b
|> PgDatabase -> Text
unPgDatabase
      }
    ((Text -> PgDatabase) -> Parser Text -> Parser PgDatabase
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map Text -> PgDatabase
PgDatabase Parser Text
Environment.text)

newtype PgPoolStripes = PgPoolStripes {PgPoolStripes -> Int
unPgPoolStripes :: Int}
  deriving (PgPoolStripes -> PgPoolStripes -> Bool
(PgPoolStripes -> PgPoolStripes -> Bool)
-> (PgPoolStripes -> PgPoolStripes -> Bool) -> Eq PgPoolStripes
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PgPoolStripes -> PgPoolStripes -> Bool
$c/= :: PgPoolStripes -> PgPoolStripes -> Bool
== :: PgPoolStripes -> PgPoolStripes -> Bool
$c== :: PgPoolStripes -> PgPoolStripes -> Bool
Eq, Int -> PgPoolStripes -> ShowS
[PgPoolStripes] -> ShowS
PgPoolStripes -> String
(Int -> PgPoolStripes -> ShowS)
-> (PgPoolStripes -> String)
-> ([PgPoolStripes] -> ShowS)
-> Show PgPoolStripes
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PgPoolStripes] -> ShowS
$cshowList :: [PgPoolStripes] -> ShowS
show :: PgPoolStripes -> String
$cshow :: PgPoolStripes -> String
showsPrec :: Int -> PgPoolStripes -> ShowS
$cshowsPrec :: Int -> PgPoolStripes -> ShowS
Show)

pgPoolStripesDecoder :: Environment.Decoder PgPoolStripes
pgPoolStripesDecoder :: Decoder PgPoolStripes
pgPoolStripesDecoder =
  Variable -> Parser PgPoolStripes -> Decoder PgPoolStripes
forall a. Variable -> Parser a -> Decoder a
Environment.variable
    Variable :: Text -> Text -> Text -> Variable
Environment.Variable
      { name :: Text
Environment.name = Text
"PG_POOL_STRIPES",
        description :: Text
Environment.description = Text
"The amount of sub-connection pools to create. Best refer to the resource-pool package for more info on this one. 1 is a good value for most applications.",
        defaultValue :: Text
Environment.defaultValue =
          Settings
defaultSettings Settings -> (Settings -> PoolSettings) -> PoolSettings
forall a b. a -> (a -> b) -> b
|> Settings -> PoolSettings
pgPool PoolSettings -> (PoolSettings -> PgPoolStripes) -> PgPoolStripes
forall a b. a -> (a -> b) -> b
|> PoolSettings -> PgPoolStripes
pgPoolStripes PgPoolStripes -> (PgPoolStripes -> Int) -> Int
forall a b. a -> (a -> b) -> b
|> PgPoolStripes -> Int
unPgPoolStripes Int -> (Int -> String) -> String
forall a b. a -> (a -> b) -> b
|> Int -> String
forall a. Show a => a -> String
show String -> (String -> Text) -> Text
forall a b. a -> (a -> b) -> b
|> String -> Text
Text.fromList
      }
    (Parser Int
forall a. Integral a => Parser a
Environment.int Parser Int
-> (Parser Int -> Parser PgPoolStripes) -> Parser PgPoolStripes
forall a b. a -> (a -> b) -> b
|> (Int -> PgPoolStripes) -> Parser Int -> Parser PgPoolStripes
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map Int -> PgPoolStripes
PgPoolStripes)

newtype PgPoolMaxIdleTime = PgPoolMaxIdleTime {PgPoolMaxIdleTime -> NominalDiffTime
unPgPoolMaxIdleTime :: Data.Time.NominalDiffTime}
  deriving (PgPoolMaxIdleTime -> PgPoolMaxIdleTime -> Bool
(PgPoolMaxIdleTime -> PgPoolMaxIdleTime -> Bool)
-> (PgPoolMaxIdleTime -> PgPoolMaxIdleTime -> Bool)
-> Eq PgPoolMaxIdleTime
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PgPoolMaxIdleTime -> PgPoolMaxIdleTime -> Bool
$c/= :: PgPoolMaxIdleTime -> PgPoolMaxIdleTime -> Bool
== :: PgPoolMaxIdleTime -> PgPoolMaxIdleTime -> Bool
$c== :: PgPoolMaxIdleTime -> PgPoolMaxIdleTime -> Bool
Eq, Int -> PgPoolMaxIdleTime -> ShowS
[PgPoolMaxIdleTime] -> ShowS
PgPoolMaxIdleTime -> String
(Int -> PgPoolMaxIdleTime -> ShowS)
-> (PgPoolMaxIdleTime -> String)
-> ([PgPoolMaxIdleTime] -> ShowS)
-> Show PgPoolMaxIdleTime
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PgPoolMaxIdleTime] -> ShowS
$cshowList :: [PgPoolMaxIdleTime] -> ShowS
show :: PgPoolMaxIdleTime -> String
$cshow :: PgPoolMaxIdleTime -> String
showsPrec :: Int -> PgPoolMaxIdleTime -> ShowS
$cshowsPrec :: Int -> PgPoolMaxIdleTime -> ShowS
Show)

pgPoolMaxIdleTimeDecoder :: Environment.Decoder PgPoolMaxIdleTime
pgPoolMaxIdleTimeDecoder :: Decoder PgPoolMaxIdleTime
pgPoolMaxIdleTimeDecoder =
  Variable -> Parser PgPoolMaxIdleTime -> Decoder PgPoolMaxIdleTime
forall a. Variable -> Parser a -> Decoder a
Environment.variable
    Variable :: Text -> Text -> Text -> Variable
Environment.Variable
      { name :: Text
Environment.name = Text
"PG_POOL_MAX_IDLE_TIME",
        description :: Text
Environment.description = Text
"The maximum time a database connection will be able remain idle until it is closed.",
        defaultValue :: Text
Environment.defaultValue =
          Settings
defaultSettings Settings -> (Settings -> PoolSettings) -> PoolSettings
forall a b. a -> (a -> b) -> b
|> Settings -> PoolSettings
pgPool PoolSettings
-> (PoolSettings -> PgPoolMaxIdleTime) -> PgPoolMaxIdleTime
forall a b. a -> (a -> b) -> b
|> PoolSettings -> PgPoolMaxIdleTime
pgPoolMaxIdleTime PgPoolMaxIdleTime
-> (PgPoolMaxIdleTime -> NominalDiffTime) -> NominalDiffTime
forall a b. a -> (a -> b) -> b
|> PgPoolMaxIdleTime -> NominalDiffTime
unPgPoolMaxIdleTime NominalDiffTime -> (NominalDiffTime -> Int) -> Int
forall a b. a -> (a -> b) -> b
|> NominalDiffTime -> Int
fromNominalDiffTime Int -> (Int -> String) -> String
forall a b. a -> (a -> b) -> b
|> Int -> String
forall a. Show a => a -> String
show String -> (String -> Text) -> Text
forall a b. a -> (a -> b) -> b
|> String -> Text
Text.fromList
      }
    (Parser Int
forall a. Integral a => Parser a
Environment.int Parser Int
-> (Parser Int -> Parser PgPoolMaxIdleTime)
-> Parser PgPoolMaxIdleTime
forall a b. a -> (a -> b) -> b
|> (Int -> PgPoolMaxIdleTime)
-> Parser Int -> Parser PgPoolMaxIdleTime
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map (NominalDiffTime -> PgPoolMaxIdleTime
PgPoolMaxIdleTime (NominalDiffTime -> PgPoolMaxIdleTime)
-> (Int -> NominalDiffTime) -> Int -> PgPoolMaxIdleTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
<< Int -> NominalDiffTime
toNominalDiffTime))

toNominalDiffTime :: Int -> Data.Time.NominalDiffTime
toNominalDiffTime :: Int -> NominalDiffTime
toNominalDiffTime = Int -> NominalDiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac

fromNominalDiffTime :: Data.Time.NominalDiffTime -> Int
fromNominalDiffTime :: NominalDiffTime -> Int
fromNominalDiffTime = NominalDiffTime -> Int
forall a b. (RealFrac a, Integral b) => a -> b
Prelude.round

newtype PgPoolSize = PgPoolSize {PgPoolSize -> Int
unPgPoolSize :: Int}
  deriving (PgPoolSize -> PgPoolSize -> Bool
(PgPoolSize -> PgPoolSize -> Bool)
-> (PgPoolSize -> PgPoolSize -> Bool) -> Eq PgPoolSize
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PgPoolSize -> PgPoolSize -> Bool
$c/= :: PgPoolSize -> PgPoolSize -> Bool
== :: PgPoolSize -> PgPoolSize -> Bool
$c== :: PgPoolSize -> PgPoolSize -> Bool
Eq, Int -> PgPoolSize -> ShowS
[PgPoolSize] -> ShowS
PgPoolSize -> String
(Int -> PgPoolSize -> ShowS)
-> (PgPoolSize -> String)
-> ([PgPoolSize] -> ShowS)
-> Show PgPoolSize
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PgPoolSize] -> ShowS
$cshowList :: [PgPoolSize] -> ShowS
show :: PgPoolSize -> String
$cshow :: PgPoolSize -> String
showsPrec :: Int -> PgPoolSize -> ShowS
$cshowsPrec :: Int -> PgPoolSize -> ShowS
Show)

pgPoolSizeDecoder :: Environment.Decoder PgPoolSize
pgPoolSizeDecoder :: Decoder PgPoolSize
pgPoolSizeDecoder =
  Variable -> Parser PgPoolSize -> Decoder PgPoolSize
forall a. Variable -> Parser a -> Decoder a
Environment.variable
    Variable :: Text -> Text -> Text -> Variable
Environment.Variable
      { name :: Text
Environment.name = Text
"PG_POOL_SIZE",
        description :: Text
Environment.description = Text
"The size of the postgres connection pool. This is the maximum amount of parallel database connections the app will be able to use.",
        defaultValue :: Text
Environment.defaultValue =
          Settings
defaultSettings Settings -> (Settings -> PoolSettings) -> PoolSettings
forall a b. a -> (a -> b) -> b
|> Settings -> PoolSettings
pgPool PoolSettings -> (PoolSettings -> PgPoolSize) -> PgPoolSize
forall a b. a -> (a -> b) -> b
|> PoolSettings -> PgPoolSize
pgPoolSize PgPoolSize -> (PgPoolSize -> Int) -> Int
forall a b. a -> (a -> b) -> b
|> PgPoolSize -> Int
unPgPoolSize Int -> (Int -> String) -> String
forall a b. a -> (a -> b) -> b
|> Int -> String
forall a. Show a => a -> String
show String -> (String -> Text) -> Text
forall a b. a -> (a -> b) -> b
|> String -> Text
Text.fromList
      }
    (Parser Int
forall a. Integral a => Parser a
Environment.int Parser Int
-> (Parser Int -> Parser PgPoolSize) -> Parser PgPoolSize
forall a b. a -> (a -> b) -> b
|> (Int -> PgPoolSize) -> Parser Int -> Parser PgPoolSize
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map Int -> PgPoolSize
PgPoolSize)

toPGDatabase :: Settings -> PGDatabase
toPGDatabase :: Settings -> PGDatabase
toPGDatabase
  Settings
    { pgConnection :: Settings -> ConnectionSettings
pgConnection =
        ConnectionSettings
          { PgDatabase
pgDatabase :: PgDatabase
pgDatabase :: ConnectionSettings -> PgDatabase
pgDatabase,
            PgUser
pgUser :: PgUser
pgUser :: ConnectionSettings -> PgUser
pgUser,
            PgHost
pgHost :: PgHost
pgHost :: ConnectionSettings -> PgHost
pgHost,
            PgPassword
pgPassword :: PgPassword
pgPassword :: ConnectionSettings -> PgPassword
pgPassword,
            PgPort
pgPort :: PgPort
pgPort :: ConnectionSettings -> PgPort
pgPort
          },
      Interval
pgQueryTimeout :: Interval
pgQueryTimeout :: Settings -> Interval
pgQueryTimeout
    } =
    PGDatabase
defaultPGDatabase
      { pgDBName :: ByteString
pgDBName = Text -> ByteString
Data.Text.Encoding.encodeUtf8 (PgDatabase -> Text
unPgDatabase PgDatabase
pgDatabase),
        pgDBUser :: ByteString
pgDBUser = Text -> ByteString
Data.Text.Encoding.encodeUtf8 (PgUser -> Text
unPgUser PgUser
pgUser),
        pgDBPass :: ByteString
pgDBPass = Text -> ByteString
Data.Text.Encoding.encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
<| Secret Text -> Text
forall a. Secret a -> a
Log.unSecret (PgPassword -> Secret Text
unPgPassword PgPassword
pgPassword),
        pgDBParams :: [(ByteString, ByteString)]
pgDBParams =
          if Interval -> Float
Time.milliseconds Interval
pgQueryTimeout Float -> Float -> Bool
forall comparable.
Ord comparable =>
comparable -> comparable -> Bool
> Float
0
            then
              [ -- We configure Postgres to automatically kill queries when they run
                -- too long. That should offer some protection against queries
                -- locking up the database.
                -- https://www.postgresql.org/docs/9.4/runtime-config-client.html
                (ByteString
"statement_timeout", Interval
pgQueryTimeout Interval -> (Interval -> Float) -> Float
forall a b. a -> (a -> b) -> b
|> Interval -> Float
Time.milliseconds Float -> (Float -> Int) -> Int
forall a b. a -> (a -> b) -> b
|> Float -> Int
floor Int -> (Int -> String) -> String
forall a b. a -> (a -> b) -> b
|> Int -> String
forall a. Show a => a -> String
show String -> (String -> ByteString) -> ByteString
forall a b. a -> (a -> b) -> b
|> String -> ByteString
Data.ByteString.Char8.pack)
              ]
            else [],
        pgDBAddr :: Either (String, String) SockAddr
pgDBAddr =
          -- The rule that PostgreSQL/libpq applies to `host`:
          --
          --   If this begins with a slash, it specifies Unix-domain
          --   communication rather than TCP/IP communication; the value is the
          --   name of the directory in which the socket file is stored
          --
          -- https://www.postgresql.org/docs/9.6/libpq-connect.html#LIBPQ-CONNECT-HOST
          if Text -> Text -> Bool
Text.startsWith Text
"/" Text
host
            then
              Text -> String
Text.toList Text
host String -> ShowS
</> String
".s.PGSQL." String -> ShowS
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Int -> String
forall a. Show a => a -> String
show Int
port
                String -> (String -> SockAddr) -> SockAddr
forall a b. a -> (a -> b) -> b
|> String -> SockAddr
SockAddrUnix
                SockAddr
-> (SockAddr -> Either (String, String) SockAddr)
-> Either (String, String) SockAddr
forall a b. a -> (a -> b) -> b
|> SockAddr -> Either (String, String) SockAddr
forall a b. b -> Either a b
Right
            else (String, String) -> Either (String, String) SockAddr
forall a b. a -> Either a b
Left (Text -> String
Text.toList Text
host, Int -> String
forall a. Show a => a -> String
show Int
port)
      }
    where
      host :: Text
host = PgHost -> Text
unPgHost PgHost
pgHost
      port :: Int
port = PgPort -> Int
unPgPort PgPort
pgPort

queryTimeoutDecoder :: Environment.Decoder Time.Interval
queryTimeoutDecoder :: Decoder Interval
queryTimeoutDecoder =
  Variable -> Parser Interval -> Decoder Interval
forall a. Variable -> Parser a -> Decoder a
Environment.variable
    Variable :: Text -> Text -> Text -> Variable
Environment.Variable
      { name :: Text
Environment.name = Text
"PG_QUERY_TIMEOUT_SECONDS",
        description :: Text
Environment.description = Text
"The maximum time a query can run before it is cancelled.",
        defaultValue :: Text
Environment.defaultValue = Settings
defaultSettings Settings -> (Settings -> Interval) -> Interval
forall a b. a -> (a -> b) -> b
|> Settings -> Interval
pgQueryTimeout Interval -> (Interval -> Float) -> Float
forall a b. a -> (a -> b) -> b
|> Interval -> Float
Time.seconds Float -> (Float -> String) -> String
forall a b. a -> (a -> b) -> b
|> Float -> String
forall a. Show a => a -> String
show String -> (String -> Text) -> Text
forall a b. a -> (a -> b) -> b
|> String -> Text
Text.fromList
      }
    (Parser Float
Environment.float Parser Float
-> (Parser Float -> Parser Interval) -> Parser Interval
forall a b. a -> (a -> b) -> b
|> (Float -> Interval) -> Parser Float -> Parser Interval
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map Float -> Interval
Time.fromSeconds)