{-# LANGUAGE OverloadedStrings #-}

-- |
-- Module       : Web.Skell.Resources
-- Description  : Resourcess for things
-- Copyright    : 2014, Peter Harpending.
-- License      : BSD3
-- Maintainer   : Peter Harpending <pharpend2@gmail.com>
-- Stability    : experimental
-- Portability  : archlinux
--

module Web.Skell.Resources where

import           Control.Applicative
import qualified Data.ByteString.Lazy as B
import qualified Data.Text as S
import qualified Data.Text.Lazy as L
import           Data.Monoid
import           Network.Wai (Response)
import           Paths_skell
import qualified Web.Skell.MimeTypes as M
import           Web.Skell.Responsible
import           Web.Skell.Saferoute

-- |The things that have a URL
data SkellRes = BootstrapCss
              | BootstrapJs
              | GlyphiconsEot
              | GlyphiconsSvg
              | GlyphiconsTtf
              | GlyphiconsWoff
              | JQueryJs
  deriving (Eq, Show)

instance Resource SkellRes where
  getRoute BootstrapCss   = "/css/bootstrap.css" 
  getRoute BootstrapJs    = "/js/bootstrap.js" 
  getRoute GlyphiconsEot  = "/fonts/glyphicons-halflings.eot" 
  getRoute GlyphiconsSvg  = "/fonts/glyphicons-halflings.svg" 
  getRoute GlyphiconsTtf  = "/fonts/glyphicons-halflings.ttf" 
  getRoute GlyphiconsWoff = "/fonts/glyphicons-halflings.woff" 
  getRoute JQueryJs       = "/js/jquery.js" 

instance Irresponsible SkellRes where
  respondIO BootstrapCss _    = df200 M.css  "vnd/bootstrap-3.2.0-dist/css/bootstrap.min.css"
  respondIO BootstrapJs _     = df200 M.js   "vnd/bootstrap-3.2.0-dist/js/bootstrap.min.js "
  respondIO GlyphiconsEot _   = df200 M.eot  "vnd/bootstrap-3.2.0-dist/fonts/glyphicons-halflings.eot"
  respondIO GlyphiconsSvg _   = df200 M.svg  "vnd/bootstrap-3.2.0-dist/fonts/glyphicons-halflings.svg"
  respondIO GlyphiconsTtf _   = df200 M.ttf  "vnd/bootstrap-3.2.0-dist/fonts/glyphicons-halflings.ttf"
  respondIO GlyphiconsWoff _  = df200 M.woff "vnd/bootstrap-3.2.0-dist/fonts/glyphicons-halflings.woff"
  respondIO JQueryJs _        = df200 M.js   "vnd/jquery-1.11.1/jquery-1.11.1.min.js"

df200 :: M.MimeType -> FilePath -> IO Response
df200 mtype fpath = respond200 mtype <$> (B.readFile =<< getDataFileName fpath)
  
-- |Error pages, 
data ErrorPage = Status403
               | Status404
               | Status405