digestive-functors-snap 0.3.2.1 → 0.4.0.0

raw patch · 2 files changed

+25/−13 lines, 2 filesdep ~containersdep ~digestive-functors

Dependency ranges changed: containers, digestive-functors

Files

• digestive-functors-snap.cabal +3/−3
• src/Text/Digestive/Snap.hs +22/−10

@@ -1,5 +1,5 @@ Name:          digestive-functors-snap-Version:       0.3.2.1+Version:       0.4.0.0 Synopsis:      Snap backend for the digestive-functors library Description:   Snap backend for the digestive-functors library Homepage:      http://github.com/jaspervdj/digestive-functors@@ -18,8 +18,8 @@    Build-depends:     base               >= 4    && < 5,-    containers         >= 0.3  && < 0.5,-    digestive-functors >= 0.3  && < 0.4,+    containers         >= 0.3  && < 0.6,+    digestive-functors >= 0.4  && < 0.5,     snap-core          >= 0.7  && < 0.9,     text               >= 0.11 && < 0.12,     directory          >= 1.0  && < 1.2,

@@ -28,21 +28,25 @@ type SnapPartPolicy = Snap.PartInfo -> Snap.PartUploadPolicy  data SnapFormConfig = SnapFormConfig-    { temporaryDirectory :: Maybe FilePath+    { -- | Can be used to override the method detected by Snap, in case you e.g.+      -- want to perform a 'postForm' even in case of a GET request.+      method             :: Maybe Method+    , temporaryDirectory :: Maybe FilePath     , uploadPolicy       :: Snap.UploadPolicy     , partPolicy         :: SnapPartPolicy     }  defaultSnapFormConfig :: SnapFormConfig defaultSnapFormConfig = SnapFormConfig-    { temporaryDirectory = Nothing+    { method             = Nothing+    , temporaryDirectory = Nothing     , uploadPolicy       = Snap.defaultUploadPolicy     , partPolicy         = const $ Snap.allowWithMaximumSize (128 * 1024)     }  snapEnv :: Snap.MonadSnap m => [(Text, FilePath)] -> Env m snapEnv allFiles path = do-    inputs <- map (TextInput . T.decodeUtf8) . findParams <$> Snap.getPostParams+    inputs <- map (TextInput . T.decodeUtf8) . findParams <$> Snap.getParams     let files = map (FileInput . snd) $ filter ((== name) . fst) allFiles     return $ inputs ++ files   where@@ -72,7 +76,7 @@ -- | Runs a form with the HTTP input provided by Snap. -- -- Automatically picks between 'getForm' and 'postForm' based on the request--- method.+-- method. Set 'method' in the 'SnapFormConfig' to override this behaviour. runForm :: Snap.MonadSnap m         => Text                 -- ^ Name for the form         -> Form v m a           -- ^ Form to run@@ -82,17 +86,25 @@ -- | Runs a form with a custom upload policy, and HTTP input from snap. -- -- Automatically picks between 'getForm' and 'postForm' based on request--- method.+-- method. Set 'method' in the 'SnapFormConfig' to override this behaviour. runFormWith :: Snap.MonadSnap m             => SnapFormConfig       -- ^ Tempdir and upload policies             -> Text                 -- ^ Name for the form             -> Form v m a           -- ^ Form to run             -> m (View v, Maybe a)  -- ^ Result-runFormWith config name form = Snap.getRequest >>= \rq ->-    case Snap.rqMethod rq of-        Snap.GET -> return (getForm name form, Nothing)-        _        -> do-            files <- case formEncType form of+runFormWith config name form = do+    m <- maybe snapMethod return (method config)+    case m of+        Get  -> do+            view <- getForm name form+            return (view, Nothing)+        Post -> do+            encType <- formEncType form+            files   <- case encType of                 UrlEncoded -> return []                 MultiPart  -> snapFiles config             postForm name form (snapEnv files)+  where+    snapMethod        = toMethod . Snap.rqMethod <$> Snap.getRequest+    toMethod Snap.GET = Get+    toMethod _        = Post