Last active
August 29, 2015 14:01
-
-
Save dpwiz/caf3dc454fa42f6f9cca to your computer and use it in GitHub Desktop.
Scotty application skeleton
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
module Hedis | |
( | |
-- * Application classes | |
HasRedis(..) | |
-- * App-wrapped redis runner | |
, redis | |
-- * Re-export other stuff from "Database.Redis" | |
, module R | |
) where | |
import Control.Monad.Trans (MonadIO(..)) | |
import Database.Redis as R hiding (MonadRedis) | |
class (MonadIO m) => HasRedis m where | |
getRedis :: m Connection | |
redis :: HasRedis m => R.Redis r -> m r | |
redis q = getRedis >>= \c -> liftIO $ R.runRedis c q |
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
{-# LANGUAGE FlexibleInstances #-} | |
import Web.Scotty.Trans | |
import Control.Applicative | |
import Control.Monad.Reader as CMR | |
import Data.Text.Lazy (Text) | |
import qualified PGSimple as PG | |
import qualified Hedis as R | |
-- * Application environment | |
data App = App { appFoo :: () | |
, pg :: PG.Connection | |
, redis :: R.Connection | |
} | |
-- ** Scotty transformer aliases | |
type Scotty = ScottyT Text (ReaderT App IO) | |
type Handler = ActionT Text (ReaderT App IO) | |
-- ** Helpers | |
-- | Access application stuff (generic) | |
getApp :: (App -> a) -> Handler a | |
getApp = lift . asks | |
-- | Shortcut to get app record. | |
foo :: Handler () | |
foo = getApp appFoo | |
-- ** Service instances | |
instance PG.HasPostgres Handler where | |
getPG = getApp pg | |
instance R.HasRedis Handler where | |
getRedis = getApp redis | |
-- * Setup | |
-- | Entry point | |
main :: IO () | |
main = do | |
env <- setup () | |
scottyT 3190 (flip runReaderT env) (flip runReaderT env) app | |
-- | Application initialization | |
setup :: () -> IO App | |
setup () = App <$> pure () | |
<*> PG.connectPostgreSQL "host=127.0.0.1 dbname=maneuver user=maneuver password=maneuver" | |
<*> R.connect R.defaultConnectInfo | |
-- | Scotty initialization | |
app :: Scotty () | |
app = do | |
get "/" index | |
-- * Handlers | |
-- | ActionT handler | |
index :: Handler () | |
index = do | |
() <- foo | |
[PG.Only 42] <- PG.pgQuery_ "select 41" :: Handler [PG.Only Int] | |
Right _ <- R.redis R.ping | |
text "lol index" |
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
module PGSimple | |
( | |
-- * Application classes | |
HasPostgres(..) | |
-- * Wrapped functions | |
, pgQuery, pgQuery_ | |
, pgReturning | |
, pgExecute, pgExecute_, pgExecuteMany | |
-- * Some re-exports | |
, Connection, connect, defaultConnectInfo, connectPostgreSQL | |
, Query, Only(..) | |
) where | |
import Control.Monad.Reader | |
import Database.PostgreSQL.Simple as PG | |
import Data.Int (Int64) | |
class MonadIO m => HasPostgres m where | |
getPG :: m Connection | |
pgQuery :: (HasPostgres m, ToRow q, FromRow r) | |
=> Query -> q -> m [r] | |
pgQuery q ps = getPG >>= \c -> liftIO $ query c q ps | |
pgQuery_ :: (HasPostgres m, FromRow r) | |
=> Query -> m [r] | |
pgQuery_ q = getPG>>= \c -> liftIO $ query_ c q | |
pgReturning :: (HasPostgres m, ToRow q, FromRow r) | |
=> Query -> [q] -> m [r] | |
pgReturning q ps = getPG >>= \c -> liftIO $ returning c q ps | |
pgExecute :: (HasPostgres m, ToRow q) | |
=> Query -> q -> m Int64 | |
pgExecute q ps = getPG >>= \c -> liftIO $ execute c q ps | |
pgExecute_ :: (HasPostgres m) | |
=> Query -> m Int64 | |
pgExecute_ q = getPG >>= \c -> liftIO $ execute_ c q | |
pgExecuteMany :: (HasPostgres m, ToRow q) | |
=> Query -> [q] -> m Int64 | |
pgExecuteMany q ps = getPG >>= \c -> liftIO $ executeMany c q ps |
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
-- Initial bounce.cabal generated by cabal init. For further | |
-- documentation, see http://haskell.org/cabal/users-guide/ | |
name: bounce | |
version: 0.1.0.0 | |
-- synopsis: | |
-- description: | |
-- license: | |
license-file: LICENSE | |
-- author: | |
-- maintainer: | |
-- copyright: | |
-- category: | |
build-type: Simple | |
-- extra-source-files: | |
cabal-version: >=1.10 | |
executable bounce | |
hs-source-dirs: src | |
main-is: Main.hs | |
ghc-options: -Wall -O2 -threaded | |
default-language: Haskell2010 | |
default-extensions: OverloadedStrings | |
build-depends: base >=4.6 && <4.8 | |
, scotty >= 0.7.2 | |
, mtl | |
, text | |
, bytestring | |
, postgresql-simple | |
, hedis |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
PostgreSQL should be wrapped with resource-pool: