{-# LANGUAGE CPP, FlexibleContexts, FlexibleInstances, TupleSections #-}
#if __GLASGOW_HASKELL__ > 702
{-# LANGUAGE DefaultSignatures, OverloadedStrings, ScopedTypeVariables, TypeOperators #-}
#endif
module Web.Routes.PathInfo
( stripOverlap
, stripOverlapBS
, stripOverlapText
, URLParser
, pToken
, segment
, anySegment
, patternParse
, parseSegments
, PathInfo(..)
, toPathInfo
, toPathInfoParams
, fromPathInfo
, fromPathInfoParams
, mkSitePI
, showParseError
#if __GLASGOW_HASKELL__ > 702
, Generic
#endif
) where
import Blaze.ByteString.Builder (Builder, toByteString)
import Control.Applicative ((<$>), (<*))
import Control.Monad (msum)
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as B
import Data.Int (Int64)
import Data.List as List (stripPrefix, tails)
import Data.Text as Text (Text, pack, unpack, null, tails, stripPrefix)
import Data.Text.Encoding (decodeUtf8)
import Data.Text.Read (decimal, signed)
import Data.Maybe (fromJust)
import Network.HTTP.Types
import Text.ParserCombinators.Parsec.Combinator (notFollowedBy)
import Text.ParserCombinators.Parsec.Error (ParseError, errorPos, errorMessages, showErrorMessages)
import Text.ParserCombinators.Parsec.Pos (incSourceLine, sourceName, sourceLine, sourceColumn)
import Text.ParserCombinators.Parsec.Prim ((<?>), GenParser, getInput, setInput, getPosition, token, parse, many)
import Web.Routes.Base (decodePathInfoParams, decodePathInfo, encodePathInfo)
import Web.Routes.Site (Site(..))
#if __GLASGOW_HASKELL__ > 702
import Control.Applicative ((<$), (<*>), (<|>), pure)
import Data.Char (toLower, isUpper)
import Data.List (intercalate)
import Data.List.Split (split, dropInitBlank, keepDelimsL, whenElt)
import GHC.Generics
#endif
stripOverlap :: (Eq a) => [a] -> [a] -> [a]
stripOverlap :: forall a. Eq a => [a] -> [a] -> [a]
stripOverlap [a]
x [a]
y = Maybe [a] -> [a]
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe [a] -> [a]) -> Maybe [a] -> [a]
forall a b. (a -> b) -> a -> b
$ [Maybe [a]] -> Maybe [a]
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum ([Maybe [a]] -> Maybe [a]) -> [Maybe [a]] -> Maybe [a]
forall a b. (a -> b) -> a -> b
$ [ [a] -> [a] -> Maybe [a]
forall a. Eq a => [a] -> [a] -> Maybe [a]
List.stripPrefix [a]
p [a]
y | [a]
p <- [a] -> [[a]]
forall a. [a] -> [[a]]
List.tails [a]
x]
stripOverlapText :: Text -> Text -> Text
stripOverlapText :: Text -> Text -> Text
stripOverlapText Text
x Text
y = Maybe Text -> Text
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ [Maybe Text] -> Maybe Text
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum ([Maybe Text] -> Maybe Text) -> [Maybe Text] -> Maybe Text
forall a b. (a -> b) -> a -> b
$ [ Text -> Text -> Maybe Text
Text.stripPrefix Text
p Text
y | Text
p <- Text -> [Text]
Text.tails Text
x ]
stripOverlapBS :: B.ByteString -> B.ByteString -> B.ByteString
stripOverlapBS :: ByteString -> ByteString -> ByteString
stripOverlapBS ByteString
x ByteString
y = Maybe ByteString -> ByteString
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe ByteString -> ByteString) -> Maybe ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ [Maybe ByteString] -> Maybe ByteString
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum ([Maybe ByteString] -> Maybe ByteString)
-> [Maybe ByteString] -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ [ ByteString -> ByteString -> Maybe ByteString
stripPrefix ByteString
p ByteString
y | ByteString
p <- ByteString -> [ByteString]
B.tails ByteString
x ]
where
stripPrefix :: B.ByteString -> B.ByteString -> Maybe B.ByteString
stripPrefix :: ByteString -> ByteString -> Maybe ByteString
stripPrefix ByteString
x ByteString
y
| ByteString
x ByteString -> ByteString -> Bool
`B.isPrefixOf` ByteString
y = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
B.drop (ByteString -> Int
B.length ByteString
x) ByteString
y
| Bool
otherwise = Maybe ByteString
forall a. Maybe a
Nothing
type URLParser a = GenParser Text () a
pToken :: tok -> (Text -> Maybe a) -> URLParser a
pToken :: forall tok a. tok -> (Text -> Maybe a) -> URLParser a
pToken tok
msg Text -> Maybe a
f = do SourcePos
pos <- ParsecT [Text] () Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
(Text -> [Char])
-> (Text -> SourcePos) -> (Text -> Maybe a) -> URLParser a
forall s t a u.
Stream s Identity t =>
(t -> [Char]) -> (t -> SourcePos) -> (t -> Maybe a) -> Parsec s u a
token Text -> [Char]
unpack (SourcePos -> Text -> SourcePos
forall a b. a -> b -> a
const (SourcePos -> Text -> SourcePos) -> SourcePos -> Text -> SourcePos
forall a b. (a -> b) -> a -> b
$ SourcePos -> Int -> SourcePos
incSourceLine SourcePos
pos Int
1) Text -> Maybe a
f
segment :: Text -> URLParser Text
segment :: Text -> URLParser Text
segment Text
x = ((Any -> Text) -> (Text -> Maybe Text) -> URLParser Text
forall tok a. tok -> (Text -> Maybe a) -> URLParser a
pToken (Text -> Any -> Text
forall a b. a -> b -> a
const Text
x) (\Text
y -> if Text
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
y then Text -> Maybe Text
forall a. a -> Maybe a
Just Text
x else Maybe Text
forall a. Maybe a
Nothing)) URLParser Text -> [Char] -> URLParser Text
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> Text -> [Char]
unpack Text
x
anySegment :: URLParser Text
anySegment :: URLParser Text
anySegment = (Any -> [Char]) -> (Text -> Maybe Text) -> URLParser Text
forall tok a. tok -> (Text -> Maybe a) -> URLParser a
pToken ([Char] -> Any -> [Char]
forall a b. a -> b -> a
const [Char]
"any string") Text -> Maybe Text
forall a. a -> Maybe a
Just
eof :: URLParser ()
eof :: URLParser ()
eof = URLParser Text -> URLParser ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy URLParser Text
anySegment URLParser () -> [Char] -> URLParser ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"end of input"
patternParse :: ([Text] -> Either String a) -> URLParser a
patternParse :: forall a. ([Text] -> Either [Char] a) -> URLParser a
patternParse [Text] -> Either [Char] a
p =
do [Text]
segs <- ParsecT [Text] () Identity [Text]
forall (m :: * -> *) s u. Monad m => ParsecT s u m s
getInput
case [Text] -> Either [Char] a
p [Text]
segs of
(Right a
r) ->
do [Text] -> URLParser ()
forall (m :: * -> *) s u. Monad m => s -> ParsecT s u m ()
setInput []
a -> URLParser a
forall (m :: * -> *) a. Monad m => a -> m a
return a
r
(Left [Char]
err) -> [Char] -> URLParser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
err
showParseError :: ParseError -> String
showParseError :: ParseError -> [Char]
showParseError ParseError
pErr =
let pos :: SourcePos
pos = ParseError -> SourcePos
errorPos ParseError
pErr
posMsg :: [Char]
posMsg = SourcePos -> [Char]
sourceName SourcePos
pos [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" (segment " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show (SourcePos -> Int
sourceLine SourcePos
pos) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" character " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show (SourcePos -> Int
sourceColumn SourcePos
pos) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"): "
msgs :: [Message]
msgs = ParseError -> [Message]
errorMessages ParseError
pErr
in [Char]
posMsg [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
-> [Char] -> [Char] -> [Char] -> [Char] -> [Message] -> [Char]
showErrorMessages [Char]
"or" [Char]
"unknown parse error" [Char]
"expecting" [Char]
"unexpected" [Char]
"end of input" [Message]
msgs
parseSegments :: URLParser a -> [Text] -> Either String a
parseSegments :: forall a. URLParser a -> [Text] -> Either [Char] a
parseSegments URLParser a
p [Text]
segments =
case URLParser a -> [Char] -> [Text] -> Either ParseError a
forall s t a.
Stream s Identity t =>
Parsec s () a -> [Char] -> s -> Either ParseError a
parse (URLParser a
p URLParser a -> URLParser () -> URLParser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* URLParser ()
eof) ([Text] -> [Char]
forall a. Show a => a -> [Char]
show [Text]
segments) [Text]
segments of
(Left ParseError
e) -> [Char] -> Either [Char] a
forall a b. a -> Either a b
Left (ParseError -> [Char]
showParseError ParseError
e)
(Right a
r) -> a -> Either [Char] a
forall a b. b -> Either a b
Right a
r
#if __GLASGOW_HASKELL__ > 702
hyphenate :: String -> Text
hyphenate :: [Char] -> Text
hyphenate =
[Char] -> Text
pack ([Char] -> Text) -> ([Char] -> [Char]) -> [Char] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"-" ([[Char]] -> [Char]) -> ([Char] -> [[Char]]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> [Char]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ((Char -> Char) -> [Char] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower) ([[Char]] -> [[Char]])
-> ([Char] -> [[Char]]) -> [Char] -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Splitter Char -> [Char] -> [[Char]]
forall a. Splitter a -> [a] -> [[a]]
split Splitter Char
splitter
where
splitter :: Splitter Char
splitter = Splitter Char -> Splitter Char
forall a. Splitter a -> Splitter a
dropInitBlank (Splitter Char -> Splitter Char)
-> ((Char -> Bool) -> Splitter Char)
-> (Char -> Bool)
-> Splitter Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Splitter Char -> Splitter Char
forall a. Splitter a -> Splitter a
keepDelimsL (Splitter Char -> Splitter Char)
-> ((Char -> Bool) -> Splitter Char)
-> (Char -> Bool)
-> Splitter Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Splitter Char
forall a. (a -> Bool) -> Splitter a
whenElt ((Char -> Bool) -> Splitter Char)
-> (Char -> Bool) -> Splitter Char
forall a b. (a -> b) -> a -> b
$ Char -> Bool
isUpper
class GPathInfo f where
gtoPathSegments :: f url -> [Text]
gfromPathSegments :: URLParser (f url)
instance GPathInfo U1 where
gtoPathSegments :: forall url. U1 url -> [Text]
gtoPathSegments U1 url
U1 = []
gfromPathSegments :: forall url. URLParser (U1 url)
gfromPathSegments = U1 url -> ParsecT [Text] () Identity (U1 url)
forall (f :: * -> *) a. Applicative f => a -> f a
pure U1 url
forall k (p :: k). U1 p
U1
instance GPathInfo a => GPathInfo (D1 c a) where
gtoPathSegments :: forall url. D1 c a url -> [Text]
gtoPathSegments = a url -> [Text]
forall (f :: * -> *) url. GPathInfo f => f url -> [Text]
gtoPathSegments (a url -> [Text])
-> (M1 D c a url -> a url) -> M1 D c a url -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. M1 D c a url -> a url
forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1
gfromPathSegments :: forall url. URLParser (D1 c a url)
gfromPathSegments = a url -> M1 D c a url
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (a url -> M1 D c a url)
-> ParsecT [Text] () Identity (a url)
-> ParsecT [Text] () Identity (M1 D c a url)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Text] () Identity (a url)
forall (f :: * -> *) url. GPathInfo f => URLParser (f url)
gfromPathSegments
instance GPathInfo a => GPathInfo (S1 c a) where
gtoPathSegments :: forall url. S1 c a url -> [Text]
gtoPathSegments = a url -> [Text]
forall (f :: * -> *) url. GPathInfo f => f url -> [Text]
gtoPathSegments (a url -> [Text])
-> (M1 S c a url -> a url) -> M1 S c a url -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. M1 S c a url -> a url
forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1
gfromPathSegments :: forall url. URLParser (S1 c a url)
gfromPathSegments = a url -> M1 S c a url
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (a url -> M1 S c a url)
-> ParsecT [Text] () Identity (a url)
-> ParsecT [Text] () Identity (M1 S c a url)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Text] () Identity (a url)
forall (f :: * -> *) url. GPathInfo f => URLParser (f url)
gfromPathSegments
instance forall c a. (GPathInfo a, Constructor c) => GPathInfo (C1 c a) where
gtoPathSegments :: forall url. C1 c a url -> [Text]
gtoPathSegments m :: C1 c a url
m@(M1 a url
x) = ([Char] -> Text
hyphenate ([Char] -> Text) -> (C1 c a url -> [Char]) -> C1 c a url -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. C1 c a url -> [Char]
forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
(f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> [Char]
conName) C1 c a url
m Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: a url -> [Text]
forall (f :: * -> *) url. GPathInfo f => f url -> [Text]
gtoPathSegments a url
x
gfromPathSegments :: forall url. URLParser (C1 c a url)
gfromPathSegments = a url -> M1 C c a url
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (a url -> M1 C c a url)
-> URLParser Text
-> ParsecT [Text] () Identity (a url -> M1 C c a url)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> URLParser Text
segment ([Char] -> Text
hyphenate ([Char] -> Text)
-> (M1 C c a Any -> [Char]) -> M1 C c a Any -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. M1 C c a Any -> [Char]
forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
(f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> [Char]
conName (M1 C c a Any -> Text) -> M1 C c a Any -> Text
forall a b. (a -> b) -> a -> b
$ (forall {r}. C1 c a r
forall a. HasCallStack => a
undefined :: C1 c a r))
ParsecT [Text] () Identity (a url -> M1 C c a url)
-> ParsecT [Text] () Identity (a url)
-> ParsecT [Text] () Identity (M1 C c a url)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT [Text] () Identity (a url)
forall (f :: * -> *) url. GPathInfo f => URLParser (f url)
gfromPathSegments
instance (GPathInfo a, GPathInfo b) => GPathInfo (a :*: b) where
gtoPathSegments :: forall url. (:*:) a b url -> [Text]
gtoPathSegments (a url
a :*: b url
b) = a url -> [Text]
forall (f :: * -> *) url. GPathInfo f => f url -> [Text]
gtoPathSegments a url
a [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ b url -> [Text]
forall (f :: * -> *) url. GPathInfo f => f url -> [Text]
gtoPathSegments b url
b
gfromPathSegments :: forall url. URLParser ((:*:) a b url)
gfromPathSegments = a url -> b url -> (:*:) a b url
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:) (a url -> b url -> (:*:) a b url)
-> ParsecT [Text] () Identity (a url)
-> ParsecT [Text] () Identity (b url -> (:*:) a b url)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Text] () Identity (a url)
forall (f :: * -> *) url. GPathInfo f => URLParser (f url)
gfromPathSegments ParsecT [Text] () Identity (b url -> (:*:) a b url)
-> ParsecT [Text] () Identity (b url)
-> ParsecT [Text] () Identity ((:*:) a b url)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT [Text] () Identity (b url)
forall (f :: * -> *) url. GPathInfo f => URLParser (f url)
gfromPathSegments
instance (GPathInfo a, GPathInfo b) => GPathInfo (a :+: b) where
gtoPathSegments :: forall url. (:+:) a b url -> [Text]
gtoPathSegments (L1 a url
x) = a url -> [Text]
forall (f :: * -> *) url. GPathInfo f => f url -> [Text]
gtoPathSegments a url
x
gtoPathSegments (R1 b url
x) = b url -> [Text]
forall (f :: * -> *) url. GPathInfo f => f url -> [Text]
gtoPathSegments b url
x
gfromPathSegments :: forall url. URLParser ((:+:) a b url)
gfromPathSegments = a url -> (:+:) a b url
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (a url -> (:+:) a b url)
-> ParsecT [Text] () Identity (a url)
-> ParsecT [Text] () Identity ((:+:) a b url)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Text] () Identity (a url)
forall (f :: * -> *) url. GPathInfo f => URLParser (f url)
gfromPathSegments
ParsecT [Text] () Identity ((:+:) a b url)
-> ParsecT [Text] () Identity ((:+:) a b url)
-> ParsecT [Text] () Identity ((:+:) a b url)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> b url -> (:+:) a b url
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (b url -> (:+:) a b url)
-> ParsecT [Text] () Identity (b url)
-> ParsecT [Text] () Identity ((:+:) a b url)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Text] () Identity (b url)
forall (f :: * -> *) url. GPathInfo f => URLParser (f url)
gfromPathSegments
instance PathInfo a => GPathInfo (K1 i a) where
gtoPathSegments :: forall url. K1 i a url -> [Text]
gtoPathSegments = a -> [Text]
forall url. PathInfo url => url -> [Text]
toPathSegments (a -> [Text]) -> (K1 i a url -> a) -> K1 i a url -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. K1 i a url -> a
forall k i c (p :: k). K1 i c p -> c
unK1
gfromPathSegments :: forall url. URLParser (K1 i a url)
gfromPathSegments = a -> K1 i a url
forall k i c (p :: k). c -> K1 i c p
K1 (a -> K1 i a url)
-> ParsecT [Text] () Identity a
-> ParsecT [Text] () Identity (K1 i a url)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Text] () Identity a
forall url. PathInfo url => URLParser url
fromPathSegments
#endif
class PathInfo url where
toPathSegments :: url -> [Text]
fromPathSegments :: URLParser url
#if __GLASGOW_HASKELL__ > 702
default toPathSegments :: (Generic url, GPathInfo (Rep url)) => url -> [Text]
toPathSegments = Rep url Any -> [Text]
forall (f :: * -> *) url. GPathInfo f => f url -> [Text]
gtoPathSegments (Rep url Any -> [Text]) -> (url -> Rep url Any) -> url -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. url -> Rep url Any
forall a x. Generic a => a -> Rep a x
from
default fromPathSegments :: (Generic url, GPathInfo (Rep url)) => URLParser url
fromPathSegments = Rep url Any -> url
forall a x. Generic a => Rep a x -> a
to (Rep url Any -> url)
-> ParsecT [Text] () Identity (Rep url Any) -> URLParser url
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Text] () Identity (Rep url Any)
forall (f :: * -> *) url. GPathInfo f => URLParser (f url)
gfromPathSegments
#endif
toPathInfo :: (PathInfo url) => url -> Text
toPathInfo :: forall url. PathInfo url => url -> Text
toPathInfo = ByteString -> Text
decodeUtf8 (ByteString -> Text) -> (url -> ByteString) -> url -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
toByteString (Builder -> ByteString) -> (url -> Builder) -> url -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. url -> Builder
forall url. PathInfo url => url -> Builder
toPathInfoUtf8
toPathInfoUtf8 :: (PathInfo url) => url -> Builder
toPathInfoUtf8 :: forall url. PathInfo url => url -> Builder
toPathInfoUtf8 = ([Text] -> Query -> Builder) -> Query -> [Text] -> Builder
forall a b c. (a -> b -> c) -> b -> a -> c
flip [Text] -> Query -> Builder
encodePath [] ([Text] -> Builder) -> (url -> [Text]) -> url -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. url -> [Text]
forall url. PathInfo url => url -> [Text]
toPathSegments
toPathInfoParams :: (PathInfo url) =>
url
-> [(Text, Maybe Text)]
-> Text
toPathInfoParams :: forall url. PathInfo url => url -> [(Text, Maybe Text)] -> Text
toPathInfoParams url
url [(Text, Maybe Text)]
params = [Text] -> [(Text, Maybe Text)] -> Text
encodePathInfo (url -> [Text]
forall url. PathInfo url => url -> [Text]
toPathSegments url
url) [(Text, Maybe Text)]
params
fromPathInfo :: (PathInfo url) => ByteString -> Either String url
fromPathInfo :: forall url. PathInfo url => ByteString -> Either [Char] url
fromPathInfo ByteString
pi =
URLParser url -> [Text] -> Either [Char] url
forall a. URLParser a -> [Text] -> Either [Char] a
parseSegments URLParser url
forall url. PathInfo url => URLParser url
fromPathSegments (ByteString -> [Text]
decodePathInfo (ByteString -> [Text]) -> ByteString -> [Text]
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
dropSlash ByteString
pi)
fromPathInfoParams :: (PathInfo url) => ByteString -> Either String (url, [(Text, Maybe Text)])
fromPathInfoParams :: forall url.
PathInfo url =>
ByteString -> Either [Char] (url, [(Text, Maybe Text)])
fromPathInfoParams ByteString
pi =
(,[(Text, Maybe Text)]
query) (url -> (url, [(Text, Maybe Text)]))
-> Either [Char] url -> Either [Char] (url, [(Text, Maybe Text)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> URLParser url -> [Text] -> Either [Char] url
forall a. URLParser a -> [Text] -> Either [Char] a
parseSegments URLParser url
forall url. PathInfo url => URLParser url
fromPathSegments [Text]
url
where
([Text]
url, [(Text, Maybe Text)]
query) = ByteString -> ([Text], [(Text, Maybe Text)])
decodePathInfoParams (ByteString -> ([Text], [(Text, Maybe Text)]))
-> ByteString -> ([Text], [(Text, Maybe Text)])
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
dropSlash ByteString
pi
dropSlash :: ByteString -> ByteString
dropSlash :: ByteString -> ByteString
dropSlash ByteString
s =
if ((Char -> ByteString
B.singleton Char
'/') ByteString -> ByteString -> Bool
`B.isPrefixOf` ByteString
s)
then ByteString -> ByteString
B.tail ByteString
s
else ByteString
s
mkSitePI :: (PathInfo url) =>
((url -> [(Text, Maybe Text)] -> Text) -> url -> a)
-> Site url a
mkSitePI :: forall url a.
PathInfo url =>
((url -> [(Text, Maybe Text)] -> Text) -> url -> a) -> Site url a
mkSitePI (url -> [(Text, Maybe Text)] -> Text) -> url -> a
handler =
Site :: forall url a.
((url -> [(Text, Maybe Text)] -> Text) -> url -> a)
-> (url -> ([Text], [(Text, Maybe Text)]))
-> ([Text] -> Either [Char] url)
-> Site url a
Site { handleSite :: (url -> [(Text, Maybe Text)] -> Text) -> url -> a
handleSite = (url -> [(Text, Maybe Text)] -> Text) -> url -> a
handler
, formatPathSegments :: url -> ([Text], [(Text, Maybe Text)])
formatPathSegments = (\[Text]
x -> ([Text]
x, [])) ([Text] -> ([Text], [(Text, Maybe Text)]))
-> (url -> [Text]) -> url -> ([Text], [(Text, Maybe Text)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. url -> [Text]
forall url. PathInfo url => url -> [Text]
toPathSegments
, parsePathSegments :: [Text] -> Either [Char] url
parsePathSegments = URLParser url -> [Text] -> Either [Char] url
forall a. URLParser a -> [Text] -> Either [Char] a
parseSegments URLParser url
forall url. PathInfo url => URLParser url
fromPathSegments
}
instance PathInfo Text where
toPathSegments :: Text -> [Text]
toPathSegments = (Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[])
fromPathSegments :: URLParser Text
fromPathSegments = URLParser Text
anySegment
instance PathInfo [Text] where
toPathSegments :: [Text] -> [Text]
toPathSegments = [Text] -> [Text]
forall a. a -> a
id
fromPathSegments :: ParsecT [Text] () Identity [Text]
fromPathSegments = URLParser Text -> ParsecT [Text] () Identity [Text]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many URLParser Text
anySegment
instance PathInfo String where
toPathSegments :: [Char] -> [Text]
toPathSegments = (Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[]) (Text -> [Text]) -> ([Char] -> Text) -> [Char] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
pack
fromPathSegments :: URLParser [Char]
fromPathSegments = Text -> [Char]
unpack (Text -> [Char]) -> URLParser Text -> URLParser [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> URLParser Text
anySegment
instance PathInfo [String] where
toPathSegments :: [[Char]] -> [Text]
toPathSegments = [Text] -> [Text]
forall a. a -> a
id ([Text] -> [Text]) -> ([[Char]] -> [Text]) -> [[Char]] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> Text) -> [[Char]] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Text
pack
fromPathSegments :: URLParser [[Char]]
fromPathSegments = URLParser [Char] -> URLParser [[Char]]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (Text -> [Char]
unpack (Text -> [Char]) -> URLParser Text -> URLParser [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> URLParser Text
anySegment)
instance PathInfo Int where
toPathSegments :: Int -> [Text]
toPathSegments Int
i = [[Char] -> Text
pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
i]
fromPathSegments :: URLParser Int
fromPathSegments = (Any -> [Char]) -> (Text -> Maybe Int) -> URLParser Int
forall tok a. tok -> (Text -> Maybe a) -> URLParser a
pToken ([Char] -> Any -> [Char]
forall a b. a -> b -> a
const [Char]
"Int") Text -> Maybe Int
forall a. Integral a => Text -> Maybe a
checkIntegral
instance PathInfo Integer where
toPathSegments :: Integer -> [Text]
toPathSegments Integer
i = [[Char] -> Text
pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Integer -> [Char]
forall a. Show a => a -> [Char]
show Integer
i]
fromPathSegments :: URLParser Integer
fromPathSegments = (Any -> [Char]) -> (Text -> Maybe Integer) -> URLParser Integer
forall tok a. tok -> (Text -> Maybe a) -> URLParser a
pToken ([Char] -> Any -> [Char]
forall a b. a -> b -> a
const [Char]
"Integer") Text -> Maybe Integer
forall a. Integral a => Text -> Maybe a
checkIntegral
instance PathInfo Int64 where
toPathSegments :: Int64 -> [Text]
toPathSegments Int64
i = [[Char] -> Text
pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Int64 -> [Char]
forall a. Show a => a -> [Char]
show Int64
i]
fromPathSegments :: URLParser Int64
fromPathSegments = (Any -> [Char]) -> (Text -> Maybe Int64) -> URLParser Int64
forall tok a. tok -> (Text -> Maybe a) -> URLParser a
pToken ([Char] -> Any -> [Char]
forall a b. a -> b -> a
const [Char]
"Int64") Text -> Maybe Int64
forall a. Integral a => Text -> Maybe a
checkIntegral
checkIntegral :: Integral a => Text -> Maybe a
checkIntegral :: forall a. Integral a => Text -> Maybe a
checkIntegral Text
txt =
case Reader a -> Reader a
forall a. Num a => Reader a -> Reader a
signed Reader a
forall a. Integral a => Reader a
decimal Text
txt of
(Left [Char]
e) -> Maybe a
forall a. Maybe a
Nothing
(Right (a
n, Text
r))
| Text -> Bool
Text.null Text
r -> a -> Maybe a
forall a. a -> Maybe a
Just a
n
| Bool
otherwise -> Maybe a
forall a. Maybe a
Nothing