Reorganize modules and imports

2024-11-22 08:54:32 +03:00 · 2023-04-20 16:41:18 +00:00 · 2023-04-20 16:41:18 +00:00 · e8de3cd590
commit e8de3cd590
parent 862dbf4089
8 changed files with 120 additions and 157 deletions
--- a/lib/okapi.cabal
+++ b/lib/okapi.cabal
@ -29,11 +29,9 @@ library
  exposed-modules:
      Okapi
      Okapi.Endpoint
-      Okapi.Executable
      Okapi.Matchpoint
-      Okapi.Response
+      Okapi.Request
      Okapi.Script
-      Okapi.Server
      Okapi.Script.Path
      Okapi.Script.Query
      Okapi.Script.Headers
--- a/lib/src/Okapi/Endpoint.hs
+++ b/lib/src/Okapi/Endpoint.hs
@ -1,12 +1,17 @@
+{-# LANGUAGE BlockArguments #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE ImportQualifiedPost #-}
 {-# LANGUAGE OverloadedRecordDot #-}
+{-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeOperators #-}

 module Okapi.Endpoint where

+import Control.Natural (type (~>))
 import Data.Aeson qualified as Aeson
+import Data.ByteString qualified as BS
 import Data.CaseInsensitive qualified as CI
 import Data.OpenApi qualified as OAPI
 import Data.OpenApi.Declare qualified as OAPI
@ -14,11 +19,15 @@ import Data.Proxy
 import Data.Text qualified as Text
 import Data.Text.Encoding qualified as Text
 import Network.HTTP.Types qualified as HTTP
+import Network.Wai qualified as WAI
+import Okapi.Request (Request)
+import Okapi.Script
 import Okapi.Script.Body qualified as Body
 import Okapi.Script.Headers qualified as Headers
 import Okapi.Script.Path qualified as Path
 import Okapi.Script.Query qualified as Query
 import Okapi.Script.Responder qualified as Responder
+import Okapi.Script.ResponderHeaders (Response, toWaiResponse)

 data Endpoint p q h b r = Endpoint
  { method :: HTTP.StdMethod,
@ -159,3 +168,78 @@ genOAPIPathItem endpoint = (pathName, pathItem)
      Path.Apply pf px -> renderPath pf <> renderPath px
      Path.Static t -> "/" <> Text.unpack t
      Path.Param @p name -> "/{" <> Text.unpack name <> "}"
+
+data Plan m p q h b r = Plan
+  { transformer :: m ~> IO,
+    endpoint :: Endpoint p q h b r,
+    handler :: Monad m => p -> q -> b -> h -> r -> m Response
+  }
+
+data Executable = Run (IO WAI.Response) | Null
+
+type Compiler = Request -> Executable
+
+executable ::
+  forall m p q h b r.
+  Monad m =>
+  Plan m p q h b r ->
+  Compiler
+executable plan (method, path, query, body, headers) =
+  if method == plan.endpoint.method
+    then
+      let pathResult = fst $ Path.eval plan.endpoint.pathScript path
+          queryResult = fst $ Query.eval plan.endpoint.queryScript query
+          bodyResult = fst $ Body.eval plan.endpoint.bodyScript body
+          headersResult = fst $ Headers.eval plan.endpoint.headersScript headers
+          responderResult = fst $ Responder.eval plan.endpoint.responderScript ()
+       in case (pathResult, queryResult, bodyResult, headersResult, responderResult) of
+            (Ok p, Ok q, Ok b, Ok h, Ok r) -> Run do
+              response <- transformer plan $ handler plan p q b h r
+              return $ toWaiResponse response
+            _ -> Null
+    else Null
+
+data Info = Info
+  { author :: Text.Text,
+    name :: Text.Text
+  }
+
+data Server = Server
+  { info :: Maybe Info,
+    compilers :: [Compiler],
+    defaultResponse :: WAI.Response
+  }
+
+data Options = Options
+
+genApplication ::
+  Options ->
+  Server ->
+  WAI.Application
+genApplication _ server request respond = do
+  let Right method = HTTP.parseMethod $ WAI.requestMethod request
+      path = WAI.pathInfo request
+      query = WAI.queryString request
+      headers = WAI.requestHeaders request
+  body <- WAI.strictRequestBody request
+  let request = (method, path, query, body, headers)
+      executables = map ($ request) $ compilers server
+  case loop executables of
+    Nothing -> respond server.defaultResponse
+    Just action -> action >>= respond
+  where
+    loop :: [Executable] -> Maybe (IO WAI.Response)
+    loop [] = Nothing
+    loop (h : t) = case h of
+      Run action -> Just action
+      Null -> loop t
+
+genOpenAPISpec ::
+  Server ->
+  BS.ByteString
+genOpenAPISpec = undefined
+
+genJSClient ::
+  Server ->
+  BS.ByteString
+genJSClient = undefined
--- a/lib/src/Okapi/Executable.hs
+++ b/lib/src/Okapi/Executable.hs
@ -1,62 +0,0 @@
-{-# LANGUAGE BlockArguments #-}
-{-# LANGUAGE DeriveAnyClass #-}
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE DuplicateRecordFields #-}
-{-# LANGUAGE ImportQualifiedPost #-}
-{-# LANGUAGE LinearTypes #-}
-{-# LANGUAGE OverloadedRecordDot #-}
-{-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeOperators #-}
-
-module Okapi.Executable where
-
-import Control.Natural (type (~>))
-import Data.ByteString.Lazy qualified as LBS
-import Data.Text qualified as Text
-import GHC.Generics qualified as Generics
-import Network.HTTP.Types qualified as HTTP
-import Network.Wai qualified as WAI
-import Okapi.Endpoint (Endpoint)
-import Okapi.Endpoint qualified as Endpoint
-import Okapi.Request
-import Okapi.Response (Response)
-import Okapi.Response qualified as Response
-import Okapi.Script
-import Okapi.Script.Body qualified as Body
-import Okapi.Script.Headers qualified as Headers
-import Okapi.Script.Path qualified as Path
-import Okapi.Script.Query qualified as Query
-import Okapi.Script.Responder qualified as Responder
-import Okapi.Script.ResponderHeaders qualified as ResponderHeaders
-
-data Plan m p q h b r = Plan
-  { transformer :: m ~> IO,
-    endpoint :: Endpoint p q h b r,
-    handler :: Monad m => p -> q -> b -> h -> r -> m Response
-  }
-
-data Executable = Run (IO WAI.Response) | Null
-
-type Compiler = Request -> Executable
-
-executable ::
-  forall m p q h b r.
-  Monad m =>
-  Plan m p q h b r ->
-  Compiler
-executable plan (method, path, query, body, headers) =
-  if method == plan.endpoint.method
-    then
-      let pathResult = fst $ Path.eval plan.endpoint.pathScript path
-          queryResult = fst $ Query.eval plan.endpoint.queryScript query
-          bodyResult = fst $ Body.eval plan.endpoint.bodyScript body
-          headersResult = fst $ Headers.eval plan.endpoint.headersScript headers
-          responderResult = fst $ Responder.eval plan.endpoint.responderScript ()
-       in case (pathResult, queryResult, bodyResult, headersResult, responderResult) of
-            (Ok p, Ok q, Ok b, Ok h, Ok r) -> Run do
-              response <- transformer plan $ handler plan p q b h r
-              return $ Response.toWaiResponse response
-            _ -> Null
-    else Null
--- a/lib/src/Okapi/Matchpoint.hs
+++ b/lib/src/Okapi/Matchpoint.hs
@ -6,19 +6,26 @@
 module Okapi.Matchpoint where

 import Control.Natural (type (~>))
+import Data.ByteString qualified as BS
 import Data.ByteString.Lazy qualified as LBS
 import Data.Text qualified as Text
 import Network.HTTP.Types qualified as HTTP
 import Network.Wai qualified as WAI
 import Okapi.Request (Request)
-import Okapi.Response (Response)
-import Okapi.Response qualified as Response

 pattern Matchpoint :: HTTP.StdMethod -> [Text.Text] -> HTTP.Query -> LBS.ByteString -> HTTP.RequestHeaders -> Request
 pattern Matchpoint method path query body headers <- (method, path, query, body, headers)

 type Server m = Monad m => Request -> m Response

+data Response = Response
+  { status :: HTTP.Status,
+    headers :: [ResponseHeader],
+    body :: LBS.ByteString
+  }
+
+data ResponseHeader = ResponseHeader HTTP.HeaderName BS.ByteString
+
 instantiate :: Monad m => (m ~> IO) -> Server m -> WAI.Application
 instantiate transformer server waiRequest respond = do
  let Right method = HTTP.parseMethod $ WAI.requestMethod waiRequest
@ -28,4 +35,7 @@ instantiate transformer server waiRequest respond = do
  body <- WAI.strictRequestBody waiRequest
  let request = (method, path, query, body, headers)
  response <- transformer $ server request
-  respond $ Response.toWaiResponse response
+  respond $ toWaiResponse response
+
+toWaiResponse :: Response -> WAI.Response
+toWaiResponse = undefined
--- a/lib/src/Okapi/Response.hs
+++ b/lib/src/Okapi/Response.hs
@ -1,17 +0,0 @@
-module Okapi.Response where
-
-import qualified Data.ByteString as BS
-import qualified Data.ByteString.Lazy as LBS
-import qualified Network.HTTP.Types as HTTP
-import qualified Network.Wai as WAI
-
-data Response = Response
-  { status :: HTTP.Status,
-    headers :: [ResponseHeader],
-    body :: LBS.ByteString
-  }
-
-data ResponseHeader = ResponseHeader HTTP.HeaderName BS.ByteString
-
-toWaiResponse :: Response -> WAI.Response
-toWaiResponse = undefined
--- a/lib/src/Okapi/Script/Responder.hs
+++ b/lib/src/Okapi/Script/Responder.hs
@ -19,10 +19,8 @@ import Data.Text qualified as Text
 import Data.Text.Encoding qualified as Text
 import GHC.Generics qualified as Generics
 import Network.HTTP.Types qualified as HTTP
-import Okapi.Response
-import Okapi.Response qualified as Response
-import Okapi.Response qualified as ResponseHeaders
 import Okapi.Script
+import Okapi.Script.ResponderHeaders (Response (..))
 import Okapi.Script.ResponderHeaders qualified as ResponderHeaders
 import Web.Cookie qualified as Web
 import Web.HttpApiData qualified as Web
@ -44,9 +42,9 @@ data Script a where
    HTTP.Status ->
    ResponderHeaders.Script h ->
    Script
-      ( (h %1 -> (ResponseHeaders.Response -> ResponseHeaders.Response)) ->
+      ( (h %1 -> (Response -> Response)) ->
        a ->
-        ResponseHeaders.Response
+        Response
      )

 instance Functor Script where
@ -74,10 +72,10 @@ eval op state = case op of
  JSON status responderHeaders -> case ResponderHeaders.eval responderHeaders () of
    (Ok h, _) ->
      let f headerApplicator payload =
-            Response.Response
-              { Response.status = status,
-                Response.body = Aeson.encode payload,
-                Response.headers = []
+            Response
+              { status = status,
+                body = Aeson.encode payload,
+                headers = []
              }
       in (Ok f, state)
    (left, _) -> (Fail ResponderHeadersError, state)
@ -87,8 +85,8 @@ json ::
  HTTP.Status ->
  ResponderHeaders.Script h ->
  Script
-    ( (h %1 -> (ResponseHeaders.Response -> ResponseHeaders.Response)) ->
+    ( (h %1 -> (Response -> Response)) ->
      a ->
-      ResponseHeaders.Response
+      Response
    )
 json = JSON
--- a/lib/src/Okapi/Script/ResponderHeaders.hs
+++ b/lib/src/Okapi/Script/ResponderHeaders.hs
@ -19,7 +19,7 @@ import Data.Text qualified as Text
 import Data.Text.Encoding qualified as Text
 import GHC.Generics qualified as Generics
 import Network.HTTP.Types qualified as HTTP
-import Okapi.Response
+import Network.Wai qualified as WAI
 import Okapi.Script
 import Web.Cookie qualified as Web
 import Web.HttpApiData qualified as Web
@ -45,6 +45,17 @@ instance Applicative Script where
  pure = Pure
  (<*>) = Apply

+data Response = Response
+  { status :: HTTP.Status,
+    headers :: [ResponseHeader],
+    body :: LBS.ByteString
+  }
+
+data ResponseHeader = ResponseHeader HTTP.HeaderName BS.ByteString
+
+toWaiResponse :: Response -> WAI.Response
+toWaiResponse = undefined
+
 eval ::
  Script a ->
  () ->
@ -69,4 +80,4 @@ has ::
  HTTP.HeaderName ->
  Script
    (a -> Response -> Response)
-has = Has
+has = Has
--- a/lib/src/Okapi/Server.hs
+++ b/lib/src/Okapi/Server.hs
@ -1,59 +0,0 @@
-{-# LANGUAGE OverloadedRecordDot #-}
-{-# LANGUAGE OverloadedStrings #-}
-
-module Okapi.Server where
-
-import qualified Control.Monad.Par as Par
-import qualified Data.ByteString as BS
-import qualified Data.ByteString.Lazy as LBS
-import Data.List.NonEmpty (NonEmpty ((:|)))
-import qualified Data.Text as Text
-import qualified Network.HTTP.Types as HTTP
-import qualified Network.Wai as WAI
-import Okapi.Executable
-import qualified Okapi.Executable as Executable
-
-data Info = Info
-  { author :: Text.Text,
-    name :: Text.Text
-  }
-
-data Server = Server
-  { info :: Maybe Info,
-    compilers :: [Compiler],
-    defaultResponse :: WAI.Response
-  }
-
-data Options = Options
-
-genApplication ::
-  Options ->
-  Server ->
-  WAI.Application
-genApplication _ server request respond = do
-  let Right method = HTTP.parseMethod $ WAI.requestMethod request
-      path = WAI.pathInfo request
-      query = WAI.queryString request
-      headers = WAI.requestHeaders request
-  body <- WAI.strictRequestBody request
-  let request = (method, path, query, body, headers)
-      executables = map ($ request) $ compilers server
-  case loop executables of
-    Nothing -> respond server.defaultResponse
-    Just action -> action >>= respond
-  where
-    loop :: [Executable] -> Maybe (IO WAI.Response)
-    loop [] = Nothing
-    loop (h : t) = case h of
-      Run action -> Just action
-      Null -> loop t
-
-genOpenAPISpec ::
-  Server ->
-  BS.ByteString
-genOpenAPISpec = undefined
-
-genJSClient ::
-  Server ->
-  BS.ByteString
-genJSClient = undefined