src/Text/Digestive/Scotty.hs

{-|
Module providing the scotty backend for the digestive-functors library

>{-# LANGUAGE OverloadedStrings #-}
>
>import Web.Scotty
>
>import Text.Digestive
>import Text.Digestive.Scotty
>
>import Control.Applicative ((<$>), (<*>))
>
>data FormData = FormData { field1 :: String
>                         , field2 :: Integer
>                         }
>
>testForm :: Monad m => Form String m FormData
>testForm = FormData
>           <$> "field1" .: string Nothing
>           <*> "field2" .: stringRead "read failed" Nothing
>
>main :: IO ()
>main = scotty 3000 $ do
>    get "/" $ do
>        setHeader "Content-Type" "text/html"
>        raw " <html><body><form enctype='multipart/form-data' method='post'> \
>              \ <input type='text' name='test-form.field1'/> \
>              \ <input type='text' name='test-form.field2'/> \
>              \ <input type='submit'/> \
>              \ </form></body></html>"
>
>    post "/" $ do
>        (view, result) <- runForm "test-form" testForm
>        case result of
>            Just d -> ... Success! `d` contains constructed FormData.
>            _ -> ... Failure! Use `view` variable to access error messages.
-}
module Text.Digestive.Scotty
    ( runForm
    ) where

import Control.Monad ( liftM )
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Text.Lazy as TL
import qualified Web.Scotty.Trans as Scotty
import Network.Wai ( requestMethod )
import Network.Wai.Parse ( fileName )
import Network.HTTP.Types ( methodGet )

import Text.Digestive.Form
import Text.Digestive.Types
import Text.Digestive.View

scottyEnv :: (Monad m, Scotty.ScottyError e) => Env (Scotty.ActionT e m)
scottyEnv path = do
    inputs <- parse (TextInput . TL.toStrict) Scotty.params
    files  <- parse (FileInput . B.unpack . fileName) Scotty.files
    return $ inputs ++ files
  where parse f = liftM $ map (f . snd) . filter ((== name) . fst)
        name    = TL.fromStrict . fromPath $ path

-- | Runs a form with the HTTP input provided by Scotty.
runForm :: (Monad m, Scotty.ScottyError e)
        => T.Text                                 -- ^ Name of the form
        -> Form v (Scotty.ActionT e m) a          -- ^ Form to run
        -> (Scotty.ActionT e m) (View v, Maybe a) -- ^ Result
runForm name form = Scotty.request >>= \rq ->
    if requestMethod rq == methodGet
        then getForm name form >>= \v -> return (v, Nothing)
        else postForm name form $ const (return scottyEnv)