{-# LANGUAGE OverloadedStrings #-} -- | -- Module : Web.Skell.Saferoute -- Description : Saferoutes for things -- Copyright : 2014, Peter Harpending. -- License : BSD3 -- Maintainer : Peter Harpending -- Stability : experimental -- Portability : archlinux -- module Web.Skell.Saferoute where import Control.Applicative import qualified Data.ByteString.Lazy as B import qualified Data.Map.Lazy as M import Data.Monoid import qualified Data.Text as S import qualified Data.Text.Lazy as L import Data.Monoid import Network.Wai (Response) import qualified Text.Blaze.Html5 as H import qualified Web.Skell.MimeTypes as Mt import Web.Skell.Responsible -- |The type for a route - just an alias for 'L.Text' type Route = S.Text type RoutePart = S.Text type RouteParts = [S.Text] type ForeignResource = H.AttributeValue -- |The type class for a resource. class Eq r => Resource r where {-# MINIMAL getRoute, (resourceList | routeResourceMap) #-} -- Get the 'Route' for a 'Resource'. This is in place to avoid -- @fmap@ stuff. Giving a 'Resource' to this function will -- invariably return a 'Route', as opposed to 'Maybe Route', which -- would be the case if I used a 'M.Map' lookup. getRoute :: r -> Route -- |A list of all of the constructors for your resource type. resourceList :: [r] resourceList = M.elems routeResourceMap -- |A map from a route to it's resource. routeResourceMap :: M.Map Route r routeResourceMap = M.fromList [(route, resource) | resource <- resourceList, let route = getRoute resource ] -- |Given a 'Route', find the 'Resource' behind it. If the route -- isn't associated with any 'Resource', this returns 'Nothing'. lookupRoute :: Route -> Maybe r lookupRoute route = M.lookup route routeResourceMap -- |Lookup a set of route parts lookupRouteParts :: RouteParts -> Maybe r lookupRouteParts = lookupRoute . slashPrependJoin getUrl :: Resource r => r -> H.AttributeValue getUrl = H.toValue . getRoute -- |Intercalate slashes, and add one to the front slashPrependJoin :: RouteParts -> Route slashPrependJoin parts = "/" <> S.intercalate "/" parts -- |Error pages, data ErrorPage = Status403 | Status404 | Status405 bootstrapCss :: ForeignResource bootstrapCss = "//maxcdn.bootstrapcdn.com/bootstrap/3.2.0/css/bootstrap.min.css" bootstrapJs :: ForeignResource bootstrapJs = "//maxcdn.bootstrapcdn.com/bootstrap/3.2.0/js/bootstrap.min.js" jQueryJs :: ForeignResource jQueryJs = "//ajax.googleapis.com/ajax/libs/jquery/1.11.1/jquery.min.js"