module Web.Routes.Site where

import Data.ByteString
import Data.Monoid
import Data.Text (Text)
import Web.Routes.Base (decodePathInfo, encodePathInfo)

{-|

A site groups together the three functions necesary to make an application:

* A function to convert from the URL type to path segments.

* A function to convert from path segments to the URL, if possible.

* A function to return the application for a given URL.

There are two type parameters for Site: the first is the URL datatype, the
second is the application datatype. The application datatype will depend upon
your server backend.
-}
data Site url a
    = Site {
           {-|
               Return the appropriate application for a given URL.

               The first argument is a function which will give an appropriate
               URL (as a String) for a URL datatype. This is usually
               constructed by a combination of 'formatPathSegments' and the
               prepending of an absolute application root.

               Well behaving applications should use this function to
               generating all internal URLs.
           -}
             Site url a -> (url -> [(Text, Maybe Text)] -> Text) -> url -> a
handleSite         :: (url -> [(Text, Maybe Text)] -> Text) -> url -> a
           -- | This function must be the inverse of 'parsePathSegments'.
           , Site url a -> url -> ([Text], [(Text, Maybe Text)])
formatPathSegments :: url -> ([Text], [(Text, Maybe Text)])
           -- | This function must be the inverse of 'formatPathSegments'.
           , Site url a -> [Text] -> Either String url
parsePathSegments  :: [Text] -> Either String url
           }

-- | Override the \"default\" URL, ie the result of 'parsePathSegments' [].
setDefault :: url -> Site url a -> Site url a
setDefault :: url -> Site url a -> Site url a
setDefault url
defUrl (Site (url -> [(Text, Maybe Text)] -> Text) -> url -> a
handle url -> ([Text], [(Text, Maybe Text)])
format [Text] -> Either String url
parse) =
    ((url -> [(Text, Maybe Text)] -> Text) -> url -> a)
-> (url -> ([Text], [(Text, Maybe Text)]))
-> ([Text] -> Either String url)
-> Site url a
forall url a.
((url -> [(Text, Maybe Text)] -> Text) -> url -> a)
-> (url -> ([Text], [(Text, Maybe Text)]))
-> ([Text] -> Either String url)
-> Site url a
Site (url -> [(Text, Maybe Text)] -> Text) -> url -> a
handle url -> ([Text], [(Text, Maybe Text)])
format [Text] -> Either String url
parse'
  where
    parse' :: [Text] -> Either String url
parse' [] = url -> Either String url
forall a b. b -> Either a b
Right url
defUrl
    parse' [Text]
x = [Text] -> Either String url
parse [Text]
x

instance Functor (Site url) where
  fmap :: (a -> b) -> Site url a -> Site url b
fmap a -> b
f Site url a
site = Site url a
site { handleSite :: (url -> [(Text, Maybe Text)] -> Text) -> url -> b
handleSite = \url -> [(Text, Maybe Text)] -> Text
showFn url
u -> a -> b
f (Site url a -> (url -> [(Text, Maybe Text)] -> Text) -> url -> a
forall url a.
Site url a -> (url -> [(Text, Maybe Text)] -> Text) -> url -> a
handleSite Site url a
site url -> [(Text, Maybe Text)] -> Text
showFn url
u) }

-- | Retrieve the application to handle a given request.
--
-- NOTE: use 'decodePathInfo' to convert a 'ByteString' url to a properly decoded list of path segments
runSite :: Text -- ^ application root, with trailing slash
        -> Site url a
        -> [Text] -- ^ path info, (call 'decodePathInfo' on path with leading slash stripped)
        -> (Either String a)
runSite :: Text -> Site url a -> [Text] -> Either String a
runSite Text
approot Site url a
site [Text]
pathInfo =
    case Site url a -> [Text] -> Either String url
forall url a. Site url a -> [Text] -> Either String url
parsePathSegments Site url a
site [Text]
pathInfo of
        (Left String
errs) -> (String -> Either String a
forall a b. a -> Either a b
Left String
errs)
        (Right url
url) -> a -> Either String a
forall a b. b -> Either a b
Right (a -> Either String a) -> a -> Either String a
forall a b. (a -> b) -> a -> b
$ Site url a -> (url -> [(Text, Maybe Text)] -> Text) -> url -> a
forall url a.
Site url a -> (url -> [(Text, Maybe Text)] -> Text) -> url -> a
handleSite Site url a
site url -> [(Text, Maybe Text)] -> Text
showFn url
url
  where
    showFn :: url -> [(Text, Maybe Text)] -> Text
showFn url
url [(Text, Maybe Text)]
qs =
        let ([Text]
pieces, [(Text, Maybe Text)]
qs') = Site url a -> url -> ([Text], [(Text, Maybe Text)])
forall url a. Site url a -> url -> ([Text], [(Text, Maybe Text)])
formatPathSegments Site url a
site url
url
        in Text
approot Text -> Text -> Text
forall a. Monoid a => a -> a -> a
`mappend` ([Text] -> [(Text, Maybe Text)] -> Text
encodePathInfo [Text]
pieces ([(Text, Maybe Text)]
qs [(Text, Maybe Text)]
-> [(Text, Maybe Text)] -> [(Text, Maybe Text)]
forall a. [a] -> [a] -> [a]
++ [(Text, Maybe Text)]
qs'))