{-# LANGUAGE DeriveDataTypeable #-}

{- |
  Module      :  Lighttpd.Conf.Syntax
  Copyright   :  (c) Matt Morrow 2008
  License     :  BSD3

  Maintainer  :  Matt Morrow <mjm2002@gmail.com>
  Stability   :  unstable
  Portability :  non-portable (DeriveDataTypeable)
-}

module Lighttpd.Conf.Syntax (
    Config(..)
  , Name(..)
  , mkName
  , QName(..)
  , mkQName
  , Val(..)
  , ArrayElem(..)
  , Enabled(..)
  , Include(..)
  , Exp(..)
  , CondElse(..)
  , Cond(..)
  , Op(..)
  , Pat(..)
  , Field(..)
  , ToVal(..)
) where

import Data.Monoid(Monoid(..))
import Data.Generics (Data)
import Data.Typeable (Typeable)
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as B

-----------------------------------------------------------------------------

newtype Config = Config [Exp]
  deriving (Eq,Ord,Show,Typeable,Data)

instance Monoid Config where
  mempty = Config []
  Config xs `mappend` Config ys = Config (xs++ys)

-----------------------------------------------------------------------------

newtype Name = Name ByteString
  deriving (Eq,Ord,Show,Typeable,Data)

mkName :: String -> Name
mkName = Name . B.pack

data QName = QName
  { moduleName  :: Name
  , baseName    :: Name }
  deriving (Eq,Ord,Show,Typeable,Data)

mkQName :: String -> String -> QName
mkQName a b = QName (mkName a) (mkName b)

-----------------------------------------------------------------------------

data Val
  = SpliceV ByteString
  | VarV QName
  | StringV ByteString
  | IntegerV Int
  | BooleanV Enabled
  | ArrayV [ArrayElem]
  | ManyV [Val]
  deriving (Eq,Ord,Show,Typeable,Data)

data ArrayElem
  = ArrayElem (Maybe Name) Val
  deriving (Eq,Ord,Show,Typeable,Data)

data Enabled = Enable | Disable
  deriving (Eq,Ord,Show,Typeable,Data)

toArrayElem :: (Maybe Name,Val) -> ArrayElem
toArrayElem = uncurry ArrayElem

-----------------------------------------------------------------------------

data Exp
  = CommentE ByteString
  | GlobalCxtE [Exp]
  | OptionE QName Val
  | MergeE QName Val
  | IncludeE Include
  | CondE Cond [Exp] [CondElse]
  deriving (Eq,Ord,Show,Typeable,Data)

data CondElse
  = CondElse Cond [Exp]
  deriving (Eq,Ord,Show,Typeable,Data)

data Include
  = ValueI Val
  | ShellI ByteString
  deriving (Eq,Ord,Show,Typeable,Data)

-----------------------------------------------------------------------------

{- |
> ghci> ppr $ Cond (HttpF Cookie) Match (RegexP "this.{,5}[=@#]?that$")
> $HTTP{"cookie"} =~ "this.{,5}[=@#]?that$"
-}
data Cond
  = Cond Field Op Pat
  deriving (Eq,Ord,Show,Typeable,Data)

data Op
  = Equal
  | NotEqual
  | Match
  | NotMatch
  deriving (Eq,Ord,Show,Typeable,Data)

data Pat
  = StringP ByteString
  | RegexP ByteString
  deriving (Eq,Ord,Show,Typeable,Data)

data Field = Field Name ByteString
  deriving (Eq,Ord,Show,Typeable,Data)
{-
  = HttpF HttpVar
  | ServerF ServerVar
  | PhysicalF PhysicalVar
-}


{-
data HttpVar
  = Cookie
  | Host
  | Referer
  | URL
  | QueryString
  | RemoteIP
  | Scheme
  deriving (Show)

data ServerVar
  = Socket
  deriving (Show)

data PhysicalVar
  = Path
  | ExistingPath
  deriving (Show)
-}

-----------------------------------------------------------------------------

class ToVal a where
  toVal :: a -> Val

instance ToVal String where
  toVal = StringV . B.pack

instance ToVal ByteString where
  toVal = StringV

instance ToVal Int where
  toVal = IntegerV

instance ToVal Integer where
  toVal = IntegerV . fromIntegral

instance ToVal Bool where
  toVal True = BooleanV Enable
  toVal _    = BooleanV Disable

instance ToVal [Val] where
  toVal = ManyV

instance ToVal [ArrayElem] where
  toVal = ArrayV

instance ToVal [(Maybe Name,Val)] where
  toVal = toVal . fmap toArrayElem

-----------------------------------------------------------------------------

{-
option   : NAME = VALUE
merge    : NAME += VALUE
NAME     : modulename.key
VALUE    : ( <string> | <integer> | <boolean> | <array> | VALUE [ + VALUE ]*)
<string> : "text"
<integer>: digit*
<boolean>: ( "enable" | "disable" )
<array>  : "(" [ <string> "=>" ] <value> [, [ <string> "=>" ] <value> ]* ")"
INCLUDE  : "include" VALUE
INCLUDE_SHELL : "include_shell" STRING_VALUE
-}

{-
<field> <operator> <value> {
  ...
  <field> <operator> <value> {
    ... nesting: match only when parent match
  }
}
else <field> <operator> <value> {
  ... the "else if" block
}
-}

{-
where <field> is one of one of the following:

$HTTP["cookie"]
    match on cookie
$HTTP["host"]
    match on host
$HTTP["useragent"]
    match on useragent
$HTTP["referer"]
    match on referer
$HTTP["url"]
    match on url. If there are nested blocks, this must be the most inner block.
$HTTP["querystring"]
    match on querystring, eg, after the ? in this type url: index.php?module=images..
$HTTP["remoteip"]
    match on the remote IP or a remote Network (Warning: doesn't work with IPv6 enabled)
$HTTP["scheme"] (Introduced in version 1.4.19)
    match on the scheme used by the incoming connection. This is either "http" or "https".
$SERVER["socket"]
    match on socket. Value must be on the format "ip:port" where ip is an IP address and port a port number, or ":port" to match port only. Only equal match (==) is supported. It also binds the daemon to this socket. Use this if you want to do IP/port-based virtual hosts.
$PHYSICAL["path"] (Introduced in version 1.5.0)
    match on the mapped physical path of the file / cgi script to be served.
$PHYSICAL["existing-path"] (Introduced in version 1.5.0)
    match on the mapped physical path of the file / cgi script to be served only if such a file exists on the local filesystem. 

<operator> is one of:
==
    string equal match
!=
    string not equal match
=~
    perl style regular expression match
!~
    perl style regular expression not match

and <value> is either a quoted ("") literal string or regular expression.
-}

{-
# default document-root
server.document-root = "/var/www/example.org/pages/"

# TCP port
server.port = 80

# selecting modules
server.modules = ( "mod_access", "mod_rewrite" )

# variables, computed when config is read.
var.mymodule = "foo"
server.modules += ( "mod_" + var.mymodule )
# var.PID is initialised to the pid of lighttpd before config is parsed

# include, relative to dirname of main config file
include "mime.types.conf"

# read configuration from output of a command
include_shell "/usr/local/bin/confmimetype /etc/mime.types"
-}