aboutsummaryrefslogtreecommitdiff
path: root/server/src/Model/Query.hs
blob: 22ae95bca32759255688f9d2795ed2822c20b3f0 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
module Model.Query
  ( Query(..)
  , run
  ) where

import           Data.Functor           (Functor)
import           Database.SQLite.Simple (Connection)
import qualified Database.SQLite.Simple as SQLite

data Query a = Query (Connection -> IO a)

instance Functor Query where
  fmap f (Query call) = Query (fmap f . call)

instance Applicative Query where
  pure x = Query (const $ return x)
  (Query callF) <*> (Query callX) = Query (\conn -> do
    x <- callX conn
    f <- callF conn
    return (f x))

instance Monad Query where
  (Query callX) >>= f = Query (\conn -> do
    x <- callX conn
    case f x of Query callY -> callY conn)

run :: Query a -> IO a
run (Query call) = do
  conn <- SQLite.open "database"
  result <- call conn
  _ <- SQLite.close conn
  return result