module Text.Digestive.Forms.Snap
( SnapInput
, SnapForm
, snapEnvironment
, eitherSnapForm
, runViewSnapForm
) where
import Control.Applicative ((<$>))
import Control.Monad (liftM)
import Data.ByteString as SB
import Data.ByteString.UTF8 as SB (toString, fromString)
import Snap.Types
import Text.Digestive.Forms (FormInput (..))
import Text.Digestive.Types (Form (..), Environment (..), viewForm, runViewForm, eitherForm)
newtype SnapInput = SnapInput {unSnapInput :: SB.ByteString}
instance FormInput SnapInput () where
getInputStrings = return . SB.toString . unSnapInput
getInputFile = const Nothing
type SnapForm m = Form m SnapInput
snapEnvironment :: (MonadSnap m) => Environment m SnapInput
snapEnvironment = Environment $ \id' -> do
input' <- getParam (SB.fromString $ show id')
return $ SnapInput <$> input'
eitherSnapForm :: (MonadSnap m)
=> SnapForm m e v a
-> String
-> m (Either v a)
eitherSnapForm form name = do
method' <- rqMethod <$> getRequest
case method' of GET -> liftM Left $ viewForm form name
_ -> eitherForm form name snapEnvironment
runViewSnapForm :: (MonadSnap m)
=> SnapForm m e v a
-> String
-> m (v, Maybe a)
runViewSnapForm form name = runViewForm form name snapEnvironment