module Text.Digestive.Forms.Happstack
( HappstackForm
, happstackEnvironment
, eitherHappstackForm
) where
import Control.Monad (MonadPlus, liftM)
import Control.Applicative (Alternative, optional)
import Data.ByteString.Lazy.UTF8 as LB (toString)
import Data.Text.Lazy as Text (toStrict)
import Data.Text.Lazy.Encoding as Text (decodeUtf8)
import Happstack.Server ( Input (..), HasRqData (..), lookInput
, Method (..), ServerMonad (..), rqMethod
)
import Text.Digestive.Forms (FormInput (..))
import Text.Digestive.Types (Form (..), Environment (..), viewForm, eitherForm)
instance FormInput Input (String, FilePath) where
getInputString inp =
case inputValue inp of
(Right bs) -> Just . LB.toString $ bs
_ -> Nothing
getInputText inp =
case inputValue inp of
(Right bs) -> Just . Text.toStrict . Text.decodeUtf8 $ bs
_ -> Nothing
getInputFile inp =
case inputValue inp of
(Left fp) ->
do fn <- inputFilename inp
return (fn, fp)
_ -> Nothing
type HappstackForm m e v a = Form m Input e v a
happstackEnvironment :: (HasRqData m, MonadPlus m, Alternative m)
=> Environment m Input
happstackEnvironment = Environment $ optional . lookInput . show
eitherHappstackForm :: (HasRqData m, MonadPlus m, Alternative m, ServerMonad m)
=> HappstackForm m e v a
-> String
-> m (Either v a)
eitherHappstackForm form name = askRq >>= \rq ->
case rqMethod rq of GET -> liftM Left $ viewForm form name
_ -> eitherForm form name happstackEnvironment