Encoding.hs

--------------------------------------------------------------------------------
{-# LANGUAGE GADTs #-}
-- | Provides a datatype to differentiate between regular urlencoding and
-- multipart encoding for the content of forms and functions to determine
-- the content types of forms.
module Text.Digestive.Form.Encoding
    ( FormEncType (..)
    , formTreeEncType
    ) where


--------------------------------------------------------------------------------
import           Control.Monad.Identity             (Identity)
import           Data.Maybe                         (mapMaybe)
import           Data.Monoid                        (Monoid (..), mconcat)
import           Data.Semigroup                     (Semigroup (..))


--------------------------------------------------------------------------------
import           Text.Digestive.Form.Internal
import           Text.Digestive.Form.Internal.Field


--------------------------------------------------------------------------------
-- | Content type encoding of the form, either url encoded
-- (percent-encoding) or multipart encoding. For details, see:
-- <http://www.w3.org/TR/html401/interact/forms.html#h-17.13.4>
data FormEncType
    = UrlEncoded
    | MultiPart
    deriving (Eq)


--------------------------------------------------------------------------------
instance Show FormEncType where
    show UrlEncoded = "application/x-www-form-urlencoded"
    show MultiPart  = "multipart/form-data"


--------------------------------------------------------------------------------
-- Semigroup instance for encoding types: prefer UrlEncoded, but fallback to
-- MultiPart when needed
instance Semigroup FormEncType where
    UrlEncoded <> x = x
    MultiPart  <> _ = MultiPart


--------------------------------------------------------------------------------
-- Monoid instance for encoding types: prefer UrlEncoded, but fallback to
-- MultiPart when needed
instance Monoid FormEncType where
    mempty  = UrlEncoded
    mappend = (<>)


--------------------------------------------------------------------------------
-- Only file uploads require the multipart encoding
fieldEncType :: Field v a -> FormEncType
fieldEncType File = MultiPart
fieldEncType _    = UrlEncoded


--------------------------------------------------------------------------------
-- Retrieves all fields from a form tree
fieldList :: FormTree Identity v m a -> [SomeField v]
fieldList = mapMaybe toField' . fieldList' . SomeForm
  where
    fieldList' (SomeForm f) = SomeForm f : concatMap fieldList' (children f)
    toField' (SomeForm f)   = toField f


--------------------------------------------------------------------------------
-- | Determines the encoding type of a "FormTree"
formTreeEncType :: FormTree Identity v m a -> FormEncType
formTreeEncType = mconcat . map fieldEncType' . fieldList
  where
    fieldEncType' (SomeField f) = fieldEncType f