{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Hipsql.Server.Adapter
( hipsql
) where
import Data.Maybe (listToMaybe)
import GHC.Stack (callStack, getCallStack)
import Hipsql.Monad (MonadHipsql(hipsql), MonadHipsqlAdapter(hipsqlAcquireLibPQ))
import Hipsql.Server (startHipsql)
instance {-# OVERLAPPABLE #-} (Monad m, MonadHipsqlAdapter m) => MonadHipsql m where
hipsql :: m ()
hipsql = do
let loc :: Maybe SrcLoc
loc = (([Char], SrcLoc) -> SrcLoc)
-> Maybe ([Char], SrcLoc) -> Maybe SrcLoc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Char], SrcLoc) -> SrcLoc
forall a b. (a, b) -> b
snd (Maybe ([Char], SrcLoc) -> Maybe SrcLoc)
-> Maybe ([Char], SrcLoc) -> Maybe SrcLoc
forall a b. (a -> b) -> a -> b
$ [([Char], SrcLoc)] -> Maybe ([Char], SrcLoc)
forall a. [a] -> Maybe a
listToMaybe ([([Char], SrcLoc)] -> Maybe ([Char], SrcLoc))
-> [([Char], SrcLoc)] -> Maybe ([Char], SrcLoc)
forall a b. (a -> b) -> a -> b
$ CallStack -> [([Char], SrcLoc)]
getCallStack CallStack
HasCallStack => CallStack
callStack
(Connection -> IO ()) -> m ()
forall (m :: * -> *) a.
MonadHipsqlAdapter m =>
(Connection -> IO a) -> m a
hipsqlAcquireLibPQ (Maybe SrcLoc -> Connection -> IO ()
startHipsql Maybe SrcLoc
loc)