removed service
This commit is contained in:
parent
2725dcef74
commit
e09653d3a6
6 changed files with 19 additions and 153 deletions
|
@ -4,7 +4,7 @@ cabal-version: 1.12
|
|||
--
|
||||
-- see: https://github.com/sol/hpack
|
||||
--
|
||||
-- hash: c6ba67633d506787943c9e979e0f721a602447dfad110f1302bbd2c64035d461
|
||||
-- hash: 45f4a7726914fbb361f0d4f25c0b9f0520907688f03bde8ff31dda1fcaa58274
|
||||
|
||||
name: aggreact
|
||||
version: 0.1.0.0
|
||||
|
@ -61,8 +61,6 @@ library
|
|||
Generics.SOP.Fieldnames
|
||||
Servant.Clay
|
||||
Servant.Errors
|
||||
Service.Config
|
||||
Service.Service
|
||||
other-modules:
|
||||
Paths_aggreact
|
||||
hs-source-dirs:
|
||||
|
|
|
@ -64,7 +64,8 @@ type CommentAPI =
|
|||
:<|> "comment" :> Capture "commentId" Text
|
||||
:> Get '[HTML,JSON] CommentPage
|
||||
:<|> "comment" :> Capture "commentId" Text
|
||||
:> DeleteAccepted '[JSON] ()
|
||||
:> "delete"
|
||||
:> PostAccepted '[JSON] ()
|
||||
|
||||
data Handlers =
|
||||
Handlers { userHandler :: UserHandler
|
||||
|
|
|
@ -139,14 +139,6 @@ deriving instance (FromJSON ms, FromJSON a) => FromJSON (Entity ms a)
|
|||
deriving instance (FromJSON ms, FromJWT ms, FromJSON a, FromJWT a) => FromJWT (Entity ms a)
|
||||
deriving instance (ToJSON ms, ToJWT ms, ToJSON a, ToJWT a) => ToJWT (Entity ms a)
|
||||
|
||||
-- data StoreService store metas entity
|
||||
-- data family StoreConfig store
|
||||
-- data family StoreHandler store
|
||||
--
|
||||
-- instance Serv.Service (StoreService store metas entity) b where
|
||||
-- type Config (StoreService store metas entity) b = StoreConfig store
|
||||
-- type Handle (StoreService store metas entity) b = StoreHandler store
|
||||
|
||||
class Store store m metas entity | store -> m metas entity where
|
||||
data DBConf store
|
||||
data StartedStore store
|
||||
|
|
|
@ -1,81 +0,0 @@
|
|||
{-# LANGUAGE AllowAmbiguousTypes #-}
|
||||
{-# LANGUAGE ConstraintKinds #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE DefaultSignatures #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE GADTs #-}
|
||||
{-# LANGUAGE InstanceSigs #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
{-# LANGUAGE PolyKinds #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
{-# LANGUAGE UndecidableInstances #-}
|
||||
|
||||
-- Common
|
||||
{-# LANGUAGE BlockArguments #-}
|
||||
{-# LANGUAGE DerivingStrategies #-}
|
||||
{-# LANGUAGE ExplicitForAll #-}
|
||||
{-# LANGUAGE NamedWildCards #-}
|
||||
{-# LANGUAGE NoImplicitPrelude #-}
|
||||
{-# LANGUAGE NumericUnderscores #-}
|
||||
{-# LANGUAGE OverloadedLists #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE PartialTypeSignatures #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
|
||||
{- |
|
||||
Module : Database.Store.SQLite
|
||||
Description : SQLite implentation for Store
|
||||
Copyright : (c) 2018, Yann Esposito
|
||||
License : ISC
|
||||
Maintainer : yann.esposito@gmail.com
|
||||
Stability : experimental
|
||||
Portability : POSIX
|
||||
|
||||
Provide a Service Abstraction
|
||||
|
||||
-}
|
||||
module Service.Config where
|
||||
|
||||
import Protolude hiding (Handle)
|
||||
|
||||
import Service.Service
|
||||
import Dhall
|
||||
import Data.Yaml
|
||||
import System.FilePath
|
||||
|
||||
data ConfigService a
|
||||
newtype ConfigServiceConfig conf =
|
||||
ConfigServiceConfig { config :: Either conf FilePath }
|
||||
newtype ConfigSvc a = ConfigSvc { getConfig :: a }
|
||||
|
||||
{-
|
||||
|
||||
Configuration service that can read a configuration from a file.
|
||||
|
||||
-}
|
||||
instance ( a ~ b
|
||||
, Interpret b
|
||||
, FromJSON b
|
||||
) => Service (ConfigService a) b where
|
||||
type Config (ConfigService a) b = ConfigServiceConfig b
|
||||
type Handle (ConfigService a) b = ConfigSvc b
|
||||
init _ ConfigServiceConfig{..} = ConfigSvc <$>
|
||||
case config of
|
||||
Left c -> return c
|
||||
Right configFile ->
|
||||
case takeExtension configFile of
|
||||
".dhall" -> input auto (toS configFile)
|
||||
".json" -> parseyaml configFile -- json are yaml
|
||||
".yaml" -> parseyaml configFile
|
||||
_ -> die "unrecognized format (only .dhall, .json and .yaml are supported)"
|
||||
where
|
||||
parseyaml configFile = do
|
||||
parseResult <- decodeFileEither configFile
|
||||
case parseResult of
|
||||
Left err -> die ("Error while parsing " <> toS configFile <> ":\n"
|
||||
<> toS (prettyPrintParseException err))
|
||||
Right c -> return c
|
|
@ -1,44 +0,0 @@
|
|||
{-# LANGUAGE AllowAmbiguousTypes #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
|
||||
-- Common
|
||||
{-# LANGUAGE BlockArguments #-}
|
||||
{-# LANGUAGE DerivingStrategies #-}
|
||||
{-# LANGUAGE ExplicitForAll #-}
|
||||
{-# LANGUAGE NamedWildCards #-}
|
||||
{-# LANGUAGE NoImplicitPrelude #-}
|
||||
{-# LANGUAGE NumericUnderscores #-}
|
||||
{-# LANGUAGE OverloadedLists #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE PartialTypeSignatures #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
|
||||
{- |
|
||||
Module : Database.Store.SQLite
|
||||
Description : SQLite implentation for Store
|
||||
Copyright : (c) 2018, Yann Esposito
|
||||
License : ISC
|
||||
Maintainer : yann.esposito@gmail.com
|
||||
Stability : experimental
|
||||
Portability : POSIX
|
||||
|
||||
Provide a Service Abstraction
|
||||
|
||||
-}
|
||||
module Service.Service where
|
||||
|
||||
import Protolude hiding (Handle)
|
||||
|
||||
import Control.Exception (bracket)
|
||||
|
||||
class Service s a where
|
||||
type Config s a -- the initial config a service should have
|
||||
type Handle s a -- a type that should contains methods provided by the service
|
||||
init :: Proxy (Service s a) -> Config s a -> IO (Handle s a)
|
||||
stop :: Proxy (Service s a) -> Handle s a -> IO ()
|
||||
stop _ _ = pure ()
|
||||
withService :: Config s a -> (Handle s a -> IO b) -> IO b
|
||||
withService config = bracket (init svc config) (stop svc)
|
||||
where svc = Proxy :: Proxy (Service s a)
|
Loading…
Reference in a new issue