digestive-functors-happstack 0.0.2.0 → 0.0.2.1

raw patch · 2 files changed

+34/−18 lines, 2 filesdep +textdep ~happstack-serverPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: text

Dependency ranges changed: happstack-server

API changes (from Hackage documentation)

Files

• digestive-functors-happstack.cabal +4/−3
• src/Text/Digestive/Forms/Happstack.hs +30/−15

@@ -1,5 +1,5 @@ Name:                digestive-functors-happstack-Version:             0.0.2.0+Version:             0.0.2.1 Synopsis:            Happstack backend for the digestive-functors library Description:         This is a happstack backend for the digestive-functors     library.@@ -19,6 +19,7 @@   Exposed-modules:   Text.Digestive.Forms.Happstack   Build-depends:     base >= 4 && < 5,                      digestive-functors == 0.0.2.*,-                     happstack-server >= 0.5 && < 0.6,+                     happstack-server >= 6.0 && < 6.1,                      utf8-string >= 0.3,-                     bytestring >= 0.9+                     bytestring >= 0.9,+                     text

@@ -1,37 +1,52 @@ -- | Module providing a happstack backend for the digestive-functors library -- {-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}+{-# OPTIONS_GHC -fno-warn-orphans #-} module Text.Digestive.Forms.Happstack     ( HappstackForm     , happstackEnvironment     , eitherHappstackForm     ) where -import Control.Monad (liftM)+import Control.Monad (MonadPlus, liftM)+import Control.Applicative (Alternative, optional) -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 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, LB.ByteString) where-    getInputString = Just . LB.toString . inputValue-    getInputFile inp = do-        inputFilename' <- inputFilename inp-        return (inputFilename', inputValue inp)+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+ -- | Simplification of the `Form` type, instantiated to Happstack ---type HappstackForm m e v a = Form (ServerPartT m) Input e v a+type HappstackForm m e v a = Form m Input e v a  -- | Environment that will fetch input from the parameters parsed by Happstack ---happstackEnvironment :: (Monad m) => Environment (ServerPartT m) Input-happstackEnvironment = Environment $ getDataFn . lookInput . show+happstackEnvironment :: (HasRqData m, MonadPlus m, Alternative m)+                     => Environment m Input+happstackEnvironment = Environment $ optional . lookInput . show  -- | Run a happstack form --@@ -42,10 +57,10 @@ --   used. When errors occur, you will receive the form as a view, otherwise, --   you will get the actual result ---eitherHappstackForm :: (Monad m, Functor m)+eitherHappstackForm :: (HasRqData m, MonadPlus m, Alternative m, ServerMonad m)                     => HappstackForm m e v a       -- ^ Form                     -> String                      -- ^ Form name-                    -> ServerPartT m (Either v a)  -- ^ Result-eitherHappstackForm form name = withRequest $ \rq -> flip runServerPartT rq $+                    -> m (Either v a)              -- ^ Result+eitherHappstackForm form name = askRq >>= \rq ->     case rqMethod rq of GET -> liftM Left $ viewForm form name                         _   -> eitherForm form name happstackEnvironment