Allow to "hide" routes from the client

Author: bitonic

solga-client-ghcjs/src/Solga/Client/GHCJS.hs

@@ -24,6 +24,7 @@
 {-# LANGUAGE DeriveTraversable #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE EmptyCase #-}
 module Solga.Client.GHCJS
   ( Client(..)
   , SomeRequestData(..)
@@ -36,6 +37,7 @@ module Solga.Client.GHCJS
   , Response(..)
   , Header
   , XHRError(..)
+  , HiddenRequestData
   ) where
 
 import Data.Kind
@@ -126,6 +128,12 @@ instance (Client next) => Client (End next) where
   type RequestData (End next) = RequestData next
   performRequest _p req perf = performRequest (Proxy @next) req perf
 
+data HiddenRequestData a
+
+instance Client (Hidden next) where
+  type RequestData (Hidden next) = HiddenRequestData
+  performRequest _p _req perf = case perf of {}
+
 addSegment :: Request -> Text -> Request
 addSegment req seg = req{reqSegments = reqSegments req <> DList.singleton seg}
 

solga-client/src/Solga/Client.hs

@@ -17,6 +17,7 @@
 {-# LANGUAGE DefaultSignatures #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE EmptyCase #-}
 module Solga.Client
   ( Client(..)
   , SomeRequestData(..)
@@ -25,6 +26,7 @@ module Solga.Client
   , ToSegment(..)
   , WithData(..)
   , GetResponse(..)
+  , HiddenRequestData
   ) where
 
 import Data.Kind
@@ -78,6 +80,12 @@ instance (Client next) => Client (End next) where
   type RequestData (End next) = RequestData next
   performRequest _p mgr req perf = performRequest (Proxy @next) mgr req perf
 
+data HiddenRequestData a
+
+instance Client (Hidden next) where
+  type RequestData (Hidden next) = HiddenRequestData
+  performRequest _p _mgr _req perf = case perf of {}
+
 addSegment :: Http.Request -> Text -> Http.Request
 addSegment req segtxt = req
   { Http.path = if BS.null (Http.path req) || BSC8.last (Http.path req) == '/'

solga-core/src/Solga/Core.hs

@@ -42,6 +42,7 @@ module Solga.Core
   , (:<|>)(..)
   , RedirectOnTrailingSlash(..)
   , WithReferer(..)
+  , Hidden(..)
   -- * FromSegment
   , FromSegment(..)
   ) where
@@ -165,4 +166,8 @@ instance FromSegment JSString where
 
 newtype RedirectOnTrailingSlash next = RedirectOnTrailingSlash {unRedirectOnTrailingSlash :: next}
 
-newtype WithReferer next = WithReferer { withRefererNext :: Maybe ByteString -> next }
+newtype WithReferer next = WithReferer { withRefererNext :: Maybe ByteString -> next }
+
+-- | To hide from client libraries
+newtype Hidden next = Hidden {hiddenNext :: next}
+

solga-router/src/Solga/Router.hs

@@ -108,6 +108,11 @@ instance Router next => Router (End next) where
     [] -> tryRouteNext endNext req
     _ -> Nothing
 
+instance Router next => Router (Hidden next) where
+  tryRoute req = case Wai.pathInfo req of
+    [] -> tryRouteNext hiddenNext req
+    _ -> Nothing
+
 instance (KnownSymbol seg, Router next) => Router (Seg seg next) where
   tryRoute req = case Wai.pathInfo req of
     s : segs | Text.unpack s == symbolVal (Proxy :: Proxy seg) ->
@@ -221,6 +226,10 @@ instance Abbreviated next => Abbreviated (End next) where
   type Brief (End next) = Brief next
   brief = End . brief
 
+instance Abbreviated next => Abbreviated (Hidden next) where
+  type Brief (Hidden next) = Brief next
+  brief = Hidden . brief
+
 instance Abbreviated next => Abbreviated (Seg seg next) where
   type Brief (Seg seg next) = Brief next
   brief = Seg . brief

stack.yaml

@@ -11,7 +11,6 @@ packages:
 - 'solga-router'
 - 'solga-client'
 - 'solga-client-ghcjs'
-- 'solga-typescript'
 
 # Packages to be pulled from upstream that are not in the resolver (e.g., acme-missiles-0.3)
 extra-deps:
@@ -20,7 +19,6 @@ extra-deps:
 - jsaddle-dom-0.9.4.0
 - jsaddle-0.9.7.0
 - ref-tf-0.4.0.2
-- aeson-typescript-0.2.0.0
 
 # Override default flag values for local packages and extra-deps
 flags: {}