tonatona-servant 0.1.0.4 → 0.2.0.0
raw patch · 5 files changed
+211/−119 lines, 5 filesdep −Globdep ~basedep ~exceptionsdep ~servantbuild-type:Customsetup-changed
Dependencies removed: Glob
Dependency ranges changed: base, exceptions, servant, servant-server, tonaparser, tonatona, tonatona-logger, wai-extra, warp
Files
- Setup.hs +7/−2
- src/Tonatona/Servant.hs +19/−8
- test/DocTest.hs +0/−56
- test/doctests.hs +9/−0
- tonatona-servant.cabal +176/−53
Setup.hs view
@@ -1,2 +1,7 @@-import Distribution.Simple-main = defaultMain+module Main (main) where++import RIO+import Distribution.Extra.Doctest ( defaultMainWithDoctests )++main :: IO ()+main = defaultMainWithDoctests "doctests"
src/Tonatona/Servant.hs view
@@ -4,6 +4,7 @@ module Tonatona.Servant ( Tonatona.Servant.run+ , runWithHandlers , redirect , Config(..) , Host(..)@@ -34,31 +35,41 @@ (HasServer api '[], HasConfig env Config, HasConfig env TonaLogger.Config) => ServerT api (RIO env) -> RIO env ()-run servantServer = do+run =+ runWithHandlers @api []++{-| Main function which allows you to pass error handlers.+ -}+runWithHandlers ::+ forall (api :: Type) env.+ (HasServer api '[], HasConfig env Config, HasConfig env TonaLogger.Config)+ => (forall a. [RIO.Handler (RIO env) a])+ -> ServerT api (RIO env)+ -> RIO env ()+runWithHandlers handlers servantServer = do env <- ask conf <- asks config loggingMiddleware <- reqLogMiddleware- let app = runServant @api env servantServer+ let app = runServant @api env handlers servantServer liftIO $ Warp.run (port conf) $ loggingMiddleware app runServant :: forall (api :: Type) env. (HasServer api '[]) => env+ -> (forall a. [RIO.Handler (RIO env) a]) -> ServerT api (RIO env) -> Application-runServant env servantServer =- serve (Proxy @api) $ hoistServer (Proxy @api) transformation servantServer+runServant env handlers servantServer =+ serve (Proxy @api) $ hoistServer (Proxy @api) (transformation . t) servantServer where+ t :: forall a. RIO env a -> RIO env a+ t = flip catches handlers transformation :: forall a. RIO env a -> Servant.Handler a transformation action = do let ioAction = Right <$> runRIO env action-#if MIN_VERSION_servant(0, 16, 0) eitherRes <- liftIO $ ioAction `catch` \(e :: ServerError) -> pure $ Left e-#else- eitherRes <- liftIO $ ioAction `catch` \(e :: ServantErr) -> pure $ Left e-#endif case eitherRes of Right res -> pure res Left servantErr -> throwError servantErr
− test/DocTest.hs
@@ -1,56 +0,0 @@-module Main (main) where--import RIO--import System.FilePath.Glob (glob)-import Test.DocTest (doctest)--main :: IO ()-main = glob "src/**/*.hs" >>= doDocTest--doDocTest :: [String] -> IO ()-doDocTest options =- doctest $- options <>- ghcExtensions--ghcExtensions :: [String]-ghcExtensions =- [ "-XBangPatterns"- , "-XBinaryLiterals"- , "-XConstraintKinds"- , "-XDataKinds"- , "-XDefaultSignatures"- , "-XDeriveDataTypeable"- , "-XDeriveFoldable"- , "-XDeriveFunctor"- , "-XDeriveGeneric"- , "-XDeriveTraversable"- , "-XDoAndIfThenElse"- , "-XEmptyDataDecls"- , "-XExistentialQuantification"- , "-XFlexibleContexts"- , "-XFlexibleInstances"- , "-XFunctionalDependencies"- , "-XGADTs"- , "-XGeneralizedNewtypeDeriving"- , "-XInstanceSigs"- , "-XKindSignatures"- , "-XLambdaCase"- , "-XMultiParamTypeClasses"- , "-XMultiWayIf"- , "-XNamedFieldPuns"- , "-XNoImplicitPrelude"- , "-XOverloadedStrings"- , "-XPartialTypeSignatures"- , "-XPatternGuards"- , "-XPolyKinds"- , "-XRankNTypes"- , "-XRecordWildCards"- , "-XScopedTypeVariables"- , "-XStandaloneDeriving"- , "-XTupleSections"- , "-XTypeFamilies"- , "-XTypeSynonymInstances"- , "-XViewPatterns"- ]
+ test/doctests.hs view
@@ -0,0 +1,9 @@+module Main where++import RIO+import Build_doctests (flags, pkgs, module_sources)+import Test.DocTest++main :: IO ()+main = do+ doctest $ flags ++ pkgs ++ module_sources
tonatona-servant.cabal view
@@ -1,13 +1,11 @@-cabal-version: 1.12+cabal-version: 1.24 --- This file has been generated from package.yaml by hpack version 0.33.0.+-- This file has been generated from package.yaml by hpack version 0.35.1. -- -- see: https://github.com/sol/hpack------ hash: 7c3045f6422f00689d6132b94cb59fdd4a68b02d1a4a5c4d657cda7a9629f167 name: tonatona-servant-version: 0.1.0.4+version: 0.2.0.0 synopsis: tonatona plugin for servant. description: Tonatona plugin for @servant@. This package provides a tonatona plugin for @servant@. category: Library, Tonatona, Servant, Web@@ -18,7 +16,9 @@ copyright: 2018 Kadzuya Okamoto license: MIT license-file: LICENSE-build-type: Simple+build-type: Custom+tested-with:+ GHC==9.4.6, GHC==9.2.8, GHC==9.0.2, GHC==8.10.7 extra-source-files: README.md @@ -26,6 +26,13 @@ type: git location: https://github.com/tonatona-project/tonatona +custom-setup+ setup-depends:+ Cabal <3.12+ , base >=4.14 && <4.18+ , cabal-doctest >=1 && <1.1+ , rio ==0.1.*+ library exposed-modules: Tonatona.Servant@@ -33,49 +40,126 @@ Paths_tonatona_servant hs-source-dirs: src- default-extensions: BangPatterns BinaryLiterals ConstraintKinds DataKinds DefaultSignatures DeriveDataTypeable DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable DoAndIfThenElse EmptyDataDecls ExistentialQuantification FlexibleContexts FlexibleInstances FunctionalDependencies GADTs GeneralizedNewtypeDeriving InstanceSigs KindSignatures LambdaCase MultiParamTypeClasses MultiWayIf NamedFieldPuns NoImplicitPrelude OverloadedStrings PartialTypeSignatures PatternGuards PolyKinds RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving Strict StrictData TupleSections TypeFamilies TypeSynonymInstances ViewPatterns+ default-extensions:+ BangPatterns+ BinaryLiterals+ ConstraintKinds+ DataKinds+ DefaultSignatures+ DeriveDataTypeable+ DeriveFoldable+ DeriveFunctor+ DeriveGeneric+ DeriveTraversable+ DoAndIfThenElse+ EmptyDataDecls+ ExistentialQuantification+ FlexibleContexts+ FlexibleInstances+ FunctionalDependencies+ GADTs+ GeneralizedNewtypeDeriving+ InstanceSigs+ KindSignatures+ LambdaCase+ MultiParamTypeClasses+ MultiWayIf+ NamedFieldPuns+ NoImplicitPrelude+ OverloadedStrings+ PartialTypeSignatures+ PatternGuards+ PolyKinds+ RankNTypes+ RecordWildCards+ ScopedTypeVariables+ StandaloneDeriving+ Strict+ StrictData+ TupleSections+ TypeFamilies+ TypeSynonymInstances+ ViewPatterns ghc-options: -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints build-depends:- base >=4.7 && <4.15- , data-default >=0.7 && <0.8- , exceptions >=0.8 && <0.11- , http-types >=0.12 && <0.13- , monad-logger >=0.3 && <0.4- , rio >=0.1 && <0.2- , servant >=0.13 && <0.17- , servant-server >=0.13 && <0.17- , tonaparser >=0.1 && <0.2- , tonatona >=0.1 && <0.2- , tonatona-logger >=0.1 && <0.3- , wai >=3.2 && <3.3- , wai-extra >=3.0.27 && <3.1- , warp >=3.2 && <3.4+ base >=4.14 && <4.18+ , data-default ==0.7.*+ , exceptions ==0.10.*+ , http-types ==0.12.*+ , monad-logger ==0.3.*+ , rio ==0.1.*+ , servant >=0.18 && <0.20+ , servant-server >=0.18 && <0.20+ , tonaparser ==0.2.*+ , tonatona ==0.2.*+ , tonatona-logger ==0.3.*+ , wai ==3.2.*+ , wai-extra ==3.1.*+ , warp ==3.3.* default-language: Haskell2010 -test-suite doctest+test-suite doctests type: exitcode-stdio-1.0- main-is: DocTest.hs+ main-is: doctests.hs hs-source-dirs: test- default-extensions: BangPatterns BinaryLiterals ConstraintKinds DataKinds DefaultSignatures DeriveDataTypeable DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable DoAndIfThenElse EmptyDataDecls ExistentialQuantification FlexibleContexts FlexibleInstances FunctionalDependencies GADTs GeneralizedNewtypeDeriving InstanceSigs KindSignatures LambdaCase MultiParamTypeClasses MultiWayIf NamedFieldPuns NoImplicitPrelude OverloadedStrings PartialTypeSignatures PatternGuards PolyKinds RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving Strict StrictData TupleSections TypeFamilies TypeSynonymInstances ViewPatterns+ default-extensions:+ BangPatterns+ BinaryLiterals+ ConstraintKinds+ DataKinds+ DefaultSignatures+ DeriveDataTypeable+ DeriveFoldable+ DeriveFunctor+ DeriveGeneric+ DeriveTraversable+ DoAndIfThenElse+ EmptyDataDecls+ ExistentialQuantification+ FlexibleContexts+ FlexibleInstances+ FunctionalDependencies+ GADTs+ GeneralizedNewtypeDeriving+ InstanceSigs+ KindSignatures+ LambdaCase+ MultiParamTypeClasses+ MultiWayIf+ NamedFieldPuns+ NoImplicitPrelude+ OverloadedStrings+ PartialTypeSignatures+ PatternGuards+ PolyKinds+ RankNTypes+ RecordWildCards+ ScopedTypeVariables+ StandaloneDeriving+ Strict+ StrictData+ TupleSections+ TypeFamilies+ TypeSynonymInstances+ ViewPatterns ghc-options: -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints build-depends:- Glob- , base >=4.7 && <4.15- , data-default >=0.7 && <0.8+ base >=4.14 && <4.18+ , data-default ==0.7.* , doctest- , exceptions >=0.8 && <0.11- , http-types >=0.12 && <0.13- , monad-logger >=0.3 && <0.4- , rio >=0.1 && <0.2- , servant >=0.13 && <0.17- , servant-server >=0.13 && <0.17- , tonaparser >=0.1 && <0.2- , tonatona >=0.1 && <0.2- , tonatona-logger >=0.1 && <0.3- , wai >=3.2 && <3.3- , wai-extra >=3.0.27 && <3.1- , warp >=3.2 && <3.4+ , exceptions ==0.10.*+ , http-types ==0.12.*+ , monad-logger ==0.3.*+ , rio ==0.1.*+ , servant >=0.18 && <0.20+ , servant-server >=0.18 && <0.20+ , tonaparser ==0.2.*+ , tonatona ==0.2.*+ , tonatona-logger ==0.3.*+ , wai ==3.2.*+ , wai-extra ==3.1.*+ , warp ==3.3.* default-language: Haskell2010 test-suite spec@@ -83,21 +167,60 @@ main-is: Spec.hs hs-source-dirs: test- default-extensions: BangPatterns BinaryLiterals ConstraintKinds DataKinds DefaultSignatures DeriveDataTypeable DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable DoAndIfThenElse EmptyDataDecls ExistentialQuantification FlexibleContexts FlexibleInstances FunctionalDependencies GADTs GeneralizedNewtypeDeriving InstanceSigs KindSignatures LambdaCase MultiParamTypeClasses MultiWayIf NamedFieldPuns NoImplicitPrelude OverloadedStrings PartialTypeSignatures PatternGuards PolyKinds RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving Strict StrictData TupleSections TypeFamilies TypeSynonymInstances ViewPatterns+ default-extensions:+ BangPatterns+ BinaryLiterals+ ConstraintKinds+ DataKinds+ DefaultSignatures+ DeriveDataTypeable+ DeriveFoldable+ DeriveFunctor+ DeriveGeneric+ DeriveTraversable+ DoAndIfThenElse+ EmptyDataDecls+ ExistentialQuantification+ FlexibleContexts+ FlexibleInstances+ FunctionalDependencies+ GADTs+ GeneralizedNewtypeDeriving+ InstanceSigs+ KindSignatures+ LambdaCase+ MultiParamTypeClasses+ MultiWayIf+ NamedFieldPuns+ NoImplicitPrelude+ OverloadedStrings+ PartialTypeSignatures+ PatternGuards+ PolyKinds+ RankNTypes+ RecordWildCards+ ScopedTypeVariables+ StandaloneDeriving+ Strict+ StrictData+ TupleSections+ TypeFamilies+ TypeSynonymInstances+ ViewPatterns ghc-options: -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints build-depends:- base >=4.7 && <4.15- , data-default >=0.7 && <0.8- , exceptions >=0.8 && <0.11- , http-types >=0.12 && <0.13- , monad-logger >=0.3 && <0.4- , rio >=0.1 && <0.2- , servant >=0.13 && <0.17- , servant-server >=0.13 && <0.17- , tonaparser >=0.1 && <0.2+ base >=4.14 && <4.18+ , data-default ==0.7.*+ , exceptions ==0.10.*+ , http-types ==0.12.*+ , monad-logger ==0.3.*+ , rio ==0.1.*+ , servant >=0.18 && <0.20+ , servant-server >=0.18 && <0.20+ , tonaparser ==0.2.* , tonatona- , tonatona-logger >=0.1 && <0.3- , wai >=3.2 && <3.3- , wai-extra >=3.0.27 && <3.1- , warp >=3.2 && <3.4+ , tonatona-logger ==0.3.*+ , wai ==3.2.*+ , wai-extra ==3.1.*+ , warp ==3.3.* default-language: Haskell2010