From e09653d3a617e6b53db4c5e8ab6d15bee4f8e72a Mon Sep 17 00:00:00 2001 From: "Yann Esposito (Yogsototh)" Date: Wed, 7 Aug 2019 22:33:20 +0200 Subject: [PATCH] removed service --- aggreact.cabal | 4 +- src/Aggreact/Comments/Server.hs | 3 +- src/Database/Store.hs | 8 ---- src/Servant/Errors.hs | 32 ++++++------- src/Service/Config.hs | 81 --------------------------------- src/Service/Service.hs | 44 ------------------ 6 files changed, 19 insertions(+), 153 deletions(-) delete mode 100644 src/Service/Config.hs delete mode 100644 src/Service/Service.hs diff --git a/aggreact.cabal b/aggreact.cabal index 97935e2..20c6990 100644 --- a/aggreact.cabal +++ b/aggreact.cabal @@ -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: diff --git a/src/Aggreact/Comments/Server.hs b/src/Aggreact/Comments/Server.hs index 3f885e4..7866515 100644 --- a/src/Aggreact/Comments/Server.hs +++ b/src/Aggreact/Comments/Server.hs @@ -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 diff --git a/src/Database/Store.hs b/src/Database/Store.hs index 4b1de3a..4430323 100644 --- a/src/Database/Store.hs +++ b/src/Database/Store.hs @@ -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 diff --git a/src/Servant/Errors.hs b/src/Servant/Errors.hs index 0b51519..f4a6c7c 100644 --- a/src/Servant/Errors.hs +++ b/src/Servant/Errors.hs @@ -1,21 +1,21 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE BlockArguments #-} -- blabla do ... instead of blabla $ do ... -{-# LANGUAGE DeriveGeneric #-} -- deriving ToJSON ... -{-# LANGUAGE DerivingStrategies #-} -- remove warn about deriving strategies -{-# LANGUAGE ExplicitForAll #-} -- f :: forall a b. a -> b -> b -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -- newtype Id = Id Text deriving (StringConv Id String) -{-# LANGUAGE NamedWildCards #-} -- can use _type instead of just _ -{-# LANGUAGE NoImplicitPrelude #-} -- to use protolude for example -{-# LANGUAGE NumericUnderscores #-} -- write 1_000 instead of 1000 -{-# LANGUAGE OverloadedLists #-} -- write [1,2,3] :: Set -{-# LANGUAGE OverloadedStrings #-} -- write "foo" and it will be the correct text type -{-# LANGUAGE PartialTypeSignatures #-} -- -{-# LANGUAGE RecordWildCards #-} -- f Conf{..} = field1 ... -{-# LANGUAGE ScopedTypeVariables #-} -- write expr :: Type inside an expression -{-# LANGUAGE StandaloneDeriving #-} -- write deriving instance ... -{-# LANGUAGE Strict #-} -- a la Clojure -{-# LANGUAGE TupleSections #-} -- (a,,) instead of \x y -> (a,x,y) +{-# LANGUAGE BlockArguments #-} -- blabla do ... instead of blabla $ do ... +{-# LANGUAGE DeriveGeneric #-} -- deriving ToJSON ... +{-# LANGUAGE DerivingStrategies #-} -- remove warn about deriving strategies +{-# LANGUAGE ExplicitForAll #-} -- f :: forall a b. a -> b -> b +{-# LANGUAGE GeneralizedNewtypeDeriving #-} -- newtype Id = Id Text deriving (StringConv Id String) +{-# LANGUAGE NamedWildCards #-} -- can use _type instead of just _ +{-# LANGUAGE NoImplicitPrelude #-} -- to use protolude for example +{-# LANGUAGE NumericUnderscores #-} -- write 1_000 instead of 1000 +{-# LANGUAGE OverloadedLists #-} -- write [1,2,3] :: Set +{-# LANGUAGE OverloadedStrings #-} -- write "foo" and it will be the correct text type +{-# LANGUAGE PartialTypeSignatures #-} -- +{-# LANGUAGE RecordWildCards #-} -- f Conf{..} = field1 ... +{-# LANGUAGE ScopedTypeVariables #-} -- write expr :: Type inside an expression +{-# LANGUAGE StandaloneDeriving #-} -- write deriving instance ... +{-# LANGUAGE Strict #-} -- a la Clojure +{-# LANGUAGE TupleSections #-} -- (a,,) instead of \x y -> (a,x,y) module Servant.Errors where import Protolude diff --git a/src/Service/Config.hs b/src/Service/Config.hs deleted file mode 100644 index bc5f217..0000000 --- a/src/Service/Config.hs +++ /dev/null @@ -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 diff --git a/src/Service/Service.hs b/src/Service/Service.hs deleted file mode 100644 index 71d92e6..0000000 --- a/src/Service/Service.hs +++ /dev/null @@ -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)