Merge pull request #29 from anton-k/add-api-path-functions

implement some useful functions for api
anton-k · Oct 19, 2023 · 594fff2 · 594fff2
2 parents a019c2b + 7b2a9c5
commit 594fff2
Show file tree

Hide file tree

Showing 3 changed files with 13 additions and 0 deletions.
diff --git a/mig-extra/src/Mig/Extra/Server/Common.hs b/mig-extra/src/Mig/Extra/Server/Common.hs
@@ -90,6 +90,8 @@ module Mig.Extra.Server.Common (
   mapServerFun,
   mapResponse,
   atPath,
+  filterPath,
+  getServerPaths,
   addPathLink,
 
   -- ** OpenApi

diff --git a/mig-server/src/Mig.hs b/mig-server/src/Mig.hs
@@ -129,6 +129,8 @@ module Mig (
   mapServerFun,
   mapResponse,
   atPath,
+  filterPath,
+  getServerPaths,
   addPathLink,
 
   -- ** OpenApi

diff --git a/mig/src/Mig/Core/Server.hs b/mig/src/Mig/Core/Server.hs
@@ -14,6 +14,8 @@ module Mig.Core.Server (
   staticFiles,
   describeInputs,
   atPath,
+  filterPath,
+  getServerPaths,
   addPathLink,
 ) where
 
@@ -355,6 +357,13 @@ atPath rootPath rootServer = maybe mempty Server $ find rootPath rootServer.unSe
         guard (prefixHead == pathHead)
         matchPath prefixTail pathTail
 
+filterPath :: (Api.Path -> Bool) -> Server m -> Server m
+filterPath cond (Server a) =
+  Server (Api.fromFlatApi $ filter (cond . fst) $ Api.flatApi a)
+
+getServerPaths :: Server m -> [Api.Path]
+getServerPaths (Server a) = fmap fst $ Api.flatApi a
+
 {-| Links one route of the server to another
 so that every call to first path is redirected to the second path
 -}