From ffed0273e7ed291ba29d2c4db7713084f239533a Mon Sep 17 00:00:00 2001 From: Anton Kholomiov Date: Thu, 2 Nov 2023 18:31:24 +0300 Subject: [PATCH] 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 (..))