Form.purs

module Hyper.Form
       ( Form(..)
       , optional
       , required
       , parseForm
       ) where

import Prelude

import Control.IxMonad (ibind, ipure)
import Control.Monad.Error.Class (throwError)
import Data.Array (head)
import Data.Either (Either(..))
import Data.Generic (class Generic)
import Data.Maybe (Maybe(Just, Nothing), maybe)
import Data.MediaType (MediaType(MediaType))
import Data.MediaType.Common (applicationFormURLEncoded)
import Data.Monoid (class Monoid)
import Data.Newtype (class Newtype, unwrap)
import Data.StrMap (lookup)
import Data.String (Pattern(Pattern), split)
import Data.Tuple (Tuple)
import Data.Tuple as Tuple
import Hyper.Conn (Conn)
import Hyper.Form.Urlencoded (Options) as Urlencoded
import Hyper.Form.Urlencoded (parseUrlencoded)
import Hyper.Middleware (Middleware)
import Hyper.Middleware.Class (getConn)
import Hyper.Request (class Request, class ReadableBody, getRequestData, readBody)

newtype Form = Form (Array (Tuple String (Maybe String)))

derive instance newtypeForm :: Newtype Form _
derive instance genericForm :: Generic Form
derive newtype instance eqForm :: Eq Form
derive newtype instance ordForm :: Ord Form
derive newtype instance showForm :: Show Form
derive newtype instance semigroupForm :: Semigroup Form
derive newtype instance monoidForm :: Monoid Form


optional :: String -> Form -> Maybe String
optional key = do
  unwrap
  >>> Tuple.lookup key
  >>> flip bind id


required :: String -> Form -> Either String String
required key =
  optional key
  >>> maybe (throwError ("Missing field: " <> key)) pure


parseContentMediaType :: String -> Maybe MediaType
parseContentMediaType = split (Pattern ";")
                        >>> head
                        >>> map MediaType

parseForm ∷ forall m req res c
  .  Monad m
  => Request req m
  => ReadableBody req m String
  => Urlencoded.Options
  -> Middleware
      m
      (Conn req res c)
      (Conn req res c)
      (Either String Form)
parseForm opts = do
  conn <- getConn
  { headers } <- getRequestData
  body <- readBody
  case lookup "content-type" headers >>= parseContentMediaType of
    Nothing ->
      ipure (Left "Missing or invalid content-type header.")
    Just mediaType | mediaType == applicationFormURLEncoded ->
      ipure (Form <$> parseUrlencoded opts body)
    Just mediaType ->
      ipure (Left ("Cannot parse media of type: " <> show mediaType))
  where bind = ibind