servant.hsfiles

{-# START_FILE .ghci #-}
:set -i.:config:dist/build/autogen
:set -DDEVELOPMENT
:set -XCPP
:set -XDeriveDataTypeable
:set -XEmptyDataDecls
:set -XFlexibleContexts
:set -XGADTs
:set -XGeneralizedNewtypeDeriving
:set -XMultiParamTypeClasses
:set -XNoImplicitPrelude
:set -XNoMonomorphismRestriction
:set -XOverloadedStrings
:set -XQuasiQuotes
:set -XRecordWildCards
:set -XTemplateHaskell
:set -XTupleSections
:set -XTypeFamilies
:set -XViewPatterns

{-# START_FILE .gitignore #-}
.stack-work/
.DS_Store
*.swp

{-# START_FILE app/Main.hs #-}
module Main where

import Database.Persist.Sql (runSqlPool)
import System.Environment   (getArgs)

import Server 
import Config
import Database (doMigrations)

main :: IO ()
main = do
  [port] <- getArgs
  c <- getConfig
  runSqlPool doMigrations (pool c) 
  putStrLn $ "{{name}} running on port: "++ port
  startApp (read port) c
  
{-# START_FILE src/Config.hs #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE GADTs                      #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE TypeFamilies               #-}

module Config(
MagicT(..),Magic,
Config(..),Environment,
getConfig
)where

import Control.Monad.Except        (ExceptT, MonadError)
import Database.Persist
import Database.Persist.Postgresql (ConnectionPool, ConnectionString,
                                    createPostgresqlPool)
import Servant                     (ServantErr)
import System.Environment          (lookupEnv)

-- Magic Monad Stuff -----------------------------------------------
import Control.Monad.Logger (runNoLoggingT, runStdoutLoggingT)
import Control.Monad.Reader (MonadReader, ReaderT, asks, runReaderT,MonadIO)
import Control.Monad.Trans.Class (MonadTrans, lift)

newtype MagicT m a
  = MagicT
  {
    runTheMagic :: ReaderT Config (ExceptT ServantErr m) a
  }deriving( Functor, Applicative, Monad, MonadReader Config, 
             MonadError ServantErr, MonadIO)

type Magic = MagicT IO

data Config = Config {
  environment :: Environment,
  pool        :: ConnectionPool
}

data Environment = Development
                 | Production
                 | Test
                 deriving(Show,Eq,Read)
-------------------------------------------------------------

--- Environment Setup ---------------------------------------
getConfig :: IO Config
getConfig = do
  env <- getEnv
  p <- makePool env
  return Config {
            environment = env,
            pool = p
          }

getEnv :: IO Environment
getEnv = do
  e <- lookupEnv "ENV"
  case e of
    Nothing -> return Development
    Just e' -> return $ read e'

makePool :: Environment -> IO ConnectionPool
makePool env = do
  s <- getConnString env
  let n = getPoolSize env
  case env of
    Development -> runStdoutLoggingT (createPostgresqlPool s n)
    Test        -> runNoLoggingT (createPostgresqlPool s n)
    Production  -> runStdoutLoggingT (createPostgresqlPool s n)


connStr = "host=localhost dbname=fs_dev user=root password=root port=5432"

getConnString :: Environment -> IO ConnectionString
getConnString _ = return connStr

getPoolSize :: Environment -> Int
getPoolSize Development = 1
getPoolSize Test = 1
getPoolSize Production = 1
--------------------------------------------------------------

{-# START_FILE src/Controller.hs #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE GADTs                      #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE TypeFamilies               #-}

module Controller(
)where

import Database.Persist
import Servant

import Config
import Database

import Control.Monad.Reader (MonadIO, MonadReader, asks, liftIO, lift)


{-# START_FILE src/Database.hs #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GADTs                      #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE TypeFamilies               #-}

module Database where

import Control.Monad.Reader (MonadIO, MonadReader, asks, liftIO)
import Data.Aeson           (FromJSON, ToJSON)
import Database.Persist.Sql (SqlPersistT, runMigration, runSqlPool)
import Database.Persist.TH  (mkMigrate, mkPersist, persistLowerCase,
                                       share, sqlSettings)
import Config               
import Api.{{name}}

doMigrations :: SqlPersistT IO ()
doMigrations = runMigration migrateAll

runDB :: (MonadReader Config m, MonadIO m) => SqlPersistT IO b -> m b
runDB query = do
  p <- asks pool
  liftIO $ runSqlPool query p
{-# START_FILE src/Server.hs #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE GADTs                      #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE TypeFamilies               #-}

module Server 
    ( startApp
    ) where

import Prelude ()
import Prelude.Compat

import Control.Monad.Except
import Network.Wai
import Network.Wai.Handler.Warp hiding (FileInfo)
import Servant
import Control.Category     ((<<<), (>>>))

import Config
import Controller


startApp :: Int -> Config -> IO ()
startApp port cfg = run port ({{name}}App cfg)

{{name}}App :: Config -> Application
{{name}}App cfg = serve api (magicToServer cfg)

magicToServer :: Config -> Server {{name}}API
magicToServer cfg = enter (convertMagic cfg >>> NT Handler) {{name}}Server

convertMagic cfg = runReaderTNat cfg <<< NT runTheMagic

{{name}}Server :: MonadIO m => ServerT {{name}}API (MagicT m)
{{name}}Server = undefined

api :: Proxy {{name}}API
api = Proxy


{-# START_FILE test/Spec.hs #-}
{-# OPTIONS_GHC -F -pgmF hspec-discover #-}

{-# START_FILE {{name}}.cabal #-}
name:              {{name}}
version:           0.0.0
cabal-version:     >= 1.8
build-type:        Simple

library
  hs-source-dirs:      src
  exposed-modules:     Config, Controller, Server, Database

  build-depends:       base >= 4.7 && < 5
                     , aeson
                     , base-compat
                     , servant-server
                     , wai
                     , warp
                     , mtl
                     , persistent
                     , persistent-postgresql
                     , persistent-template
                     , transformers
                     , monad-logger
                     , time
  default-language:    Haskell2010

executable {{name}}
  hs-source-dirs:      app
  main-is:             Main.hs
  ghc-options:         -threaded -rtsopts -with-rtsopts=-N
  build-depends:       base
                     , {{name}} 
                     , persistent
  default-language:    Haskell2010

test-suite {{name}}-test
  type:                exitcode-stdio-1.0
  hs-source-dirs:      test
  main-is:             Spec.hs
  build-depends:       base
                     , {{name}}
                     , hspec
                     , hspec-wai
                     , hspec-wai-json
                     , aeson
  ghc-options:         -threaded -rtsopts -with-rtsopts=-N
  default-language:    Haskell2010

source-repository head
  type:     git
  location: https://github.com/githubuser/{{name}}