64 lines
1.7 KiB
Haskell
64 lines
1.7 KiB
Haskell
{-# LANGUAGE DeriveGeneric #-}
|
|
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
|
|
|
module Soostone.Types where
|
|
|
|
import Control.Monad.Catch ( MonadMask, MonadCatch, MonadThrow )
|
|
import Control.Monad.Error.Class ( MonadError(throwError) )
|
|
import Control.Monad.IO.Class ( MonadIO(..) )
|
|
import Control.Monad.Reader.Class ( MonadReader )
|
|
import Control.Monad.Trans.Reader (ReaderT)
|
|
import Data.Aeson
|
|
( defaultOptions, genericToEncoding, FromJSON, ToJSON(toEncoding) )
|
|
import Data.String ( IsString(fromString) )
|
|
import Data.Text ( Text )
|
|
import Database.SQLite.Simple ( field, FromRow(..) )
|
|
import Database.SQLite.Simple.ToField ( ToField(..) )
|
|
import Servant
|
|
( Handler, ServerError(errBody), FromHttpApiData, err500 )
|
|
import Servant.API.Generic ( Generic )
|
|
import qualified StmContainers.Map as SM
|
|
import Data.Hashable
|
|
|
|
|
|
newtype Key = Key Text
|
|
deriving (FromHttpApiData, Generic, Hashable, Eq)
|
|
|
|
instance ToField Key where
|
|
toField (Key k) = toField k
|
|
|
|
instance ToJSON Key where
|
|
toEncoding = genericToEncoding defaultOptions
|
|
instance FromJSON Key
|
|
|
|
|
|
newtype Count = Count Integer
|
|
deriving (Generic, Num)
|
|
|
|
instance FromRow Count where
|
|
fromRow = Count <$> field
|
|
|
|
instance ToField Count where
|
|
toField (Count c) = toField c
|
|
|
|
|
|
instance ToJSON Count where
|
|
toEncoding = genericToEncoding defaultOptions
|
|
instance FromJSON Count
|
|
|
|
data AppState = AppState {
|
|
sqliteFile :: FilePath
|
|
, stmMap :: SM.Map Key Count
|
|
}
|
|
|
|
newtype AppM a = AppM { runAppM :: ReaderT AppState Handler a }
|
|
deriving
|
|
( Functor, Applicative, Monad, MonadIO, Generic
|
|
, MonadThrow, MonadCatch, MonadMask
|
|
, MonadReader AppState
|
|
, MonadError ServerError
|
|
)
|
|
|
|
instance MonadFail AppM where
|
|
fail str = throwError $ err500 { errBody = fromString str }
|