module Text.Digestive.Forms.Happstack
( HappstackForm
, happstackEnvironment
, eitherHappstackForm
) where
import Control.Monad (liftM)
import Data.ByteString.Lazy as LB
import Data.ByteString.Lazy.UTF8 as LB (toString)
import Happstack.Server ( Input (..), ServerPartT, getDataFn, lookInput
, Method (..), withRequest, runServerPartT, rqMethod
)
import Text.Digestive.Forms (FormInput (..))
import Text.Digestive.Types (Form (..), Environment (..), viewForm, eitherForm)
instance FormInput Input (String, LB.ByteString) where
getInputString = Just . LB.toString . inputValue
getInputFile inp = do
inputFilename' <- inputFilename inp
return (inputFilename', inputValue inp)
type HappstackForm m e v a = Form (ServerPartT m) Input e v a
happstackEnvironment :: (Monad m) => Environment (ServerPartT m) Input
happstackEnvironment = Environment $ getDataFn . lookInput . show
eitherHappstackForm :: (Monad m, Functor m)
=> HappstackForm m e v a
-> String
-> ServerPartT m (Either v a)
eitherHappstackForm form name = withRequest $ \rq -> flip runServerPartT rq $
case rqMethod rq of GET -> liftM Left $ viewForm form name
_ -> eitherForm form name happstackEnvironment