@@ -10,6 +10,7 @@
1010{-# LANGUAGE MultiParamTypeClasses #-}
1111{-# LANGUAGE OverloadedStrings #-}
1212{-# LANGUAGE PatternSynonyms #-}
13+{-# LANGUAGE PolyKinds #-}
1314{-# LANGUAGE RankNTypes #-}
1415{-# LANGUAGE ScopedTypeVariables #-}
1516{-# LANGUAGE TemplateHaskell #-}
@@ -82,6 +83,9 @@ module Obelisk.Route
8283 , renderObeliskRoute
8384 , renderBackendRoute
8485 , renderFrontendRoute
86+ , readShowEncoder
87+ , integralEncoder
88+ , pathSegmentEncoder
8589 ) where
8690
8791import Prelude hiding ((.), id)
@@ -118,6 +122,7 @@ import qualified Data.Text as T
118122import Data.Text.Encoding
119123import Data.Universe
120124import Network.HTTP.Types.URI
125+import qualified Numeric.Lens
121126import Obelisk.Route.TH
122127import Text.Read (readMaybe)
123128
@@ -859,4 +864,20 @@ renderObeliskRoute e r =
859864 enc = (pageNameEncoder . hoistParse (pure . runIdentity) e)
860865 in (T.pack . uncurry (<>)) $ encode enc r
861866
867+readShowEncoder :: (MonadError Text parse, Read a, Show a, Applicative check) => Encoder check parse a PageName
868+readShowEncoder = singlePathSegmentEncoder . unsafeTshowEncoder
869+
870+
871+integralEncoder :: (MonadError Text parse, Applicative check, Integral a) => Encoder check parse a Integer
872+integralEncoder = prismEncoder (Numeric.Lens.integral)
873+
874+pathSegmentEncoder :: (MonadError Text parse, Applicative check) =>
875+ Encoder check parse (Text, PageName) PageName
876+pathSegmentEncoder = unsafeMkEncoder EncoderImpl
877+ { _encoderImpl_encode = \(x, (y, z)) -> (x:y, z)
878+ , _encoderImpl_decode = \(xss, y) -> case xss of
879+ [] -> throwError "not enough path segments"
880+ (x:xs) -> pure (x, (xs, y))
881+ }
882+
862883--TODO: decodeURIComponent as appropriate