{-# 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 (Int8, Int16, Int32, 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 Data.Word (Word, Word8, Word16, Word32, Word64)
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 a. a -> ParsecT [Text] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return a
r
(Left [Char]
err) -> [Char] -> URLParser a
forall a. [Char] -> ParsecT [Text] () Identity 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 a b.
ParsecT [Text] () Identity a
-> ParsecT [Text] () Identity b -> ParsecT [Text] () Identity 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 a. a -> ParsecT [Text] () Identity a
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 url. a url -> [Text]
forall (f :: * -> *) url. GPathInfo f => f url -> [Text]
gtoPathSegments (a url -> [Text]) -> (D1 c a url -> a url) -> D1 c a url -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. D1 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 url. URLParser (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 url. a url -> [Text]
forall (f :: * -> *) url. GPathInfo f => f url -> [Text]
gtoPathSegments (a url -> [Text]) -> (S1 c a url -> a url) -> S1 c a url -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. S1 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 url. URLParser (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]
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
(a :: k1).
t c f a -> [Char]
conName) C1 c a url
m Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: a url -> [Text]
forall url. 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 a b.
a -> ParsecT [Text] () Identity b -> ParsecT [Text] () Identity a
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]
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
(a :: k1).
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
$ (C1 c a r
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 a b.
ParsecT [Text] () Identity (a -> b)
-> ParsecT [Text] () Identity a -> ParsecT [Text] () Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT [Text] () Identity (a url)
forall url. URLParser (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 url. 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 url. 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 url. URLParser (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 a b.
ParsecT [Text] () Identity (a -> b)
-> ParsecT [Text] () Identity a -> ParsecT [Text] () Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT [Text] () Identity (b url)
forall url. URLParser (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 url. a url -> [Text]
forall (f :: * -> *) url. GPathInfo f => f url -> [Text]
gtoPathSegments a url
x
gtoPathSegments (R1 b url
x) = b url -> [Text]
forall url. 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 url. URLParser (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 a.
ParsecT [Text] () Identity a
-> ParsecT [Text] () Identity a -> ParsecT [Text] () Identity a
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 url. URLParser (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 url. Rep url url -> [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 x. url -> Rep url x
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
forall x. Rep url x -> url
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 url. URLParser (Rep url url)
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 HasCallStack => ByteString -> ByteString
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 { 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 Int8 where
toPathSegments :: Int8 -> [Text]
toPathSegments Int8
i = [[Char] -> Text
pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Int8 -> [Char]
forall a. Show a => a -> [Char]
show Int8
i]
fromPathSegments :: URLParser Int8
fromPathSegments = (Any -> [Char]) -> (Text -> Maybe Int8) -> URLParser Int8
forall tok a. tok -> (Text -> Maybe a) -> URLParser a
pToken ([Char] -> Any -> [Char]
forall a b. a -> b -> a
const [Char]
"Int8") Text -> Maybe Int8
forall a. Integral a => Text -> Maybe a
checkIntegral
instance PathInfo Int16 where
toPathSegments :: Int16 -> [Text]
toPathSegments Int16
i = [[Char] -> Text
pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Int16 -> [Char]
forall a. Show a => a -> [Char]
show Int16
i]
fromPathSegments :: URLParser Int16
fromPathSegments = (Any -> [Char]) -> (Text -> Maybe Int16) -> URLParser Int16
forall tok a. tok -> (Text -> Maybe a) -> URLParser a
pToken ([Char] -> Any -> [Char]
forall a b. a -> b -> a
const [Char]
"Int16") Text -> Maybe Int16
forall a. Integral a => Text -> Maybe a
checkIntegral
instance PathInfo Int32 where
toPathSegments :: Int32 -> [Text]
toPathSegments Int32
i = [[Char] -> Text
pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Int32 -> [Char]
forall a. Show a => a -> [Char]
show Int32
i]
fromPathSegments :: URLParser Int32
fromPathSegments = (Any -> [Char]) -> (Text -> Maybe Int32) -> URLParser Int32
forall tok a. tok -> (Text -> Maybe a) -> URLParser a
pToken ([Char] -> Any -> [Char]
forall a b. a -> b -> a
const [Char]
"Int32") Text -> Maybe Int32
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
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 Word where
toPathSegments :: Word -> [Text]
toPathSegments Word
i = [[Char] -> Text
pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Word -> [Char]
forall a. Show a => a -> [Char]
show Word
i]
fromPathSegments :: URLParser Word
fromPathSegments = (Any -> [Char]) -> (Text -> Maybe Word) -> URLParser Word
forall tok a. tok -> (Text -> Maybe a) -> URLParser a
pToken ([Char] -> Any -> [Char]
forall a b. a -> b -> a
const [Char]
"Word") Text -> Maybe Word
forall a. Integral a => Text -> Maybe a
checkIntegral
instance PathInfo Word8 where
toPathSegments :: Word8 -> [Text]
toPathSegments Word8
i = [[Char] -> Text
pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Word8 -> [Char]
forall a. Show a => a -> [Char]
show Word8
i]
fromPathSegments :: URLParser Word8
fromPathSegments = (Any -> [Char]) -> (Text -> Maybe Word8) -> URLParser Word8
forall tok a. tok -> (Text -> Maybe a) -> URLParser a
pToken ([Char] -> Any -> [Char]
forall a b. a -> b -> a
const [Char]
"Word8") Text -> Maybe Word8
forall a. Integral a => Text -> Maybe a
checkIntegral
instance PathInfo Word16 where
toPathSegments :: Word16 -> [Text]
toPathSegments Word16
i = [[Char] -> Text
pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Word16 -> [Char]
forall a. Show a => a -> [Char]
show Word16
i]
fromPathSegments :: URLParser Word16
fromPathSegments = (Any -> [Char]) -> (Text -> Maybe Word16) -> URLParser Word16
forall tok a. tok -> (Text -> Maybe a) -> URLParser a
pToken ([Char] -> Any -> [Char]
forall a b. a -> b -> a
const [Char]
"Word16") Text -> Maybe Word16
forall a. Integral a => Text -> Maybe a
checkIntegral
instance PathInfo Word32 where
toPathSegments :: Word32 -> [Text]
toPathSegments Word32
i = [[Char] -> Text
pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Word32 -> [Char]
forall a. Show a => a -> [Char]
show Word32
i]
fromPathSegments :: URLParser Word32
fromPathSegments = (Any -> [Char]) -> (Text -> Maybe Word32) -> URLParser Word32
forall tok a. tok -> (Text -> Maybe a) -> URLParser a
pToken ([Char] -> Any -> [Char]
forall a b. a -> b -> a
const [Char]
"Word32") Text -> Maybe Word32
forall a. Integral a => Text -> Maybe a
checkIntegral
instance PathInfo Word64 where
toPathSegments :: Word64 -> [Text]
toPathSegments Word64
i = [[Char] -> Text
pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Word64 -> [Char]
forall a. Show a => a -> [Char]
show Word64
i]
fromPathSegments :: URLParser Word64
fromPathSegments = (Any -> [Char]) -> (Text -> Maybe Word64) -> URLParser Word64
forall tok a. tok -> (Text -> Maybe a) -> URLParser a
pToken ([Char] -> Any -> [Char]
forall a b. a -> b -> a
const [Char]
"Word64") Text -> Maybe Word64
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