--------------------------------------------------------------------------------
{-# LANGUAGE GADTs #-}
module Text.Digestive.Form.Encoding
    ( FormEncType (..)
    , formEncType
    , formTreeEncType
    ) where


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


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


--------------------------------------------------------------------------------
data FormEncType
    = UrlEncoded
    | MultiPart
    deriving (Eq)


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


--------------------------------------------------------------------------------
-- Monoid instance for encoding types: prefer UrlEncoded, but fallback to
-- MultiPart when needed
instance Monoid FormEncType where
    mempty               = UrlEncoded
    mappend UrlEncoded x = x
    mappend MultiPart  _ = MultiPart


--------------------------------------------------------------------------------
fieldEncType :: Field v a -> FormEncType
fieldEncType File = MultiPart
fieldEncType _    = UrlEncoded


--------------------------------------------------------------------------------
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


--------------------------------------------------------------------------------
formEncType :: Monad m => Form v m a -> m FormEncType
formEncType form = liftM formTreeEncType $ toFormTree form


--------------------------------------------------------------------------------
formTreeEncType :: FormTree Identity v m a -> FormEncType
formTreeEncType = mconcat . map fieldEncType' . fieldList
  where
    fieldEncType' (SomeField f) = fieldEncType f