Saferoute.hs

{-# LANGUAGE OverloadedStrings #-}

-- |
-- Module       : Web.Skell.Saferoute
-- Description  : Saferoutes for things
-- Copyright    : 2014, Peter Harpending.
-- License      : BSD3
-- Maintainer   : Peter Harpending <pharpend2@gmail.com>
-- 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"