-- |
-- Module:     WebWire.Types
-- Copyright:  (c) 2011 Ertugrul Soeylemez
-- License:    BSD3
-- Maintainer: Ertugrul Soeylemez <es@ertes.de>
--
-- Types used in webwire.

module WebWire.Types
    ( -- * Common types
      WebException(..),
      WebOutput(..),
      WebWire,

      -- * Utility types
      RedirectType(..),

      -- * Simple sites
      SimpleWire,

      -- * Internal
      WebConfig(..)
    )
    where

import qualified Data.ByteString.Char8 as BC
import qualified Data.Text as T
import Blaze.ByteString.Builder
import Control.Exception
import Control.Monad.Trans.State
import Data.ByteString (ByteString)
import Data.CaseInsensitive (CI)
import Data.Map (Map)
import Data.Text (Text)
import Data.Typeable
import FRP.NetWire
import Network.HTTP.Types
import Network.Wai
import Network.Wai.Parse
import Text.Blaze
import WebWire.Widget


-- | Types of redirection.  For temporary redirections, especially in
-- response to handling a form, you will want to use 'RedirectSeeOther'.

data RedirectType
    = RedirectPermanent  -- ^ Permanently moved (301).
    | RedirectSeeOther   -- ^ See other (303).
    | RedirectTemporary  -- ^ Temporary redirection (307).


-- | Wire type for simple sites.

type SimpleWire = WebWire ()


-- | Runtime configuration of a wire.

data WebConfig site =
    WebConfig {
      wcCookies     :: Map ByteString ByteString,  -- ^ Received cookies.
      wcCurrentPath :: [Text],                     -- ^ Current path.
      wcPostParams  :: Map ByteString ByteString,  -- ^ POST parameters.
      wcPostFiles   :: Map ByteString (FileInfo FilePath), -- ^ POST files.
      wcQueryParams :: Map ByteString ByteString,  -- ^ Query parameters.
      wcRequest     :: Request,                    -- ^ Current request.
      wcRequestPath :: [Text],                     -- ^ Request path.
      wcRootPath    :: [Text],                     -- ^ Site's root path.
      wcSetCookies  :: Map ByteString ByteString,  -- ^ Cookies to add to the response.
      wcSetHeaders  :: [(CI Ascii, Ascii)],        -- ^ Headers to add to the response.
      wcSite        :: site,                       -- ^ User site argument.
      wcWidget      :: Widget                      -- ^ Default rendering widget.
    }


-- | A web exception is an HTTP status code possibly with additional
-- data.

data WebException
    -- | Generic web exception.  This can be an internal server error
    -- (5xx) or document error (4xx), which don't need additional data.
    = WebException Status

    -- | Redirection exception.  The second argument specifies the URI
    -- to redirect to.
    | WebRedirect Status Text
    deriving (Typeable)

instance Show WebException where
    show (WebException (Status code msg)) =
        show code ++ ": " ++ BC.unpack msg

    show (WebRedirect (Status code msg) uri) =
        show code ++ ": " ++ BC.unpack msg ++ " <" ++ T.unpack uri ++ ">"

instance Exception WebException


-- | Various output types.  The boolean argument taken by the
-- constructors specifies whether a Content-length header should be
-- sent.  If true, the string will be fully built, before being sent to
-- the client.

data WebOutput
    -- | Generic data output
    = GenOutput Bool Ascii Builder

    -- | UTF-8-encoded HTML.
    | HtmlOutput Bool Html

    -- | UTF-8-encoded string.
    | TextOutput Bool Builder


-- | Web request handling wires.

type WebWire site = Wire (StateT (WebConfig site) IO)