module Mensam.Server.Configuration.SQLite where

import Mensam.API.Aeson

import Control.DeepSeq
import Data.Aeson qualified as A
import Data.Kind
import Deriving.Aeson qualified as A
import GHC.Generics

type SQLiteConfig :: Type
data SQLiteConfig = MkSQLiteConfig
  { SQLiteConfig -> FilePath
sqliteFilepath :: FilePath
  , SQLiteConfig -> Double
sqliteConnectionPoolTimeoutSeconds :: Double
  -- ^ Number of seconds, that an unused resource is kept in the pool.
  , SQLiteConfig -> Int
sqliteConnectionPoolMaxNumberOfConnections :: Int
  -- ^ Maximum number of resources open at once.
  , SQLiteConfig -> Bool
sqliteCheckDataIntegrityOnStartup :: Bool
  -- ^ Maximum number of resources open at once.
  }
  deriving stock (SQLiteConfig -> SQLiteConfig -> Bool
(SQLiteConfig -> SQLiteConfig -> Bool)
-> (SQLiteConfig -> SQLiteConfig -> Bool) -> Eq SQLiteConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SQLiteConfig -> SQLiteConfig -> Bool
== :: SQLiteConfig -> SQLiteConfig -> Bool
$c/= :: SQLiteConfig -> SQLiteConfig -> Bool
/= :: SQLiteConfig -> SQLiteConfig -> Bool
Eq, (forall x. SQLiteConfig -> Rep SQLiteConfig x)
-> (forall x. Rep SQLiteConfig x -> SQLiteConfig)
-> Generic SQLiteConfig
forall x. Rep SQLiteConfig x -> SQLiteConfig
forall x. SQLiteConfig -> Rep SQLiteConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SQLiteConfig -> Rep SQLiteConfig x
from :: forall x. SQLiteConfig -> Rep SQLiteConfig x
$cto :: forall x. Rep SQLiteConfig x -> SQLiteConfig
to :: forall x. Rep SQLiteConfig x -> SQLiteConfig
Generic, Eq SQLiteConfig
Eq SQLiteConfig =>
(SQLiteConfig -> SQLiteConfig -> Ordering)
-> (SQLiteConfig -> SQLiteConfig -> Bool)
-> (SQLiteConfig -> SQLiteConfig -> Bool)
-> (SQLiteConfig -> SQLiteConfig -> Bool)
-> (SQLiteConfig -> SQLiteConfig -> Bool)
-> (SQLiteConfig -> SQLiteConfig -> SQLiteConfig)
-> (SQLiteConfig -> SQLiteConfig -> SQLiteConfig)
-> Ord SQLiteConfig
SQLiteConfig -> SQLiteConfig -> Bool
SQLiteConfig -> SQLiteConfig -> Ordering
SQLiteConfig -> SQLiteConfig -> SQLiteConfig
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SQLiteConfig -> SQLiteConfig -> Ordering
compare :: SQLiteConfig -> SQLiteConfig -> Ordering
$c< :: SQLiteConfig -> SQLiteConfig -> Bool
< :: SQLiteConfig -> SQLiteConfig -> Bool
$c<= :: SQLiteConfig -> SQLiteConfig -> Bool
<= :: SQLiteConfig -> SQLiteConfig -> Bool
$c> :: SQLiteConfig -> SQLiteConfig -> Bool
> :: SQLiteConfig -> SQLiteConfig -> Bool
$c>= :: SQLiteConfig -> SQLiteConfig -> Bool
>= :: SQLiteConfig -> SQLiteConfig -> Bool
$cmax :: SQLiteConfig -> SQLiteConfig -> SQLiteConfig
max :: SQLiteConfig -> SQLiteConfig -> SQLiteConfig
$cmin :: SQLiteConfig -> SQLiteConfig -> SQLiteConfig
min :: SQLiteConfig -> SQLiteConfig -> SQLiteConfig
Ord, ReadPrec [SQLiteConfig]
ReadPrec SQLiteConfig
Int -> ReadS SQLiteConfig
ReadS [SQLiteConfig]
(Int -> ReadS SQLiteConfig)
-> ReadS [SQLiteConfig]
-> ReadPrec SQLiteConfig
-> ReadPrec [SQLiteConfig]
-> Read SQLiteConfig
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS SQLiteConfig
readsPrec :: Int -> ReadS SQLiteConfig
$creadList :: ReadS [SQLiteConfig]
readList :: ReadS [SQLiteConfig]
$creadPrec :: ReadPrec SQLiteConfig
readPrec :: ReadPrec SQLiteConfig
$creadListPrec :: ReadPrec [SQLiteConfig]
readListPrec :: ReadPrec [SQLiteConfig]
Read, Int -> SQLiteConfig -> ShowS
[SQLiteConfig] -> ShowS
SQLiteConfig -> FilePath
(Int -> SQLiteConfig -> ShowS)
-> (SQLiteConfig -> FilePath)
-> ([SQLiteConfig] -> ShowS)
-> Show SQLiteConfig
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SQLiteConfig -> ShowS
showsPrec :: Int -> SQLiteConfig -> ShowS
$cshow :: SQLiteConfig -> FilePath
show :: SQLiteConfig -> FilePath
$cshowList :: [SQLiteConfig] -> ShowS
showList :: [SQLiteConfig] -> ShowS
Show)
  deriving anyclass (SQLiteConfig -> ()
(SQLiteConfig -> ()) -> NFData SQLiteConfig
forall a. (a -> ()) -> NFData a
$crnf :: SQLiteConfig -> ()
rnf :: SQLiteConfig -> ()
NFData)
  deriving
    (Value -> Parser [SQLiteConfig]
Value -> Parser SQLiteConfig
(Value -> Parser SQLiteConfig)
-> (Value -> Parser [SQLiteConfig]) -> FromJSON SQLiteConfig
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser SQLiteConfig
parseJSON :: Value -> Parser SQLiteConfig
$cparseJSONList :: Value -> Parser [SQLiteConfig]
parseJSONList :: Value -> Parser [SQLiteConfig]
A.FromJSON, [SQLiteConfig] -> Value
[SQLiteConfig] -> Encoding
SQLiteConfig -> Value
SQLiteConfig -> Encoding
(SQLiteConfig -> Value)
-> (SQLiteConfig -> Encoding)
-> ([SQLiteConfig] -> Value)
-> ([SQLiteConfig] -> Encoding)
-> ToJSON SQLiteConfig
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: SQLiteConfig -> Value
toJSON :: SQLiteConfig -> Value
$ctoEncoding :: SQLiteConfig -> Encoding
toEncoding :: SQLiteConfig -> Encoding
$ctoJSONList :: [SQLiteConfig] -> Value
toJSONList :: [SQLiteConfig] -> Value
$ctoEncodingList :: [SQLiteConfig] -> Encoding
toEncodingList :: [SQLiteConfig] -> Encoding
A.ToJSON)
    via A.CustomJSON (JSONSettings "Mk" "sqlite") SQLiteConfig