{-# LANGUAGE OverloadedStrings #-}
module System.Nix.Store.DB.Util
  ( persistLikeNix
  , setWAL
  , enableWAL
  , disableWAL
  , setFK
  , enableFK
  , disableFK
  ) where

import Language.Haskell.TH.Quote
import Database.Persist.Quasi
import Database.Persist.Sqlite (SqliteConnectionInfo)
import Database.Persist.TH (persistWith)

import qualified Database.Persist.Sqlite
import qualified Lens.Micro

-- | Coerce table names to their plural names
-- i.e. ValidPath -> ValidPaths
persistLikeNix :: QuasiQuoter
persistLikeNix :: QuasiQuoter
persistLikeNix = PersistSettings -> QuasiQuoter
persistWith (PersistSettings -> QuasiQuoter) -> PersistSettings -> QuasiQuoter
forall a b. (a -> b) -> a -> b
$
  (Text -> Text) -> PersistSettings -> PersistSettings
setPsToDBName
    (Text -> Text
forall {a}. (Eq a, IsString a, Semigroup a) => a -> a
coerce (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PersistSettings -> Text -> Text
getPsToDBName PersistSettings
upperCaseSettings))
    PersistSettings
upperCaseSettings
  where
    coerce :: a -> a
coerce a
x | a
x a -> [a] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a
"ValidPath", a
"Ref", a
"DerivationOutput"] = a -> a
forall {a}. (Semigroup a, IsString a) => a -> a
plural a
x
    coerce a
x = a
x

    plural :: a -> a
plural a
x = a
x a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
"s"

-- * WAL and FK

-- | Configure WAL (write ahead log)
setWAL
  :: Bool
  -> SqliteConnectionInfo
  -> SqliteConnectionInfo
setWAL :: Bool -> SqliteConnectionInfo -> SqliteConnectionInfo
setWAL Bool
v = ASetter SqliteConnectionInfo SqliteConnectionInfo Bool Bool
-> (Bool -> Bool) -> SqliteConnectionInfo -> SqliteConnectionInfo
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
Lens.Micro.over ASetter SqliteConnectionInfo SqliteConnectionInfo Bool Bool
Lens' SqliteConnectionInfo Bool
Database.Persist.Sqlite.walEnabled (Bool -> Bool -> Bool
forall a b. a -> b -> a
const Bool
v)

-- | Enable WAL (write ahead log)
enableWAL
  :: SqliteConnectionInfo
  -> SqliteConnectionInfo
enableWAL :: SqliteConnectionInfo -> SqliteConnectionInfo
enableWAL = Bool -> SqliteConnectionInfo -> SqliteConnectionInfo
setWAL Bool
True

-- | Disable WAL (write ahead log)
disableWAL
  :: SqliteConnectionInfo
  -> SqliteConnectionInfo
disableWAL :: SqliteConnectionInfo -> SqliteConnectionInfo
disableWAL = Bool -> SqliteConnectionInfo -> SqliteConnectionInfo
setWAL Bool
False

-- | Configure FK (foreign key constraints)
setFK
  :: Bool
  -> SqliteConnectionInfo
  -> SqliteConnectionInfo
setFK :: Bool -> SqliteConnectionInfo -> SqliteConnectionInfo
setFK Bool
v = ASetter SqliteConnectionInfo SqliteConnectionInfo Bool Bool
-> (Bool -> Bool) -> SqliteConnectionInfo -> SqliteConnectionInfo
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
Lens.Micro.over ASetter SqliteConnectionInfo SqliteConnectionInfo Bool Bool
Lens' SqliteConnectionInfo Bool
Database.Persist.Sqlite.walEnabled (Bool -> Bool -> Bool
forall a b. a -> b -> a
const Bool
v)

-- | Enable foreign key constraint checking
enableFK
  :: SqliteConnectionInfo
  -> SqliteConnectionInfo
enableFK :: SqliteConnectionInfo -> SqliteConnectionInfo
enableFK = Bool -> SqliteConnectionInfo -> SqliteConnectionInfo
setFK Bool
True

-- | Disable foreign key constraint checking
disableFK
  :: SqliteConnectionInfo
  -> SqliteConnectionInfo
disableFK :: SqliteConnectionInfo -> SqliteConnectionInfo
disableFK = Bool -> SqliteConnectionInfo -> SqliteConnectionInfo
setFK Bool
False