{-# LANGUAGE GeneralizedNewtypeDeriving, StandaloneDeriving, FlexibleInstances, FlexibleContexts #-}
module Web.Route.Invertible.Host
( HostString
, splitHost
, joinHost
, Host(..)
, renderHost
) where
import Prelude hiding (lookup)
import Control.Invertible.Monoidal
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BSC
import qualified Data.Invertible as I
import Data.String (IsString(..))
import Web.Route.Invertible.Parameter
import Web.Route.Invertible.Placeholder
import Web.Route.Invertible.Sequence
type HostString = BS.ByteString
splitHost :: BS.ByteString -> [HostString]
splitHost :: ByteString -> [ByteString]
splitHost = [ByteString] -> [ByteString]
forall a. [a] -> [a]
reverse ([ByteString] -> [ByteString])
-> (ByteString -> [ByteString]) -> ByteString -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ByteString -> [ByteString]
BSC.split Char
'.'
joinHost :: [HostString] -> BS.ByteString
joinHost :: [ByteString] -> ByteString
joinHost = ByteString -> [ByteString] -> ByteString
BS.intercalate (Char -> ByteString
BSC.singleton Char
'.') ([ByteString] -> ByteString)
-> ([ByteString] -> [ByteString]) -> [ByteString] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> [ByteString]
forall a. [a] -> [a]
reverse
newtype Host a = HostRev { Host a -> Sequence ByteString a
hostSequence :: Sequence HostString a }
deriving ((a <-> b) -> Host a -> Host b
(forall a b. (a <-> b) -> Host a -> Host b) -> Functor Host
forall a b. (a <-> b) -> Host a -> Host b
forall (f :: * -> *).
(forall a b. (a <-> b) -> f a -> f b) -> Functor f
fmap :: (a <-> b) -> Host a -> Host b
$cfmap :: forall a b. (a <-> b) -> Host a -> Host b
I.Functor, Monoidal Host
Host Void
Monoidal Host
-> Host Void
-> (forall a b. Host a -> Host b -> Host (Either a b))
-> MonoidalAlt Host
Host a -> Host b -> Host (Either a b)
forall a b. Host a -> Host b -> Host (Either a b)
forall (f :: * -> *).
Monoidal f
-> f Void
-> (forall a b. f a -> f b -> f (Either a b))
-> MonoidalAlt f
>|< :: Host a -> Host b -> Host (Either a b)
$c>|< :: forall a b. Host a -> Host b -> Host (Either a b)
zero :: Host Void
$czero :: Host Void
$cp1MonoidalAlt :: Monoidal Host
MonoidalAlt, Parameterized HostString, Int -> Host a -> ShowS
[Host a] -> ShowS
Host a -> String
(Int -> Host a -> ShowS)
-> (Host a -> String) -> ([Host a] -> ShowS) -> Show (Host a)
forall a. Int -> Host a -> ShowS
forall a. [Host a] -> ShowS
forall a. Host a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Host a] -> ShowS
$cshowList :: forall a. [Host a] -> ShowS
show :: Host a -> String
$cshow :: forall a. Host a -> String
showsPrec :: Int -> Host a -> ShowS
$cshowsPrec :: forall a. Int -> Host a -> ShowS
Show)
instance Monoidal Host where
unit :: Host ()
unit = Sequence ByteString () -> Host ()
forall a. Sequence ByteString a -> Host a
HostRev Sequence ByteString ()
forall (f :: * -> *). Monoidal f => f ()
unit
HostRev Sequence ByteString a
p >*< :: Host a -> Host b -> Host (a, b)
>*< HostRev Sequence ByteString b
q = (b, a) <-> (a, b)
forall a b. (a, b) <-> (b, a)
I.swap ((b, a) <-> (a, b)) -> Host (b, a) -> Host (a, b)
forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
>$< Sequence ByteString (b, a) -> Host (b, a)
forall a. Sequence ByteString a -> Host a
HostRev (Sequence ByteString b
q Sequence ByteString b
-> Sequence ByteString a -> Sequence ByteString (b, a)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< Sequence ByteString a
p)
instance IsString (Host ()) where
fromString :: String -> Host ()
fromString String
s = Sequence ByteString () -> Host ()
forall a. Sequence ByteString a -> Host a
HostRev (Sequence ByteString () -> Host ())
-> Sequence ByteString () -> Host ()
forall a b. (a -> b) -> a -> b
$ (ByteString -> Sequence ByteString ())
-> [ByteString] -> Sequence ByteString ()
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Monoidal f) =>
(a -> f ()) -> t a -> f ()
mapI_ (Placeholder ByteString () -> Sequence ByteString ()
forall s a. Placeholder s a -> Sequence s a
placeholderSequence (Placeholder ByteString () -> Sequence ByteString ())
-> (ByteString -> Placeholder ByteString ())
-> ByteString
-> Sequence ByteString ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Placeholder ByteString ()
forall s. s -> Placeholder s ()
PlaceholderFixed) ([ByteString] -> Sequence ByteString ())
-> [ByteString] -> Sequence ByteString ()
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString]
splitHost (ByteString -> [ByteString]) -> ByteString -> [ByteString]
forall a b. (a -> b) -> a -> b
$ String -> ByteString
forall a. IsString a => String -> a
fromString String
s
renderHost :: Host a -> a -> BS.ByteString
renderHost :: Host a -> a -> ByteString
renderHost (HostRev Sequence ByteString a
p) a
a = [ByteString] -> ByteString
joinHost ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ Sequence ByteString a -> a -> [ByteString]
forall s a. Sequence s a -> a -> [s]
renderSequence Sequence ByteString a
p a
a