Use heterogenous list instead of Secret keys to pass arguments to handlers

lib/okapi.cabal

@@ -28,10 +28,10 @@ source-repository head
 library
   exposed-modules:
       Okapi
-      Okapi.Pattern
+      Okapi.Route.Pattern
       Okapi.Headers
       Okapi.Secret
-      Okapi.API
+      Okapi.App
       Okapi.Route
       Okapi.Response
   other-modules:
@@ -53,6 +53,8 @@ library
     , natural-transformation
     , network
     , pretty-simple
+    , recursion-schemes
+    , regex-tdfa
     , text
     , vault
     , wai

lib/src/Okapi.hs

@@ -17,8 +17,6 @@
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE QualifiedDo #-}
--- {-# LANGUAGE RebindableSyntax #-}
 
 module Okapi where
 
@@ -36,23 +34,25 @@ import Network.HTTP.Types qualified as HTTP
 import Network.Wai qualified as Wai
 import Network.Wai.Handler.Warp qualified as Warp
 import Network.Wai.Middleware.RequestLogger qualified as Wai
-import Okapi.API qualified as API
+import Okapi.App
-import Okapi.API
+import Okapi.App qualified as App
 import Okapi.Headers qualified as Headers
 import Okapi.Route qualified as Route
 import Okapi.Secret qualified as Secret
 import Text.Pretty.Simple qualified as Pretty
 import Web.HttpApiData qualified as Web
 
+{-
 test1 :: IO ()
 test1 = do
   apiTreeRep <- forest testAPI
   putStrLn $ Tree.drawTree apiTreeRep
-  Warp.run 1234 $ (build testAPI id) backupWaiApp
   where
+    -- Warp.run 1234 $ (build testAPI id) backupWaiApp
+
     backupWaiApp = \req resp -> do
       resp $ Wai.responseLBS HTTP.status200 [] "The test app failed..."
-    testAPI :: [API]
+    testAPI :: [App]
     testAPI =
       [ lit
           "" -- Won't be matched because you can't request http://localhost:1234/
@@ -82,11 +82,12 @@ test2 :: IO ()
 test2 = do
   apiTreeRep <- forest testAPI
   putStrLn $ Tree.drawTree apiTreeRep
-  Warp.run 1234 $ (build testAPI id) backupWaiApp
   where
+    -- Warp.run 1234 $ (build testAPI id) backupWaiApp
+
     backupWaiApp = \req resp -> do
       resp $ Wai.responseLBS HTTP.status200 [] "The test app failed..."
-    testAPI :: [API]
+    testAPI :: [App]
     testAPI =
       lit
         "" -- Won't be matched because you can't request http://localhost:1234/
@@ -117,11 +118,12 @@ test3 :: IO ()
 test3 = do
   apiTreeRep <- forest testAPI
   putStrLn $ Tree.drawTree apiTreeRep
-  Warp.run 1234 $ (build testAPI id) backupWaiApp
   where
+    -- Warp.run 1234 $ (build testAPI id) backupWaiApp
+
     backupWaiApp = \_ resp -> do
       resp $ Wai.responseLBS HTTP.status200 [] "The test app failed..."
-    testAPI :: [API]
+    testAPI :: [App]
     testAPI =
       [ lit
           "numbers"
@@ -159,7 +161,7 @@ test4 = do
 
     backupWaiApp = \_ resp -> do
       resp $ Wai.responseLBS HTTP.status404 [] "The test app failed..."
-    testAPI :: [API]
+    testAPI :: [App]
     testAPI =
       [ lit
           "numbers"
@@ -197,13 +199,14 @@ test5 = do
   apiTreeRep <- forest testAPI
   -- apiEndpoints <- endpoints testAPI
   putStrLn $ Tree.drawTree apiTreeRep
-  -- Pretty.pPrint $ map curl $ List.reverse apiEndpoints
   where
+    -- Pretty.pPrint $ map curl $ List.reverse apiEndpoints
+
     -- Warp.run 1234 $ build testAPI id backupWaiApp
 
     backupWaiApp = \_ resp -> do
       resp $ Wai.responseLBS HTTP.status404 [] "The test app failed..."
-    testAPI :: [API]
+    testAPI :: [App]
     testAPI =
       [ lit "numbers" $
           [ getIO_ \req -> do
@@ -212,7 +215,7 @@ test5 = do
             ++ map opAPI [Add, Sub, Mul]
       ]
 
-opAPI :: Op -> API
+opAPI :: Op -> App
 opAPI op =
   match
     op
@@ -241,3 +244,19 @@ opAPI op =
               ]
             _ -> []
     ]
+-}
+-- test6 :: IO ()
+-- test6 = do
+--   apiTreeRep <- forest testAPI
+--   putStrLn $ Tree.drawTree apiTreeRep
+--   where
+--     backupWaiApp = \req resp -> do
+--       resp $ Wai.responseLBS HTTP.status200 [] "The test app failed..."
+--     testAPI :: [App]
+--     testAPI =
+--       [ endpoint HTTP.GET (do Route.lit "user";) id \_ req -> do
+--           undefined
+--       , endpoint HTTP.POST (do Route.lit "user"; id' <- Route.param @Int; return id') id \userIDS req -> do
+--           let userID = Secret.tell req userIDS
+--           undefined
+--       ]

lib/src/Okapi/API.hs

@@ -1,206 +0,0 @@
-{-# LANGUAGE AllowAmbiguousTypes #-}
-{-# LANGUAGE ApplicativeDo #-}
-{-# LANGUAGE BlockArguments #-}
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE FunctionalDependencies #-}
-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE ImportQualifiedPost #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE PolyKinds #-}
-{-# LANGUAGE QualifiedDo #-}
-{-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE StandaloneKindSignatures #-}
-{-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE UndecidableInstances #-}
-
-module Okapi.API where
-
-import Control.Natural qualified as Natural
-import Data.Binary.Builder qualified as Builder
-import Data.ByteString.Lazy qualified as LBS
-import Data.Functor.Identity qualified as Identity
-import Data.Kind
-import Data.List qualified as List
-import Data.List.NonEmpty qualified as NonEmpty
-import Data.Text qualified as Text
-import Data.Tree qualified as Tree
-import Data.Type.Equality qualified as Equality
-import Data.Typeable qualified as Typeable
-import Data.Vault.Lazy qualified as Vault
-import GHC.Exts qualified as Exts
-import GHC.Generics qualified as Generics
-import GHC.Natural qualified as Natural
-import Network.HTTP.Types qualified as HTTP
-import Network.Wai qualified as Wai
-import Okapi.Headers qualified as Headers
-import Okapi.Response qualified as Response
-import Okapi.Route qualified as Route
-import Okapi.Secret qualified as Secret
-import Web.HttpApiData qualified as Web
-
-type Handler env = Wai.Request -> env Wai.Response
-
-data API where
-  Match :: forall a. (Web.ToHttpApiData a) => a -> [API] -> API
-  Param :: forall a. (Web.FromHttpApiData a, Typeable.Typeable a) => (Secret.Secret a -> [API]) -> API
-  Regex :: API
-  Splat :: forall a. (Web.FromHttpApiData a) => (Secret.Secret (NonEmpty.NonEmpty a) -> [API]) -> API
-  Route :: forall a. Route.Parser a -> (Secret.Secret a -> [API]) -> API
-  Method :: forall env. HTTP.StdMethod -> (env Natural.~> IO) -> Handler env -> API
-  -- Query :: forall a. Query.Parser a -> (Secret.Secret a -> [API]) -> API
-  -- Headers :: forall a. RequestHeaders.Parser a -> (Secret.Secret a -> [API]) -> API
-  -- Body :: forall a. RequestBody.Parser a -> (Secret.Secret a -> [API]) -> API
-  Pipe :: Wai.Middleware -> API -> API
-  Respond ::
-    forall (status :: Natural.Natural) (headerKeys :: [Exts.Symbol]) (contentType :: Type) (resultType :: Type).
-    (Response.ToContentType contentType resultType) =>
-    ((Response.Headers headerKeys -> resultType -> Wai.Response) -> [API]) ->
-    API
-
-match :: forall a. (Web.ToHttpApiData a) => a -> [API] -> API
-match = Match
-
-lit :: Text.Text -> [API] -> API
-lit = match @Text.Text
-
-param :: forall a. (Web.FromHttpApiData a, Typeable.Typeable a) => (Secret.Secret a -> [API]) -> API
-param = Param
-
-splat :: forall a. (Web.FromHttpApiData a) => (Secret.Secret (NonEmpty.NonEmpty a) -> [API]) -> API
-splat = Splat
-
-route :: forall a. Route.Parser a -> (Secret.Secret a -> [API]) -> API
-route = Route
-
-pipe :: Wai.Middleware -> API -> API
-pipe = Pipe
-
-scope :: Wai.Middleware -> Text.Text -> [API] -> API
-scope mw t apps = pipe mw $ lit t apps
-
-method :: forall env. HTTP.StdMethod -> (env Natural.~> IO) -> Handler env -> API
-method = Method
-
-respond ::
-  forall (status :: Natural.Natural) (headerKeys :: [Exts.Symbol]) (contentType :: Type) (resultType :: Type).
-  (Response.ToContentType contentType resultType) =>
-  ((Response.Headers headerKeys -> resultType -> Wai.Response) -> [API]) ->
-  API
-respond = Respond
-
-build :: [API] -> Wai.Middleware -> Wai.Middleware
-build [] _ backup req resp = backup req resp
-build (api : apis) middlewareToApply backup req resp =
-  case api of
-    Match value children ->
-      case Wai.pathInfo req of
-        [] -> build apis middlewareToApply backup req resp
-        (pathHead : pathTail) ->
-          if pathHead == Web.toUrlPiece value
-            then do
-              let newReq = req {Wai.pathInfo = pathTail}
-              build children middlewareToApply backup newReq resp
-            else build apis middlewareToApply backup req resp
-    Param @ty produce ->
-      case Wai.pathInfo req of
-        [] -> build apis middlewareToApply backup req resp
-        (pathHead : pathTail) ->
-          case Web.parseUrlPiece @ty pathHead of
-            Left _ -> build apis middlewareToApply backup req resp
-            Right value -> do
-              key <- Vault.newKey @ty
-              let newVault = Vault.insert key value (Wai.vault req)
-                  newReq = req {Wai.pathInfo = pathTail, Wai.vault = newVault}
-              build (produce $ Secret.Secret key) middlewareToApply backup newReq resp
-    Splat @ty produce -> do
-      case Wai.pathInfo req of
-        [] -> build apis middlewareToApply backup req resp
-        (pathHead : pathTail) -> case Web.parseUrlPiece @ty pathHead of
-          Left _ -> build apis middlewareToApply backup req resp
-          Right valueHead -> do
-            -- TODO: FIX ALGORITHM!
-            let valueTail = loop @ty pathTail
-                nonEmptyPath = valueHead NonEmpty.:| valueTail
-            key <- Vault.newKey @(NonEmpty.NonEmpty ty)
-            let newVault = Vault.insert key nonEmptyPath (Wai.vault req)
-                newReq = req {Wai.pathInfo = List.drop (List.length valueTail + 1) (Wai.pathInfo req), Wai.vault = newVault}
-            build (produce $ Secret.Secret key) middlewareToApply backup newReq resp
-      where
-        loop :: forall ty. (Web.FromHttpApiData ty) => [Text.Text] -> [ty]
-        loop [] = []
-        loop (t : ts) = case Web.parseUrlPiece @ty t of
-          Left _ -> []
-          Right v -> v : loop @ty ts
-    Route @ty route produce -> do
-      case Route.exec route $ Wai.pathInfo req of
-        (Left _, _) -> build apis middlewareToApply backup req resp
-        (Right value, newPathInfo) -> do
-          key <- Vault.newKey @ty
-          let newVault = Vault.insert key value (Wai.vault req)
-              newReq = req {Wai.pathInfo = newPathInfo, Wai.vault = newVault}
-          build (produce $ Secret.Secret key) middlewareToApply backup newReq resp
-    Method m trans handler ->
-      case HTTP.parseMethod $ Wai.requestMethod req of
-        Left _ -> build apis middlewareToApply backup req resp
-        Right stdMethod ->
-          if m == stdMethod && List.null (Wai.pathInfo req)
-            then
-              middlewareToApply
-                ( \req' resp' -> do
-                    res <- trans $ handler req'
-                    resp' res
-                )
-                req
-                resp
-            else build apis middlewareToApply backup req resp
-    Pipe otherMiddlewareToApply app ->
-      build
-        (app : [])
-        (otherMiddlewareToApply . middlewareToApply)
-        (build apis middlewareToApply backup)
-        req
-        resp
-
-forest :: [API] -> IO (Tree.Tree String)
-forest [] = return $ Tree.Node ":root:" []
-forest apis = do
-  forest' <- mapM tree apis
-  return $ Tree.Node "\ESC[31m:root:\ESC[0m" forest'
-  where
-    tree :: API -> IO (Tree.Tree String)
-    tree (Match value apis) = do
-      forest <- mapM tree apis
-      return $ Tree.Node ("/" <> (Text.unpack $ Web.toUrlPiece value)) forest
-    tree (Param @ty produce) = do
-      secret <- Secret.new @ty
-      forest <- mapM tree $ produce secret
-      return $ Tree.Node ("/:" <> showType @ty) forest
-    tree (Splat @ty produce) = do
-      secret <- Secret.new @(NonEmpty.NonEmpty ty)
-      forest <- mapM tree $ produce secret
-      return $ Tree.Node "/*" forest
-    tree (Route @ty route produce) = do
-      secret <- Secret.new @ty
-      forest <- mapM tree $ produce secret
-      return $ Tree.Node (Text.unpack (Route.rep route)) forest
-    tree (Method m _ _) = do
-      return $ Tree.Node (show m) []
-    tree (Pipe _ api) = do
-      (Tree.Node root subTrees) <- tree api
-      return $ Tree.Node ("(" <> root <> ")") subTrees
-
-showType :: forall a. (Typeable.Typeable a) => String
-showType = show . Typeable.typeRep $ Typeable.Proxy @a
-
-get_ = method HTTP.GET
-
-getIO_ = method HTTP.GET id

lib/src/Okapi/App.hs

@@ -0,0 +1,494 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE ApplicativeDo #-}
+{-# LANGUAGE BlockArguments #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE ImportQualifiedPost #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedRecordDot #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE QualifiedDo #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+module Okapi.App where
+
+import Control.Natural qualified as Natural
+import Data.Binary.Builder qualified as Builder
+import Data.ByteString.Lazy qualified as LBS
+import Data.ByteString.Lazy.Char8 qualified as LBSChar8
+import Data.Functor.Base qualified as Base
+import Data.Functor.Foldable qualified as Foldable
+import Data.Functor.Identity qualified as Identity
+import Data.Kind
+import Data.List qualified as List
+import Data.List.NonEmpty qualified as NonEmpty
+import Data.Text qualified as Text
+import Data.Tree qualified as Tree
+import Data.Type.Equality qualified as Equality
+import Data.Typeable qualified as Typeable
+import Data.Vault.Lazy qualified as Vault
+import GHC.Exts qualified as Exts
+import GHC.Generics qualified as Generics
+import GHC.Natural qualified as Natural
+import Network.HTTP.Types qualified as HTTP
+import Network.Wai qualified as Wai
+import Network.Wai.Handler.Warp qualified as Warp
+import Okapi.Headers qualified as Headers
+import Okapi.Response qualified as Response
+import Okapi.Route qualified as Route
+import Okapi.Secret qualified as Secret
+import Text.Regex.TDFA qualified as Regex
+import Web.HttpApiData qualified as Web
+
+type Tree r = [Node r]
+
+type (:>) :: [Type] -> Type -> [Type]
+type family (:>) (a :: [Type]) (b :: Type) where
+  (:>) '[] b = '[b]
+  (:>) (aa : aas) b = aa : (aas :> b)
+
+data Node (r :: [Type]) where
+  Match :: forall a (r :: [Type]). (Web.ToHttpApiData a) => a -> Tree r -> Node r
+  Param :: forall a (r :: [Type]). (Web.FromHttpApiData a, Typeable.Typeable a) => Tree (r :> a) -> Node r
+  -- Regex :: forall a (r :: [Type]). (Regex.RegexContext Regex.Regex Text.Text a) => Text.Text -> Tree (a : r) -> Node (a : r)
+  -- Splat :: forall a (r :: [Type]). (Web.FromHttpApiData a, Typeable.Typeable a) => Tree (NonEmpty.NonEmpty a : r) -> Node (NonEmpty.NonEmpty a : r)
+  -- Route :: forall a (r :: [Type]). Route.Parser a -> Tree (a : r) -> Node (a : r)
+  Method :: forall env (r :: [Type]). HTTP.StdMethod -> (env Natural.~> IO) -> Handler r env -> Node r
+
+-- Query :: forall a. Query.Parser a -> (Secret.Secret a -> Tree) -> Node
+-- Headers :: forall a. RequestHeaders.Parser a -> (Secret.Secret a -> Tree) -> Node
+-- Body :: forall a. RequestBody.Parser a -> (Secret.Secret a -> Tree) -> Node
+-- Apply :: forall (r :: [Type]). Wai.Middleware -> Node r -> Node r
+
+type Handler :: [Type] -> (Type -> Type) -> Type
+type family Handler args env where
+  Handler '[] env = Wai.Request -> env Wai.Response
+  Handler (arg : args) env = arg -> Handler args env
+
+argsTest :: Handler '[] IO
+argsTest = \request -> do
+  return $ Wai.responseLBS HTTP.status200 [] "world"
+
+argsTest1 :: Handler '[Int] IO
+argsTest1 = \x -> \request -> do
+  return $ Wai.responseLBS HTTP.status200 [] "world"
+
+argsTest2 :: Handler '[Int, Int] IO
+argsTest2 = \x -> \y -> \request -> do
+  return $ Wai.responseLBS HTTP.status200 [] "world"
+
+match :: forall a (r :: [Type]). (Web.ToHttpApiData a) => a -> Tree r -> Node r
+match = Match
+
+lit :: forall (r :: [Type]). Text.Text -> Tree r -> Node r
+lit = match @Text.Text
+
+param :: forall a (r :: [Type]). (Web.FromHttpApiData a, Typeable.Typeable a) => Tree (r :> a) -> Node r
+param = Param @a @r
+
+method :: forall env (r :: [Type]). HTTP.StdMethod -> (env Natural.~> IO) -> Handler r env -> Node r
+method = Method
+
+type Root = '[]
+
+myTest = Warp.run 8080 $ test `withDefault` \_ resp -> resp $ Wai.responseLBS HTTP.status404 [] "Not Found..."
+
+test :: Tree Root
+test =
+  [ lit
+      "hello"
+      [ lit
+          "world"
+          [ param @Bool
+              [ method HTTP.GET id testHandler1,
+                param @Int
+                  [ method HTTP.GET id testHandler2,
+                    lit
+                      "foo"
+                      [ method HTTP.POST id testHandler2
+                      ],
+                    param @Float
+                      [ method HTTP.PUT id \bool1 -> \int2 -> \f3 -> \req -> do
+                          return $ Wai.responseLBS HTTP.status200 [] "many args"
+                      ]
+                  ]
+              ]
+          ]
+      ],
+    lit
+      "world"
+      [ method HTTP.GET id \req -> do
+          return $ Wai.responseLBS HTTP.status200 [] "world",
+        method HTTP.HEAD id \req -> do
+          return $ Wai.responseLBS HTTP.status200 [] "dub"
+      ],
+    method HTTP.GET id \req -> do
+      return $ Wai.responseLBS HTTP.status200 [] "What's up??"
+  ]
+
+testHandler1 :: Bool -> Wai.Request -> IO Wai.Response
+testHandler1 x request = do
+  return $ Wai.responseLBS HTTP.status200 [] $ LBSChar8.pack $ show x
+
+testHandler2 :: Bool -> Int -> Wai.Request -> IO Wai.Response
+testHandler2 x y request = do
+  return $ Wai.responseLBS HTTP.status200 [] $ LBSChar8.pack $ show x <> show y
+
+data HList (l :: [Type]) where
+  HNil :: HList '[]
+  HCons :: e -> HList l -> HList (e ': l)
+
+snoc :: forall (l :: [Type]) (e :: Type). HList l -> e -> HList (l :> e)
+snoc HNil x = HCons x HNil
+snoc (HCons h t) x = HCons h (snoc t x)
+
+-- type Reverse :: [Type] -> [Type]
+-- type family Reverse l where
+--   Reverse '[] = '[]
+--   Reverse (h : t) = Reverse t :> h
+
+fillHandler :: Handler args env -> HList args -> (Wai.Request -> env Wai.Response)
+fillHandler handler HNil = handler
+fillHandler handler (HCons x xs) = fillHandler (handler x) xs
+
+myFunc :: Wai.Request -> IO Wai.Response
+myFunc = fillHandler handlerTest argsTest
+  where
+    handlerTest :: Handler [Bool, Int, Float] IO
+    handlerTest = \b -> \i -> \f -> \req -> do
+      undefined
+
+    argsTest :: HList '[Bool, Int, Float]
+    argsTest = HCons True (HCons 5 (HCons 5.8 HNil))
+
+withDefault :: Tree Root -> Wai.Middleware
+withDefault = withDefaultLoop id HNil
+
+withDefaultLoop :: Wai.Middleware -> HList args -> Tree args -> Wai.Middleware
+withDefaultLoop middleware args tree backup request respond = case tree of
+  [] -> backup request respond
+  (node : remTree) ->
+    case node of
+      Match value subTree ->
+        case Wai.pathInfo request of
+          [] -> withDefaultLoop middleware args remTree backup request respond
+          (pathHead : pathTail) ->
+            if pathHead == Web.toUrlPiece value
+              then do
+                let newRequest = request {Wai.pathInfo = pathTail}
+                withDefaultLoop middleware args subTree backup newRequest respond
+              else withDefaultLoop middleware args remTree backup request respond
+      Param @t subTree ->
+        case Wai.pathInfo request of
+          [] -> withDefaultLoop middleware args remTree backup request respond
+          (pathHead : pathTail) ->
+            case Web.parseUrlPiece @t pathHead of
+              Left _ -> withDefaultLoop middleware args remTree backup request respond
+              Right value -> do
+                let newRequest = request {Wai.pathInfo = pathTail}
+                withDefaultLoop middleware (snoc args value) subTree backup newRequest respond
+      Method stdMethod transformation handler ->
+        case HTTP.parseMethod $ Wai.requestMethod request of
+          Left _ -> withDefaultLoop middleware args remTree backup request respond
+          Right stdMethod' ->
+            if stdMethod == stdMethod' && List.null (Wai.pathInfo request)
+              then
+                middleware
+                  ( \request' respond' -> do
+                      response <- transformation $ fillHandler handler args request'
+                      respond' response
+                  )
+                  request
+                  respond
+              else withDefaultLoop middleware args remTree backup request respond
+
+{-
+type Remove :: Exts.Symbol -> [Exts.Symbol] -> [Exts.Symbol]
+type family Remove x ys where
+  Remove a '[] = '[]
+  Remove a (a ': ys) = ys
+  Remove a (y ': ys) = y ': (Remove a ys)
+-}
+
+{-
+data Node (r :: [Type]) where
+  Match :: forall a (r :: [Type]). (Web.ToHttpApiData a) => a -> Tree r -> Node r
+  Param :: forall a. (Web.FromHttpApiData a, Typeable.Typeable a) => (Secret.Secret a -> Tree) -> Node
+  Regex :: forall a. (Regex.RegexContext Regex.Regex Text.Text a) => Text.Text -> (Secret.Secret a -> Tree) -> Node
+  Splat :: forall a. (Web.FromHttpApiData a, Typeable.Typeable a) => (Secret.Secret (NonEmpty.NonEmpty a) -> Tree) -> Node
+  Route :: forall a. Route.Parser a -> (Secret.Secret a -> Tree) -> Node
+  Method :: forall env. HTTP.StdMethod -> (env Natural.~> IO) -> Handler env -> Node
+  -- Query :: forall a. Query.Parser a -> (Secret.Secret a -> Tree) -> Node
+  -- Headers :: forall a. RequestHeaders.Parser a -> (Secret.Secret a -> Tree) -> Node
+  -- Body :: forall a. RequestBody.Parser a -> (Secret.Secret a -> Tree) -> Node
+  Apply :: Wai.Middleware -> Node -> Node
+-}
+
+-- Respond ::
+--   forall (status :: Natural.Natural) (headerKeys :: [Exts.Symbol]) (contentType :: Type) (resultType :: Type).
+--   (Response.ToContentType contentType resultType) =>
+--   ((Response.Headers headerKeys -> resultType -> Wai.Response) -> Tree) ->
+--   Node
+
+{-
+regex :: forall a. (Regex.RegexContext Regex.Regex Text.Text a) => Text.Text -> (Secret.Secret a -> Tree) -> Node
+regex = Regex
+
+splat :: forall a. (Web.FromHttpApiData a, Typeable.Typeable a) => (Secret.Secret (NonEmpty.NonEmpty a) -> Tree) -> Node
+splat = Splat
+
+route :: forall a. Route.Parser a -> (Secret.Secret a -> Tree) -> Node
+route = Route
+
+apply :: Wai.Middleware -> Node -> Node
+apply = Apply
+
+scope :: Wai.Middleware -> Text.Text -> Tree -> Node
+scope mw t forest = apply mw $ lit t forest
+-}
+
+{-
+-- respond ::
+--   forall (status :: Natural.Natural) (headerKeys :: [Exts.Symbol]) (contentType :: Type) (resultType :: Type).
+--   (Response.ToContentType contentType resultType) =>
+--   ((Response.Headers headerKeys -> resultType -> Wai.Response) -> Tree) ->
+--   Node
+-- respond = Respond
+
+withDefault :: Tree -> Wai.Middleware
+withDefault = loop id
+  where
+    loop :: Wai.Middleware -> Tree -> Wai.Middleware
+    loop middleware forest backup request respond = case forest of
+      [] -> backup request respond
+      (tree : remForest) ->
+        case tree of
+          Match value subForest ->
+            case Wai.pathInfo request of
+              [] -> loop middleware remForest backup request respond
+              (pathHead : pathTail) ->
+                if pathHead == Web.toUrlPiece value
+                  then do
+                    let newRequest = request {Wai.pathInfo = pathTail}
+                    loop middleware subForest backup newRequest respond
+                  else loop middleware remForest backup request respond
+          Param @t growSubForest ->
+            case Wai.pathInfo request of
+              [] -> loop middleware remForest backup request respond
+              (pathHead : pathTail) ->
+                case Web.parseUrlPiece @t pathHead of
+                  Left _ -> loop middleware remForest backup request respond
+                  Right value -> do
+                    key <- Vault.newKey @t
+                    let newVault = Vault.insert key value (Wai.vault request)
+                        newRequest = request {Wai.pathInfo = pathTail, Wai.vault = newVault}
+                    loop middleware (growSubForest $ Secret.Secret key) backup newRequest respond
+          Regex @t regex growSubForest -> do
+            case Wai.pathInfo request of
+              [] -> loop middleware remForest backup request respond
+              (pathHead : pathTail) ->
+                case pathHead Regex.=~~ regex of
+                  Nothing -> loop middleware remForest backup request respond
+                  Just value -> do
+                    key <- Vault.newKey @t
+                    let newVault = Vault.insert key value (Wai.vault request)
+                        newRequest = request {Wai.pathInfo = pathTail, Wai.vault = newVault}
+                    loop middleware (growSubForest $ Secret.Secret key) backup newRequest respond
+          Splat @t growSubForest -> do
+            case Wai.pathInfo request of
+              [] -> loop middleware remForest backup request respond
+              (pathHead : pathTail) -> case Web.parseUrlPiece @t pathHead of
+                Left _ -> loop middleware remForest backup request respond
+                Right valueHead -> do
+                  key <- Vault.newKey @(NonEmpty.NonEmpty t)
+                  let valueTail = getValues @t pathTail
+                      nonEmptyPath = valueHead NonEmpty.:| valueTail
+                      newVault = Vault.insert key nonEmptyPath (Wai.vault request)
+                      newRequest = request {Wai.pathInfo = List.drop (List.length valueTail + 1) (Wai.pathInfo request), Wai.vault = newVault}
+                  loop middleware (growSubForest $ Secret.Secret key) backup newRequest respond
+            where
+              getValues :: forall ty. (Web.FromHttpApiData t) => [Text.Text] -> [t]
+              getValues [] = []
+              getValues (p : ps) = case Web.parseUrlPiece @t p of
+                Left _ -> []
+                Right v -> v : getValues @t ps
+          Route @t route growSubForest -> do
+            case Route.parse route $ Wai.pathInfo request of
+              (Left _, _) -> loop middleware remForest backup request respond
+              (Right value, newPathInfo) -> do
+                key <- Vault.newKey @t
+                let newVault = Vault.insert key value (Wai.vault request)
+                    newRequest = request {Wai.pathInfo = newPathInfo, Wai.vault = newVault}
+                loop middleware (growSubForest $ Secret.Secret key) backup newRequest respond
+          Method stdMethod transformation handler ->
+            case HTTP.parseMethod $ Wai.requestMethod request of
+              Left _ -> loop middleware remForest backup request respond
+              Right stdMethod' ->
+                if stdMethod == stdMethod' && List.null (Wai.pathInfo request)
+                  then
+                    middleware
+                      ( \request' respond' -> do
+                          response <- transformation $ handler request'
+                          respond' response
+                      )
+                      request
+                      respond
+                  else loop middleware remForest backup request respond
+          Apply middleware' tree ->
+            loop
+              (middleware' . middleware)
+              (tree : [])
+              (loop middleware remForest backup)
+              request
+              respond
+-}
+{-
+stringify :: Tree -> IO (Node.Tree String)
+stringify [] = return []
+stringify (tree:remForest) = case tree of
+  Match value subForest -> do
+    stringSubForest <- stringify subForest
+    stringRemForest <- stringify remForest
+    let string = "/" <> (Text.unpack $ Web.toUrlPiece value)
+    return ((Tree.Node string stringSubForest) : stringRemForest)
+  Param @t growSubForest -> do
+    secret <- Secret.new @t
+    stringSubForest <- stringify $ growSubForest secret
+    stringRemForest <- stringify remForest
+    let string = "/:" <> showType @t
+    return ((Tree.Node string stringSubForest) : stringRemForest)
+  Regex @t regex growSubForest -> do
+    secret <- Secret.new @t
+    stringSubForest <- stringify $ growSubForest secret
+    stringRemForest <- stringify remForest
+    let string = "/<" <> Text.unpack regex <> ">"
+    return ((Tree.Node string stringSubForest) : stringRemForest)
+  Splat @t growSubForest -> do
+    secret <- Secret.new @(NonEmpty.NonEmpty ty)
+    forest <- mapM $ produce secret
+    return $ Tree.Node ("/*" <> showType @ty) forest
+  (Route @ty route produce) = do
+    secret <- Secret.new @ty
+    forest <- mapM $ produce secret
+    return $ Tree.Node (Text.unpack (Route.rep route)) forest
+  (Method m _ _) = do
+    return $ Tree.Node (show m) []
+  (Apply _ api) = do
+    (Tree.Node root subTrees) <- api
+    return $ Tree.Node ("(" <> root <> ")") subTrees
+-}
+{-
+forest :: Tree -> IO (Tree.Node String)
+forest [] = return $ Tree.Node ":root:" []
+forest apis = do
+  forest' <- mapM tree apis
+  return $ Tree.Node "\ESC[31m:root:\ESC[0m" forest'
+  where
+    tree :: Node -> IO (Tree.Node String)
+    tree (Match value apis) = do
+      forest <- mapM tree apis
+      return $ Tree.Node ("/" <> (Text.unpack $ Web.toUrlPiece value)) forest
+    tree (Param @ty produce) = do
+      secret <- Secret.new @ty
+      forest <- mapM tree $ produce secret
+      return $ Tree.Node ("/:" <> showType @ty) forest
+    tree (Regex @ty regex produce) = do
+      secret <- Secret.new @ty
+      forest <- mapM tree $ produce secret
+      return $ Tree.Node ("/r<" <> Text.unpack regex <> ">") forest
+    tree (Splat @ty produce) = do
+      secret <- Secret.new @(NonEmpty.NonEmpty ty)
+      forest <- mapM tree $ produce secret
+      return $ Tree.Node ("/*" <> showType @ty) forest
+    tree (Route @ty route produce) = do
+      secret <- Secret.new @ty
+      forest <- mapM tree $ produce secret
+      return $ Tree.Node (Text.unpack (Route.rep route)) forest
+    tree (Method m _ _) = do
+      return $ Tree.Node (show m) []
+    tree (Apply _ api) = do
+      (Tree.Node root subTrees) <- tree api
+      return $ Tree.Node ("(" <> root <> ")") subTrees
+
+showType :: forall a. (Typeable.Typeable a) => String
+showType = show . Typeable.typeRep $ Typeable.Proxy @a
+
+get_ = method HTTP.GET
+
+getIO_ = method HTTP.GET id
+-}
+{-
+data Node where
+  Match :: forall a. (Web.ToHttpApiData a) => a -> Tree -> Node
+  Param :: forall a. (Web.FromHttpApiData a, Typeable.Typeable a) => (Secret.Secret a -> Tree) -> Node
+  Regex :: forall a. (Regex.RegexContext Regex.Regex Text.Text a) => Text.Text -> (Secret.Secret a -> Tree) -> Node
+  Splat :: forall a. (Web.FromHttpApiData a, Typeable.Typeable a) => (Secret.Secret (NonEmpty.NonEmpty a) -> Tree) -> Node
+  Route :: forall a. Route.Parser a -> (Secret.Secret a -> Tree) -> Node
+  Method :: forall env. HTTP.StdMethod -> (env Natural.~> IO) -> Handler env -> Node
+  -- Query :: forall a. Query.Parser a -> (Secret.Secret a -> Tree) -> Node
+  -- Headers :: forall a. RequestHeaders.Parser a -> (Secret.Secret a -> Tree) -> Node
+  -- Body :: forall a. RequestBody.Parser a -> (Secret.Secret a -> Tree) -> Node
+  Pipe :: Wai.Middleware -> Node -> Node
+  Respond ::
+    forall (status :: Natural.Natural) (headerKeys :: [Exts.Symbol]) (contentType :: Type) (resultType :: Type).
+    (Response.ToContentType contentType resultType) =>
+    ((Response.Headers headerKeys -> resultType -> Wai.Response) -> Tree) ->
+    Node
+
+-- data AppF a where
+--   MatchF :: forall a b. (Web.ToHttpApiData b) => b -> [a] -> AppF a
+--   ParamF :: forall a b. (Web.FromHttpApiData b, Typeable.Typeable b) => (Secret.Secret b -> [a]) -> AppF a
+--   RegexF :: forall a b. (Regex.RegexContext Regex.Regex Text.Text b) => Text.Text -> (Secret.Secret b -> [a]) -> AppF a
+--   SplatF :: forall a b. (Web.FromHttpApiData b, Typeable.Typeable b) => (Secret.Secret (NonEmpty.NonEmpty b) -> [a]) -> AppF a
+--   RouteF :: forall a b. Route.Parser b -> (Secret.Secret b -> [a]) -> AppF a
+--   MethodF :: forall a env. HTTP.StdMethod -> (env Natural.~> IO) -> Handler env -> AppF a
+--   -- Query :: forall a. Query.Parser a -> (Secret.Secret a -> [AppF]) -> AppF
+--   -- Headers :: forall a. RequestHeaders.Parser a -> (Secret.Secret a -> [AppF]) -> AppF
+--   -- Body :: forall a. RequestBody.Parser a -> (Secret.Secret a -> [AppF]) -> AppF
+--   PipeF :: forall a. Wai.Middleware -> a -> AppF a
+  -- RespondF ::
+  --   forall (status :: Natural.Natural) (headerKeys :: [Exts.Symbol]) (contentType :: Type) (resultType :: Type).
+  --   (Response.ToContentType contentType resultType) =>
+  --   ((Response.Headers headerKeys -> resultType -> Wai.Response) -> [a]) ->
+  --   AppF a
+
+build' :: Tree -> Wai.Middleware -> Wai.Middleware
+build' root middleware backup request respond = Foldable.fold
+  (\case
+      Base.Nil -> backup request respond
+      Base.Cons api (apis :: _) -> case api of
+        Match value children ->
+          case Wai.pathInfo request of
+            [] -> build' apis middleware backup request respond
+            (pathHead : pathTail) ->
+              if pathHead == Web.toUrlPiece value
+                then do
+                  let newReq = request {Wai.pathInfo = pathTail}
+                  build' children middleware backup newReq respond
+                else build' apis middleware backup request respond
+  )
+  root
+
+endpoint ::
+  HTTP.StdMethod ->
+  Route.Parser a ->
+  (env Natural.~> IO) ->
+  (Secret.Secret a -> Handler env) ->
+  Node
+endpoint stdMethod routeP trans handlerWithSecret = route routeP \routeS ->
+  [ method stdMethod trans (handlerWithSecret routeS)
+  ]
+-}

lib/src/Okapi/Form.hs

@@ -0,0 +1,2 @@
+module Okapi.Form where
+

lib/src/Okapi/Response.hs

@@ -94,7 +94,7 @@ insertHeader = InsertHeader
 --     Nothing -> (deleteHeader @headerKey rest)
 --     Just Typeable.Refl -> rest
 
-data Key (k :: Exts.Symbol) = Key
+data HeaderKey (k :: Exts.Symbol) = HeaderKey
 
 -- instance Exts.KnownSymbol k => Show (Var k) where
 --     show = Exts.symbolVal
@@ -102,7 +102,7 @@ data Key (k :: Exts.Symbol) = Key
 -- | Membership test a type class (predicate)
 class IsMember (headerKey :: Exts.Symbol) (headerKeys :: [Exts.Symbol]) where
   -- | Value-level lookup of elements from a map, via type class predicate
-  lookupHeader :: Key headerKey -> Headers headerKeys -> LBS.ByteString
+  lookupHeader :: HeaderKey headerKey -> Headers headerKeys -> LBS.ByteString
 
 -- instance {-# OVERLAPS #-} IsMember v t ((v ':-> t) ': m) where
 --   lookp _ (Ext _ x _) = x

lib/src/Okapi/Route.hs

@@ -1,23 +1,25 @@
 {-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE ImportQualifiedPost #-}
 {-# LANGUAGE OverloadedStrings #-}
--- {-# LANGUAGE RebindableSyntax #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
 
 module Okapi.Route where
 
-import Data.Text
+import Data.Text qualified as Text
-import Data.Typeable
+import Data.Typeable qualified as Typeable
+import Text.Regex.TDFA qualified as Regex
 import Web.HttpApiData qualified as Web
 
 data Parser a where
   FMap :: (a -> b) -> Parser a -> Parser b
   Pure :: a -> Parser a
   Apply :: Parser (a -> b) -> Parser a -> Parser b
-  Match :: Text -> Parser ()
+  Match :: forall a. (Web.ToHttpApiData a) => a -> Parser ()
-  Param :: (Typeable a, Web.FromHttpApiData a) => Parser a
+  Param :: forall a. (Typeable.Typeable a, Web.FromHttpApiData a) => Parser a
+  Regex :: forall a. (Regex.RegexContext Regex.Regex Text.Text a) => Text.Text -> Parser a
 
 instance Functor Parser where
   fmap = FMap
@@ -26,18 +28,25 @@ instance Applicative Parser where
   pure = Pure
   (<*>) = Apply
 
-param :: (Typeable a, Web.FromHttpApiData a) => Parser a
+match :: forall a. (Web.ToHttpApiData a) => a -> Parser ()
-param = Param
-
-match :: Text -> Parser ()
 match = Match
 
-rep :: Parser a -> Text
+lit :: Text.Text -> Parser ()
+lit = Match @Text.Text
+
+param :: (Typeable.Typeable a, Web.FromHttpApiData a) => Parser a
+param = Param
+
+regex :: forall a. (Regex.RegexContext Regex.Regex Text.Text a) => Text.Text -> Parser a
+regex = Regex
+
+rep :: Parser a -> Text.Text
 rep (FMap _ dsl) = rep dsl
 rep (Pure x) = ""
 rep (Apply aF aX) = rep aF <> rep aX
-rep (Match t) = "/" <> t
+rep (Match t) = "/" <> Web.toUrlPiece t
-rep (Param @p) = "/:" <> pack (show . typeRep $ Proxy @p)
+rep (Param @p) = "/:" <> Text.pack (show . Typeable.typeRep $ Typeable.Proxy @p)
+rep (Regex @ty regex) = "/r(" <> regex <> ")"
 
 -- equals :: Parser a -> Parser b -> Bool
 -- equals (FMap _ r) (FMap _ r') = equals r r'
@@ -51,5 +60,5 @@ rep (Param @p) = "/:" <> pack (show . typeRep $ Proxy @p)
 
 data Error = Error
 
-exec :: Parser a -> [Text] -> (Either Error a, [Text])
+parse :: Parser a -> [Text.Text] -> (Either Error a, [Text.Text])
-exec = undefined
+parse = undefined

lib/src/Okapi/Route/Pattern.hs

@@ -2,18 +2,18 @@
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE ImportQualifiedPost #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE ViewPatterns #-}
 
-module Okapi.Pattern where
+module Okapi.Route.Pattern where
 
 import Data.Text
 import Data.Typeable
 import Web.HttpApiData qualified as Web
 
-pattern Literal :: forall a. (Web.FromHttpApiData a, Web.ToHttpApiData a) => a -> Text
+pattern Part :: forall a. (Web.FromHttpApiData a, Web.ToHttpApiData a) => a -> Text
-pattern Literal x <- (Web.parseUrlPiece -> Right x)
+pattern Part x <- (Web.parseUrlPiece -> Right x)
   where
-    Literal x = Web.toUrlPiece x
+    Part x = Web.toUrlPiece x

lib/src/Okapi/TypedAPI.hs

@@ -22,7 +22,7 @@
 {-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE UndecidableInstances #-}
 
-module Okapi.API where
+module Okapi.App where
 
 import Control.Natural qualified as Natural
 import Data.Binary.Builder qualified as Builder

newdocs/.gitignore

@@ -0,0 +1,21 @@
+# build output
+dist/
+# generated types
+.astro/
+
+# dependencies
+node_modules/
+
+# logs
+npm-debug.log*
+yarn-debug.log*
+yarn-error.log*
+pnpm-debug.log*
+
+
+# environment variables
+.env
+.env.production
+
+# macOS-specific files
+.DS_Store

newdocs/.vscode/extensions.json

@@ -0,0 +1,4 @@
+{
+  "recommendations": ["astro-build.astro-vscode"],
+  "unwantedRecommendations": []
+}

newdocs/.vscode/launch.json

@@ -0,0 +1,11 @@
+{
+  "version": "0.2.0",
+  "configurations": [
+    {
+      "command": "./node_modules/.bin/astro dev",
+      "name": "Development server",
+      "request": "launch",
+      "type": "node-terminal"
+    }
+  ]
+}

newdocs/README.md

@@ -0,0 +1,47 @@
+# Astro Starter Kit: Minimal
+
+```sh
+npm create astro@latest -- --template minimal
+```
+
+[![Open in StackBlitz](https://developer.stackblitz.com/img/open_in_stackblitz.svg)](https://stackblitz.com/github/withastro/astro/tree/latest/examples/minimal)
+[![Open with CodeSandbox](https://assets.codesandbox.io/github/button-edit-lime.svg)](https://codesandbox.io/p/sandbox/github/withastro/astro/tree/latest/examples/minimal)
+[![Open in GitHub Codespaces](https://github.com/codespaces/badge.svg)](https://codespaces.new/withastro/astro?devcontainer_path=.devcontainer/minimal/devcontainer.json)
+
+> 🧑‍🚀 **Seasoned astronaut?** Delete this file. Have fun!
+
+## 🚀 Project Structure
+
+Inside of your Astro project, you'll see the following folders and files:
+
+```text
+/
+├── public/
+├── src/
+│   └── pages/
+│       └── index.astro
+└── package.json
+```
+
+Astro looks for `.astro` or `.md` files in the `src/pages/` directory. Each page is exposed as a route based on its file name.
+
+There's nothing special about `src/components/`, but that's where we like to put any Astro/React/Vue/Svelte/Preact components.
+
+Any static assets, like images, can be placed in the `public/` directory.
+
+## 🧞 Commands
+
+All commands are run from the root of the project, from a terminal:
+
+| Command                   | Action                                           |
+| :------------------------ | :----------------------------------------------- |
+| `npm install`             | Installs dependencies                            |
+| `npm run dev`             | Starts local dev server at `localhost:4321`      |
+| `npm run build`           | Build your production site to `./dist/`          |
+| `npm run preview`         | Preview your build locally, before deploying     |
+| `npm run astro ...`       | Run CLI commands like `astro add`, `astro check` |
+| `npm run astro -- --help` | Get help using the Astro CLI                     |
+
+## 👀 Want to learn more?
+
+Feel free to check [our documentation](https://docs.astro.build) or jump into our [Discord server](https://astro.build/chat).

newdocs/astro.config.mjs

@@ -0,0 +1,4 @@
+import { defineConfig } from 'astro/config';
+
+// https://astro.build/config
+export default defineConfig({});

newdocs/package.json

@@ -0,0 +1,17 @@
+{
+  "name": "newdocs",
+  "type": "module",
+  "version": "0.0.1",
+  "scripts": {
+    "dev": "astro dev",
+    "start": "astro dev",
+    "build": "astro check && astro build",
+    "preview": "astro preview",
+    "astro": "astro"
+  },
+  "dependencies": {
+    "@astrojs/check": "^0.3.0",
+    "astro": "^3.4.0",
+    "typescript": "^5.2.2"
+  }
+}

newdocs/public/favicon.svg

@@ -0,0 +1,9 @@
+<svg xmlns="http://www.w3.org/2000/svg" fill="none" viewBox="0 0 128 128">
+    <path d="M50.4 78.5a75.1 75.1 0 0 0-28.5 6.9l24.2-65.7c.7-2 1.9-3.2 3.4-3.2h29c1.5 0 2.7 1.2 3.4 3.2l24.2 65.7s-11.6-7-28.5-7L67 45.5c-.4-1.7-1.6-2.8-2.9-2.8-1.3 0-2.5 1.1-2.9 2.7L50.4 78.5Zm-1.1 28.2Zm-4.2-20.2c-2 6.6-.6 15.8 4.2 20.2a17.5 17.5 0 0 1 .2-.7 5.5 5.5 0 0 1 5.7-4.5c2.8.1 4.3 1.5 4.7 4.7.2 1.1.2 2.3.2 3.5v.4c0 2.7.7 5.2 2.2 7.4a13 13 0 0 0 5.7 4.9v-.3l-.2-.3c-1.8-5.6-.5-9.5 4.4-12.8l1.5-1a73 73 0 0 0 3.2-2.2 16 16 0 0 0 6.8-11.4c.3-2 .1-4-.6-6l-.8.6-1.6 1a37 37 0 0 1-22.4 2.7c-5-.7-9.7-2-13.2-6.2Z" />
+    <style>
+        path { fill: #000; }
+        @media (prefers-color-scheme: dark) {
+            path { fill: #FFF; }
+        }
+    </style>
+</svg>

newdocs/src/env.d.ts

@@ -0,0 +1 @@
+/// <reference types="astro/client" />

newdocs/src/pages/docs.md

@@ -0,0 +1,76 @@
+---
+---
+
+# Okapi
+
+```haskell
+data App where
+  Match :: forall a. (Web.ToHttpApiData a) => a -> [App] -> App
+  Param :: forall a. (Web.FromHttpApiData a, Typeable.Typeable a) => (Secret.Secret a -> [App]) -> App
+  Regex :: forall a. Text -> (Secret.Secret a -> [App]) -> App
+  Splat :: forall a. (Web.FromHttpApiData a) => (Secret.Secret (NonEmpty.NonEmpty a) -> [App]) -> App
+  Route :: forall a. Route.Parser a -> (Secret.Secret a -> [App]) -> App
+  Method :: forall env. HTTP.StdMethod -> (env Natural.~> IO) -> Handler env -> App
+  Query :: forall a. Query.Parser a -> (Secret.Secret a -> [App]) -> App
+  Headers :: forall a. RequestHeaders.Parser a -> (Secret.Secret a -> [App]) -> App
+  -- Body :: forall a. RequestBody.Parser a -> (Secret.Secret a -> [App]) -> App
+  Pipe :: Wai.Middleware -> App -> App
+  Respond ::
+    forall (status :: Natural.Natural) (headerKeys :: [Exts.Symbol]) (contentType :: Type) (resultType :: Type).
+    (Response.ToContentType contentType resultType) =>
+    ((Response.Headers headerKeys -> resultType -> Wai.Response) -> [App]) ->
+    App
+-- Endpoint :: HTTP.StdMethod -> Route.Parser a -> (env Natural.~> IO) -> App
+```
+
+## `endpoint` function
+
+```haskell
+endpoint
+  :: HTTP.StdMethod
+  -> Route.Parser a
+  -> (env Natural.~> IO)
+  -> (Secret.Secret a -> Handler env)
+  -> App
+endpoint stdMethod routeP trans handlerWithSecret = route routeP \routeS ->
+  [ method stdMethod trans (handlerWithSecret routeS)
+  ]
+
+myAPI :: [App]
+myAPI =
+  [ endpoint GET (do Route.lit "user";) id \_ req -> do
+      ...
+  , endpoint POST (do Route.lit "user"; Route.param @UserID;) id \userIDS req -> do
+      let userID = Secret.tell req userIDs
+      ...
+  ]
+```
+
+## `on` function
+
+```haskell
+on :: Operation a -> (Secret.Secret a -> [App]) -> App
+on op ... = 
+
+myAPI =
+  [on|/api|]
+    [ [on|/v2|]
+        [ [on|?name:Text|] \nameS ->
+            [ getIO \req -> do
+                ...
+            ]
+        , [on|/:Text|] \nameS ->
+            [ getIO \req -> do
+                ...
+            ]
+        , [on|/*Int|] \intsS ->
+            [ method GET id \req -> do
+                ...
+            ]
+        , [on|{ Accept:Text, XSRF-Token:XSRFToken }|] \headersS ->
+            [ [on|POST /new/:Int|] id \intS req -> do
+                ...
+            ]
+        ]
+    ]
+```

newdocs/src/pages/index.astro

@@ -0,0 +1,16 @@
+---
+
+---
+
+<html lang="en">
+	<head>
+		<meta charset="utf-8" />
+		<link rel="icon" type="image/svg+xml" href="/favicon.svg" />
+		<meta name="viewport" content="width=device-width" />
+		<meta name="generator" content={Astro.generator} />
+		<title>Astro</title>
+	</head>
+	<body>
+		<h1>Astro</h1>
+	</body>
+</html>

newdocs/tsconfig.json

@@ -0,0 +1,3 @@
+{
+  "extends": "astro/tsconfigs/strict"
+}