From 104644a129e7532cdf7650d7aa99bb78e5bedd7e Mon Sep 17 00:00:00 2001 From: Anton Kholomiov Date: Thu, 2 Nov 2023 18:16:40 +0300 Subject: [PATCH 1/2] Makes send to monad transdormer --- .../mig-example-apps/mig-example-apps.cabal | 456 ++++++++---------- mig-extra/mig-extra.cabal | 59 ++- mig-wai/mig-wai.cabal | 39 +- mig/mig.cabal | 100 ++-- mig/package.yaml | 1 + mig/src/Mig/Core/Types/Route.hs | 6 + 6 files changed, 302 insertions(+), 359 deletions(-) diff --git a/examples/mig-example-apps/mig-example-apps.cabal b/examples/mig-example-apps/mig-example-apps.cabal index a9cd9ab..12b3dac 100644 --- a/examples/mig-example-apps/mig-example-apps.cabal +++ b/examples/mig-example-apps/mig-example-apps.cabal @@ -1,4 +1,4 @@ -cabal-version: 1.12 +cabal-version: 1.12 -- This file has been generated from package.yaml by hpack version 0.35.2. -- @@ -6,9 +6,7 @@ cabal-version: 1.12 name: mig-example-apps version: 0.1.0.0 -description: - Please see the README on GitHub at - +description: Please see the README on GitHub at homepage: https://github.com/githubuser/mig-example-apps#readme bug-reports: https://github.com/githubuser/mig-example-apps/issues author: Author name here @@ -18,48 +16,42 @@ license: BSD3 license-file: LICENSE build-type: Simple extra-source-files: - Html/resources/haskell-logo.png - Html/resources/lambda-logo.png - Html/resources/milligram.min.css - README.md + README.md + Html/resources/haskell-logo.png + Html/resources/lambda-logo.png + Html/resources/milligram.min.css source-repository head - type: git + type: git location: https://github.com/githubuser/mig-example-apps executable counter-client-mig-example-app - main-is: Main.hs + main-is: Main.hs other-modules: - Api - Client - Paths_mig_example_apps - Server - - hs-source-dirs: CounterClient + Api + Client + Server + Paths_mig_example_apps + hs-source-dirs: + CounterClient default-extensions: - DataKinds - DeriveAnyClass - DeriveDataTypeable - DeriveGeneric - DerivingStrategies - DuplicateRecordFields - GeneralizedNewtypeDeriving - ImportQualifiedPost - LambdaCase - OverloadedRecordDot - OverloadedStrings - RecordWildCards - StandaloneDeriving - StrictData - TemplateHaskell - TypeFamilies - - ghc-options: - -Wall -Werror -Wcompat -Widentities -Wincomplete-record-updates - -Wincomplete-uni-patterns -Wmissing-export-lists - -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints - -threaded -rtsopts -with-rtsopts=-N - + ImportQualifiedPost + OverloadedStrings + TypeFamilies + OverloadedRecordDot + DuplicateRecordFields + LambdaCase + DerivingStrategies + DataKinds + StrictData + DeriveAnyClass + RecordWildCards + TemplateHaskell + StandaloneDeriving + DeriveGeneric + DeriveDataTypeable + GeneralizedNewtypeDeriving + ghc-options: -Wall -Werror -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N build-depends: aeson , aeson-pretty @@ -81,37 +73,32 @@ executable counter-client-mig-example-app , safe , text , time - - default-language: GHC2021 + default-language: GHC2021 executable counter-mig-example-app - main-is: Main.hs - other-modules: Paths_mig_example_apps - hs-source-dirs: Counter + main-is: Main.hs + other-modules: + Paths_mig_example_apps + hs-source-dirs: + Counter default-extensions: - DataKinds - DeriveAnyClass - DeriveDataTypeable - DeriveGeneric - DerivingStrategies - DuplicateRecordFields - GeneralizedNewtypeDeriving - ImportQualifiedPost - LambdaCase - OverloadedRecordDot - OverloadedStrings - RecordWildCards - StandaloneDeriving - StrictData - TemplateHaskell - TypeFamilies - - ghc-options: - -Wall -Werror -Wcompat -Widentities -Wincomplete-record-updates - -Wincomplete-uni-patterns -Wmissing-export-lists - -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints - -threaded -rtsopts -with-rtsopts=-N - + ImportQualifiedPost + OverloadedStrings + TypeFamilies + OverloadedRecordDot + DuplicateRecordFields + LambdaCase + DerivingStrategies + DataKinds + StrictData + DeriveAnyClass + RecordWildCards + TemplateHaskell + StandaloneDeriving + DeriveGeneric + DeriveDataTypeable + GeneralizedNewtypeDeriving + ghc-options: -Wall -Werror -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N build-depends: aeson , aeson-pretty @@ -132,37 +119,32 @@ executable counter-mig-example-app , safe , text , time - - default-language: GHC2021 + default-language: GHC2021 executable hello-world-client-mig-example-app - main-is: Main.hs - other-modules: Paths_mig_example_apps - hs-source-dirs: HelloClient + main-is: Main.hs + other-modules: + Paths_mig_example_apps + hs-source-dirs: + HelloClient default-extensions: - DataKinds - DeriveAnyClass - DeriveDataTypeable - DeriveGeneric - DerivingStrategies - DuplicateRecordFields - GeneralizedNewtypeDeriving - ImportQualifiedPost - LambdaCase - OverloadedRecordDot - OverloadedStrings - RecordWildCards - StandaloneDeriving - StrictData - TemplateHaskell - TypeFamilies - - ghc-options: - -Wall -Werror -Wcompat -Widentities -Wincomplete-record-updates - -Wincomplete-uni-patterns -Wmissing-export-lists - -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints - -threaded -rtsopts -with-rtsopts=-N - + ImportQualifiedPost + OverloadedStrings + TypeFamilies + OverloadedRecordDot + DuplicateRecordFields + LambdaCase + DerivingStrategies + DataKinds + StrictData + DeriveAnyClass + RecordWildCards + TemplateHaskell + StandaloneDeriving + DeriveGeneric + DeriveDataTypeable + GeneralizedNewtypeDeriving + ghc-options: -Wall -Werror -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N build-depends: aeson , aeson-pretty @@ -183,37 +165,32 @@ executable hello-world-client-mig-example-app , safe , text , time - - default-language: GHC2021 + default-language: GHC2021 executable hello-world-mig-example-app - main-is: Main.hs - other-modules: Paths_mig_example_apps - hs-source-dirs: HelloWorld + main-is: Main.hs + other-modules: + Paths_mig_example_apps + hs-source-dirs: + HelloWorld default-extensions: - DataKinds - DeriveAnyClass - DeriveDataTypeable - DeriveGeneric - DerivingStrategies - DuplicateRecordFields - GeneralizedNewtypeDeriving - ImportQualifiedPost - LambdaCase - OverloadedRecordDot - OverloadedStrings - RecordWildCards - StandaloneDeriving - StrictData - TemplateHaskell - TypeFamilies - - ghc-options: - -Wall -Werror -Wcompat -Widentities -Wincomplete-record-updates - -Wincomplete-uni-patterns -Wmissing-export-lists - -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints - -threaded -rtsopts -with-rtsopts=-N - + ImportQualifiedPost + OverloadedStrings + TypeFamilies + OverloadedRecordDot + DuplicateRecordFields + LambdaCase + DerivingStrategies + DataKinds + StrictData + DeriveAnyClass + RecordWildCards + TemplateHaskell + StandaloneDeriving + DeriveGeneric + DeriveDataTypeable + GeneralizedNewtypeDeriving + ghc-options: -Wall -Werror -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N build-depends: aeson , aeson-pretty @@ -233,46 +210,39 @@ executable hello-world-mig-example-app , safe , text , time - - default-language: GHC2021 + default-language: GHC2021 executable html-mig-example-app - main-is: Main.hs + main-is: Main.hs other-modules: - Content - Init - Interface - Internal.State - Paths_mig_example_apps - Server - Types - View - - hs-source-dirs: Html/src + Content + Init + Interface + Internal.State + Server + Types + View + Paths_mig_example_apps + hs-source-dirs: + Html/src default-extensions: - DataKinds - DeriveAnyClass - DeriveDataTypeable - DeriveGeneric - DerivingStrategies - DuplicateRecordFields - GeneralizedNewtypeDeriving - ImportQualifiedPost - LambdaCase - OverloadedRecordDot - OverloadedStrings - RecordWildCards - StandaloneDeriving - StrictData - TemplateHaskell - TypeFamilies - - ghc-options: - -Wall -Werror -Wcompat -Widentities -Wincomplete-record-updates - -Wincomplete-uni-patterns -Wmissing-export-lists - -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints - -threaded -rtsopts -with-rtsopts=-N - + ImportQualifiedPost + OverloadedStrings + TypeFamilies + OverloadedRecordDot + DuplicateRecordFields + LambdaCase + DerivingStrategies + DataKinds + StrictData + DeriveAnyClass + RecordWildCards + TemplateHaskell + StandaloneDeriving + DeriveGeneric + DeriveDataTypeable + GeneralizedNewtypeDeriving + ghc-options: -Wall -Werror -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N build-depends: aeson , aeson-pretty @@ -297,45 +267,38 @@ executable html-mig-example-app , text , time , uuid - - default-language: GHC2021 + default-language: GHC2021 executable json-api-mig-example-app - main-is: Main.hs + main-is: Main.hs other-modules: - Init - Interface - Internal.State - Paths_mig_example_apps - Server - Server.Swagger - Types - - hs-source-dirs: JsonApi + Init + Interface + Internal.State + Server + Server.Swagger + Types + Paths_mig_example_apps + hs-source-dirs: + JsonApi default-extensions: - DataKinds - DeriveAnyClass - DeriveDataTypeable - DeriveGeneric - DerivingStrategies - DuplicateRecordFields - GeneralizedNewtypeDeriving - ImportQualifiedPost - LambdaCase - OverloadedRecordDot - OverloadedStrings - RecordWildCards - StandaloneDeriving - StrictData - TemplateHaskell - TypeFamilies - - ghc-options: - -Wall -Werror -Wcompat -Widentities -Wincomplete-record-updates - -Wincomplete-uni-patterns -Wmissing-export-lists - -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints - -threaded -rtsopts -with-rtsopts=-N - + ImportQualifiedPost + OverloadedStrings + TypeFamilies + OverloadedRecordDot + DuplicateRecordFields + LambdaCase + DerivingStrategies + DataKinds + StrictData + DeriveAnyClass + RecordWildCards + TemplateHaskell + StandaloneDeriving + DeriveGeneric + DeriveDataTypeable + GeneralizedNewtypeDeriving + ghc-options: -Wall -Werror -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N build-depends: aeson , aeson-pretty @@ -357,37 +320,32 @@ executable json-api-mig-example-app , text , time , yaml - - default-language: GHC2021 + default-language: GHC2021 executable route-args-client-mig-example-app - main-is: Main.hs - other-modules: Paths_mig_example_apps - hs-source-dirs: RouteArgsClient + main-is: Main.hs + other-modules: + Paths_mig_example_apps + hs-source-dirs: + RouteArgsClient default-extensions: - DataKinds - DeriveAnyClass - DeriveDataTypeable - DeriveGeneric - DerivingStrategies - DuplicateRecordFields - GeneralizedNewtypeDeriving - ImportQualifiedPost - LambdaCase - OverloadedRecordDot - OverloadedStrings - RecordWildCards - StandaloneDeriving - StrictData - TemplateHaskell - TypeFamilies - - ghc-options: - -Wall -Werror -Wcompat -Widentities -Wincomplete-record-updates - -Wincomplete-uni-patterns -Wmissing-export-lists - -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints - -threaded -rtsopts -with-rtsopts=-N - + ImportQualifiedPost + OverloadedStrings + TypeFamilies + OverloadedRecordDot + DuplicateRecordFields + LambdaCase + DerivingStrategies + DataKinds + StrictData + DeriveAnyClass + RecordWildCards + TemplateHaskell + StandaloneDeriving + DeriveGeneric + DeriveDataTypeable + GeneralizedNewtypeDeriving + ghc-options: -Wall -Werror -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N build-depends: aeson , aeson-pretty @@ -408,37 +366,32 @@ executable route-args-client-mig-example-app , safe , text , time - - default-language: GHC2021 + default-language: GHC2021 executable route-args-mig-example-app - main-is: Main.hs - other-modules: Paths_mig_example_apps - hs-source-dirs: RouteArgs + main-is: Main.hs + other-modules: + Paths_mig_example_apps + hs-source-dirs: + RouteArgs default-extensions: - DataKinds - DeriveAnyClass - DeriveDataTypeable - DeriveGeneric - DerivingStrategies - DuplicateRecordFields - GeneralizedNewtypeDeriving - ImportQualifiedPost - LambdaCase - OverloadedRecordDot - OverloadedStrings - RecordWildCards - StandaloneDeriving - StrictData - TemplateHaskell - TypeFamilies - - ghc-options: - -Wall -Werror -Wcompat -Widentities -Wincomplete-record-updates - -Wincomplete-uni-patterns -Wmissing-export-lists - -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints - -threaded -rtsopts -with-rtsopts=-N - + ImportQualifiedPost + OverloadedStrings + TypeFamilies + OverloadedRecordDot + DuplicateRecordFields + LambdaCase + DerivingStrategies + DataKinds + StrictData + DeriveAnyClass + RecordWildCards + TemplateHaskell + StandaloneDeriving + DeriveGeneric + DeriveDataTypeable + GeneralizedNewtypeDeriving + ghc-options: -Wall -Werror -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N build-depends: aeson , aeson-pretty @@ -458,5 +411,4 @@ executable route-args-mig-example-app , safe , text , time - - default-language: GHC2021 + default-language: GHC2021 diff --git a/mig-extra/mig-extra.cabal b/mig-extra/mig-extra.cabal index 2c86192..c14a571 100644 --- a/mig-extra/mig-extra.cabal +++ b/mig-extra/mig-extra.cabal @@ -1,4 +1,4 @@ -cabal-version: 1.12 +cabal-version: 1.12 -- This file has been generated from package.yaml by hpack version 0.35.2. -- @@ -16,42 +16,38 @@ maintainer: anton.kholomiov@gmail.com copyright: 2023 Anton Kholomiov license: BSD3 build-type: Simple -extra-source-files: README.md +extra-source-files: + README.md source-repository head - type: git + type: git location: https://github.com/anton-k/mig library exposed-modules: - Mig.Extra.Derive - Mig.Extra.Plugin.Auth - Mig.Extra.Plugin.Exception - Mig.Extra.Plugin.Trace - Mig.Extra.Server.Common - Mig.Extra.Server.Html - Mig.Extra.Server.Html.IO - Mig.Extra.Server.IO - Mig.Extra.Server.Json - Mig.Extra.Server.Json.IO - - other-modules: Paths_mig_extra - hs-source-dirs: src + Mig.Extra.Derive + Mig.Extra.Plugin.Auth + Mig.Extra.Plugin.Exception + Mig.Extra.Plugin.Trace + Mig.Extra.Server.Common + Mig.Extra.Server.Html + Mig.Extra.Server.Html.IO + Mig.Extra.Server.IO + Mig.Extra.Server.Json + Mig.Extra.Server.Json.IO + other-modules: + Paths_mig_extra + hs-source-dirs: + src default-extensions: - DataKinds - DerivingStrategies - DuplicateRecordFields - LambdaCase - OverloadedRecordDot - OverloadedStrings - TypeFamilies - - ghc-options: - -Wall -Wcompat -Widentities -Wincomplete-record-updates - -Wincomplete-uni-patterns -Wmissing-export-lists - -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints - -Wunused-packages - + DerivingStrategies + TypeFamilies + DataKinds + OverloadedRecordDot + OverloadedStrings + DuplicateRecordFields + LambdaCase + ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -Wunused-packages build-depends: aeson , base >=4.7 && <5 @@ -72,5 +68,4 @@ library , text , time , yaml - - default-language: GHC2021 + default-language: GHC2021 diff --git a/mig-wai/mig-wai.cabal b/mig-wai/mig-wai.cabal index 8668901..fb2ddf1 100644 --- a/mig-wai/mig-wai.cabal +++ b/mig-wai/mig-wai.cabal @@ -1,4 +1,4 @@ -cabal-version: 1.12 +cabal-version: 1.12 -- This file has been generated from package.yaml by hpack version 0.35.2. -- @@ -7,9 +7,7 @@ cabal-version: 1.12 name: mig-wai version: 0.1.0.0 synopsis: Render mig-servers as wai-applications -description: - Please see the README on GitHub at - +description: Please see the README on GitHub at category: Web homepage: https://github.com/githubuser/mig-wai#readme bug-reports: https://github.com/githubuser/mig-wai/issues @@ -18,28 +16,26 @@ maintainer: example@example.com copyright: 2023 Author name here license: BSD3 build-type: Simple -extra-source-files: README.md +extra-source-files: + README.md source-repository head - type: git + type: git location: https://github.com/githubuser/mig-wai library - exposed-modules: Mig.Server.Wai - other-modules: Paths_mig_wai - hs-source-dirs: src + exposed-modules: + Mig.Server.Wai + other-modules: + Paths_mig_wai + hs-source-dirs: + src default-extensions: - DuplicateRecordFields - LambdaCase - OverloadedRecordDot - OverloadedStrings - - ghc-options: - -Wall -Wcompat -Widentities -Wincomplete-record-updates - -Wincomplete-uni-patterns -Wmissing-export-lists - -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints - -Wunused-packages - + OverloadedRecordDot + DuplicateRecordFields + OverloadedStrings + LambdaCase + ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -Wunused-packages build-depends: base >=4.7 && <5 , bytestring @@ -49,5 +45,4 @@ library , mig , text , wai - - default-language: GHC2021 + default-language: GHC2021 diff --git a/mig/mig.cabal b/mig/mig.cabal index 2e6f6ad..bb566ff 100644 --- a/mig/mig.cabal +++ b/mig/mig.cabal @@ -1,4 +1,4 @@ -cabal-version: 1.12 +cabal-version: 1.12 -- This file has been generated from package.yaml by hpack version 0.35.2. -- @@ -7,18 +7,16 @@ cabal-version: 1.12 name: mig version: 0.2.0.0 synopsis: Build lightweight and composable servers -description: - Core for the mig server library. - With library mig we can build lightweight and composable servers. - There are only couple of combinators to assemble servers from parts. - It supports generic handler functions as servant does. But strives to use more - simple model for API. It does not go to describing Server API at type level which - leads to simpler error messages. - . - * quick start guide at - . - * examples directory for more fun servers: at - +description: Core for the mig server library. + With library mig we can build lightweight and composable servers. + There are only couple of combinators to assemble servers from parts. + It supports generic handler functions as servant does. But strives to use more + simple model for API. It does not go to describing Server API at type level which + leads to simpler error messages. + . + * quick start guide at + . + * examples directory for more fun servers: at category: Web homepage: https://github.com/anton-k/mig#readme bug-reports: https://github.com/anton-k/mig/issues @@ -27,51 +25,47 @@ maintainer: anton.kholomiov@gmail.com copyright: 2023 Anton Kholomiov license: BSD3 build-type: Simple -extra-source-files: README.md +extra-source-files: + README.md source-repository head - type: git + type: git location: https://github.com/anton-k/mig library exposed-modules: - Mig.Core - Mig.Core.Api - Mig.Core.Api.NormalForm.TreeApi - Mig.Core.Class - Mig.Core.Class.MediaType - Mig.Core.Class.Monad - Mig.Core.Class.Plugin - Mig.Core.Class.Response - Mig.Core.Class.Route - Mig.Core.Class.Server - Mig.Core.OpenApi - Mig.Core.Server - Mig.Core.Server.Cache - Mig.Core.ServerFun - Mig.Core.Types - Mig.Core.Types.Http - Mig.Core.Types.Info - Mig.Core.Types.Route - - other-modules: Paths_mig - hs-source-dirs: src + Mig.Core + Mig.Core.Api + Mig.Core.Api.NormalForm.TreeApi + Mig.Core.Class + Mig.Core.Class.MediaType + Mig.Core.Class.Monad + Mig.Core.Class.Plugin + Mig.Core.Class.Response + Mig.Core.Class.Route + Mig.Core.Class.Server + Mig.Core.OpenApi + Mig.Core.Server + Mig.Core.Server.Cache + Mig.Core.ServerFun + Mig.Core.Types + Mig.Core.Types.Http + Mig.Core.Types.Info + Mig.Core.Types.Route + other-modules: + Paths_mig + hs-source-dirs: + src default-extensions: - AllowAmbiguousTypes - DerivingStrategies - DuplicateRecordFields - LambdaCase - OverloadedRecordDot - OverloadedStrings - StrictData - TypeFamilies - - ghc-options: - -Wall -Wcompat -Widentities -Wincomplete-record-updates - -Wincomplete-uni-patterns -Wmissing-export-lists - -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints - -Wunused-packages - + OverloadedStrings + TypeFamilies + OverloadedRecordDot + DuplicateRecordFields + LambdaCase + DerivingStrategies + StrictData + AllowAmbiguousTypes + ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -Wunused-packages build-depends: aeson , base >=4.7 && <5 @@ -92,5 +86,5 @@ library , openapi3 , safe , text - - default-language: GHC2021 + , transformers + default-language: GHC2021 diff --git a/mig/package.yaml b/mig/package.yaml index 8580b49..0e52777 100644 --- a/mig/package.yaml +++ b/mig/package.yaml @@ -48,6 +48,7 @@ dependencies: - insert-ordered-containers - lens - lrucache +- transformers default-extensions: - OverloadedStrings diff --git a/mig/src/Mig/Core/Types/Route.hs b/mig/src/Mig/Core/Types/Route.hs index 2043a07..89efa8d 100644 --- a/mig/src/Mig/Core/Types/Route.hs +++ b/mig/src/Mig/Core/Types/Route.hs @@ -36,6 +36,8 @@ module Mig.Core.Types.Route ( TRACE, ) where +import Control.Monad.IO.Class +import Control.Monad.Trans.Class import Data.Text (Text) import GHC.TypeLits import Network.HTTP.Types.Method @@ -125,6 +127,10 @@ The repsonse value is usually one of two cases: See the class @IsResp@ for more details on response types. -} newtype Send method m a = Send {unSend :: m a} + deriving newtype (Functor, Applicative, Monad, MonadIO) + +instance MonadTrans (Send method) where + lift = Send -- | type-level GET-method tag data GET From ffed0273e7ed291ba29d2c4db7713084f239533a Mon Sep 17 00:00:00 2001 From: Anton Kholomiov Date: Thu, 2 Nov 2023 18:31:24 +0300 Subject: [PATCH 2/2] Updates examples --- docs/src/00-foreword.md | 4 +-- docs/src/01-hello-world.md | 8 +++--- docs/src/02-request-anatomy.md | 26 ++++++++++---------- docs/src/03-response-anatomy.md | 4 +-- examples/mig-example-apps/HelloWorld/Main.hs | 2 +- examples/mig-example-apps/RouteArgs/Main.hs | 23 +++++++++-------- mig-extra/mig-extra.cabal | 1 + mig-extra/package.yaml | 1 + mig-extra/src/Mig/Extra/Server/Common.hs | 1 + mig-server/mig-server.cabal | 1 + mig-server/package.yaml | 10 ++++---- mig-server/src/Mig.hs | 1 + 12 files changed, 43 insertions(+), 39 deletions(-) diff --git a/docs/src/00-foreword.md b/docs/src/00-foreword.md index 2aa9a37..2d366b7 100644 --- a/docs/src/00-foreword.md +++ b/docs/src/00-foreword.md @@ -10,8 +10,6 @@ The main features are: * easy to use. It has simple design on purpose -* it defines no custom server monads. I promise you - * expressive DSL to compose servers * type-safe route handlers and conversions @@ -40,7 +38,7 @@ server = "api/v1/hello" /. hello -- | The handler definition as a function hello :: Get (Resp Text) -hello = Send $ pure $ ok "Hello World" +hello = pure $ ok "Hello World" ``` diff --git a/docs/src/01-hello-world.md b/docs/src/01-hello-world.md index 22192c8..6b942f9 100644 --- a/docs/src/01-hello-world.md +++ b/docs/src/01-hello-world.md @@ -104,6 +104,8 @@ We have type synonyms for all HTTP-methods (`Get`, `Post`, `Put` etc). It's interesting to know that library mig does not use any custom monads for operation. Instead it runs on top of monad provided by the user. Usually it would be `IO` or `Reader` over `IO`. +Also for convenience `Send` is also `Monad`, `MonadTrans` and `MonadIO`. +So we can omit `Send` constructor in many cases. ### HTTP-response type @@ -143,7 +145,7 @@ Let's complete the example and define a handler which returns static text: ```haskell hello :: Get IO (Resp Json) -hello = Send $ pure $ ok "Hello World!" +hello = pure $ ok "Hello World!" ``` We have several wrappers here: @@ -193,7 +195,7 @@ server :: Server IO server = "api/v1/hello" /. hello hello :: Get IO (Resp Json Text) -hello = Send $ pure $ ok "Hello World!" +hello = pure $ ok "Hello World!" ``` If we run the code we can test it with `curl` in command line: @@ -210,7 +212,7 @@ Let's define another handler to say `bye`: ```haskell bye :: Get IO (Resp Json) -bye = Send $ pure $ ok "Goodbye" +bye = pure $ ok "Goodbye" ``` We can add it to the server with monoid method as `Server m` is a `Monoid`: diff --git a/docs/src/02-request-anatomy.md b/docs/src/02-request-anatomy.md index f1b7942..8399f9d 100644 --- a/docs/src/02-request-anatomy.md +++ b/docs/src/02-request-anatomy.md @@ -75,7 +75,7 @@ by the name: ```haskell hello :: Query "who" Text -> Get (Resp Text) -hello (Query name) = Send $ +hello (Query name) = pure $ ok $ "Hello " <> name ``` @@ -109,7 +109,7 @@ queries in the handler. For example if we want to greet two persons we can write ```haskell hello :: Query "personA" Text -> Query "personB" Text -> Get (Resp Text) -hello (Query nameA) (Query nameB) = Send $ +hello (Query nameA) (Query nameB) = pure $ ok $ "Hello " <> nameA <> " and " <> nameB ``` @@ -118,7 +118,7 @@ For example let's add two numbers: ```haskell add :: Query "a" Int -> Query "b" Int -> Get (Resp Int) -add (Query a) (Query b) = Send $ +add (Query a) (Query b) = pure $ ok (a + b) ``` @@ -131,7 +131,7 @@ Let's for example query numbers for addition as capture parameters: ```haskell add :: Capture "a" Int -> Capture "b" Int -> Get (Resp Int) -add (Query a) (Query b) = Send $ +add (Query a) (Query b) = pure $ ok (a + b) ``` @@ -176,7 +176,7 @@ For the example we haven't altered the server and our example: ```haskell add :: Query "a" Int -> Query "b" Int -> Get (Resp Int) -add (Query a) (Query b) = Send $ +add (Query a) (Query b) = pure $ ok (a + b) server = "api/v1/add" /. add @@ -223,7 +223,7 @@ data AddInput = AddInput -- | Using JSON as body request handleAddJson :: Body AddInput -> Post (Resp Int) -handleAddJson (Body (AddInput a b)) = Send $ +handleAddJson (Body (AddInput a b)) = pure $ ok $ a + b ``` @@ -291,7 +291,7 @@ server = -- | Simple getter helloWorld :: Get (Resp Text) -helloWorld = Send $ do +helloWorld = do pure $ ok "Hello world!" newtype TraceId = TraceId Text @@ -301,12 +301,12 @@ newtype TraceId = TraceId Text and using conditional output status -} handleSucc :: Header "Trace-Id" TraceId -> Query "value" Int -> Get (Resp Int) -handleSucc (Header _traceId) (Query n) = Send $ do +handleSucc (Header _traceId) (Query n) = pure $ ok (succ n) -- | Using optional query parameters. handleSuccOpt :: Optional "value" Int -> Get (Resp Int) -handleSuccOpt (Optional n) = Send $ do +handleSuccOpt (Optional n) = pure $ case n of Just val -> ok (succ val) Nothing -> ok 0 @@ -314,12 +314,12 @@ handleSuccOpt (Optional n) = Send $ do {-| Using several query parameters -} handleAdd :: Query "a" Int -> Query "b" Int -> Get (Resp Int) -handleAdd (Query a) (Query b) = Send $ do +handleAdd (Query a) (Query b) = pure $ ok $ a + b -- | Using query flag if flag is false returns 0 handleAddIf :: Query "a" Int -> Query "b" Int -> QueryFlag "perform" -> Get (Resp Int) -handleAddIf (Query a) (Query b) (QueryFlag addFlag) = Send $ do +handleAddIf (Query a) (Query b) (QueryFlag addFlag) = do pure $ ok $ if addFlag @@ -332,7 +332,7 @@ captured in URL. For example: > http://localhost:8085/hello/api/mul/3/100 -} handleMul :: Capture "a" Int -> Capture "b" Int -> Get (Resp Int) -handleMul (Capture a) (Capture b) = Send $ do +handleMul (Capture a) (Capture b) = do pure $ ok (a * b) data AddInput = AddInput @@ -343,7 +343,7 @@ data AddInput = AddInput -- | Using JSON as input handleAddJson :: Body AddInput -> Post (Resp Int) -handleAddJson (Body (AddInput a b)) = Send $ do +handleAddJson (Body (AddInput a b)) = pure $ ok $ a + b ``` diff --git a/docs/src/03-response-anatomy.md b/docs/src/03-response-anatomy.md index 38fa546..76ce21a 100644 --- a/docs/src/03-response-anatomy.md +++ b/docs/src/03-response-anatomy.md @@ -134,7 +134,7 @@ server = "square-root" /. squareRoot squareRoot :: Body Float -> Post (RespOr Text Float) -squareRoot (Body arg) = Send $ pure $ +squareRoot (Body arg) = pure $ if arg >= 0 then ok (sqrt arg) else bad badRequest400 "Argument for square root should be non-negative" @@ -161,7 +161,7 @@ trace id from request to the response. Let's do it with `addHeaders`: ```haskell passTrace :: Header "trace-id" Text -> Post (Resp ()) -passTrace (Header traceId) = Send $ +passTrace (Header traceId) = pure $ addHeaders [("trace-id", toHeader traceId)] $ ok () ``` diff --git a/examples/mig-example-apps/HelloWorld/Main.hs b/examples/mig-example-apps/HelloWorld/Main.hs index 85a257e..829468e 100644 --- a/examples/mig-example-apps/HelloWorld/Main.hs +++ b/examples/mig-example-apps/HelloWorld/Main.hs @@ -25,4 +25,4 @@ server = "api/v1/hello" /. hello -- | Handler takes no inputs and marked as Get HTTP-request that returns Text response as Json. hello :: Get IO (Resp Json Text) -hello = Send $ pure $ ok "Hello World!" +hello = pure $ ok "Hello World!" diff --git a/examples/mig-example-apps/RouteArgs/Main.hs b/examples/mig-example-apps/RouteArgs/Main.hs index a1ee66b..f3a2819 100644 --- a/examples/mig-example-apps/RouteArgs/Main.hs +++ b/examples/mig-example-apps/RouteArgs/Main.hs @@ -46,7 +46,7 @@ routeArgs = -- | Simple getter helloWorld :: Get (Resp Text) -helloWorld = Send $ do +helloWorld = do pure $ ok "Hello world!" newtype TraceId = TraceId Text @@ -56,7 +56,7 @@ newtype TraceId = TraceId Text and using conditional output status -} handleSucc :: Header "Trace-Id" TraceId -> Query "value" Int -> Get (Resp Int) -handleSucc (Header traceId) (Query n) = Send $ do +handleSucc (Header traceId) (Query n) = do pure $ setHeader "Trace-Id" traceId $ setStatus st $ ok (succ n) where st @@ -65,7 +65,7 @@ handleSucc (Header traceId) (Query n) = Send $ do -- | Using optional query parameters and error as RespOr. handleSuccOpt :: Optional "value" Int -> Get (RespOr Text Int) -handleSuccOpt (Optional n) = Send $ do +handleSuccOpt (Optional n) = do pure $ case n of Just val -> ok (succ val) Nothing -> bad status500 "error: no input" @@ -75,14 +75,14 @@ Note that function can have any number of arguments. We encode the input type with proper type-wrapper. -} handleAdd :: Query "a" Int -> Query "b" Int -> Get (Resp Int) -handleAdd (Query a) (Query b) = Send $ do +handleAdd (Query a) (Query b) = do pure $ addHeaders headers $ ok $ a + b where headers = [("args", "a, b")] -- | Using query flag if flag is false returns 0 handleAddIf :: Query "a" Int -> Query "b" Int -> QueryFlag "perform" -> Get (Resp Int) -handleAddIf (Query a) (Query b) (QueryFlag addFlag) = Send $ do +handleAddIf (Query a) (Query b) (QueryFlag addFlag) = do pure $ ok $ if addFlag @@ -95,7 +95,7 @@ captured in URL. For example: > http://localhost:8085/hello/api/mul/3/100 -} handleMul :: Capture "a" Int -> Capture "b" Int -> Get (Resp Int) -handleMul (Capture a) (Capture b) = Send $ do +handleMul (Capture a) (Capture b) = do pure $ ok (a * b) data AddInput = AddInput @@ -106,13 +106,12 @@ data AddInput = AddInput -- | Using JSON as input handleAddJson :: Body AddInput -> Post (Resp Int) -handleAddJson (Body (AddInput a b)) = Send $ do +handleAddJson (Body (AddInput a b)) = do pure $ ok $ a + b handleSquareRoot :: Body Float -> Post (RespOr Text Float) handleSquareRoot (Body arg) = - Send $ - pure $ - if arg >= 0 - then ok (sqrt arg) - else bad badRequest400 "Argument for square root should be non-negative" + pure $ + if arg >= 0 + then ok (sqrt arg) + else bad badRequest400 "Argument for square root should be non-negative" diff --git a/mig-extra/mig-extra.cabal b/mig-extra/mig-extra.cabal index c14a571..a07434d 100644 --- a/mig-extra/mig-extra.cabal +++ b/mig-extra/mig-extra.cabal @@ -67,5 +67,6 @@ library , template-haskell , text , time + , transformers , yaml default-language: GHC2021 diff --git a/mig-extra/package.yaml b/mig-extra/package.yaml index a3ad721..4ba3272 100644 --- a/mig-extra/package.yaml +++ b/mig-extra/package.yaml @@ -49,6 +49,7 @@ dependencies: - exceptions - mig-client - template-haskell +- transformers ghc-options: - -Wall diff --git a/mig-extra/src/Mig/Extra/Server/Common.hs b/mig-extra/src/Mig/Extra/Server/Common.hs index 2fcb23e..f2020a0 100644 --- a/mig-extra/src/Mig/Extra/Server/Common.hs +++ b/mig-extra/src/Mig/Extra/Server/Common.hs @@ -119,6 +119,7 @@ import Mig.Core hiding ( -- common codecs and types import Control.Monad.IO.Class as X +import Control.Monad.Trans.Class as X import Data.Aeson as X (FromJSON (..), ToJSON (..)) import Data.Default as X import Data.OpenApi as X (OpenApi, ToParamSchema (..), ToSchema (..)) diff --git a/mig-server/mig-server.cabal b/mig-server/mig-server.cabal index 4750462..335106d 100644 --- a/mig-server/mig-server.cabal +++ b/mig-server/mig-server.cabal @@ -108,5 +108,6 @@ library , mig-wai , openapi3 , text + , transformers , warp default-language: GHC2021 diff --git a/mig-server/package.yaml b/mig-server/package.yaml index bef568e..1a0a219 100644 --- a/mig-server/package.yaml +++ b/mig-server/package.yaml @@ -47,24 +47,23 @@ description: | > -- | Init simple hello world server whith two routes: > server :: Server IO > server = - > "api" /. "v1" /. - > mconcat + > "api/v1" /. > [ "hello" /. hello > , "bye" /. bye > ] > > -- | Handler takes no inputs and marked as Get HTTP-request that returns Text. > hello :: Get (Resp Text) - > hello = Get $ pure $ ok "Hello World" + > hello = pure $ ok "Hello World" > > -- | Handle with URL-param query and json body input as Post HTTP-request that returns Text. > bye :: Query "name" Text -> Body Text -> Post (Resp Text) - > bye (Query name) (Body greeting) = Post $ + > bye (Query name) (Body greeting) = > pure $ ok $ "Bye to " <> name <> " " <> greeting . Please see: . - * quick start guide at + * quick start guide at . * examples directory for more fun servers: at @@ -93,6 +92,7 @@ dependencies: - warp - mig-swagger-ui - data-default +- transformers ghc-options: - -Wall diff --git a/mig-server/src/Mig.hs b/mig-server/src/Mig.hs index 1d37290..a8476ab 100644 --- a/mig-server/src/Mig.hs +++ b/mig-server/src/Mig.hs @@ -155,6 +155,7 @@ module Mig ( -- common codecs and types import Control.Monad.IO.Class as X +import Control.Monad.Trans.Class as X import Data.Aeson as X (FromJSON (..), ToJSON (..)) import Data.Default as X import Data.OpenApi as X (OpenApi, ToParamSchema (..), ToSchema (..))