fn-extra 0.3.0.1 → 0.3.0.2
raw patch · 4 files changed
+41/−40 lines, 4 filesdep +map-syntaxdep ~basenew-uploaderPVP ok
version bump matches the API change (PVP)
Dependencies added: map-syntax
Dependency ranges changed: base
API changes (from Hackage documentation)
Files
- CHANGELOG.md +5/−0
- fn-extra.cabal +3/−2
- src/Web/Fn/Extra/Digestive.hs +19/−33
- src/Web/Fn/Extra/Heist.hs +14/−5
CHANGELOG.md view
@@ -1,3 +1,8 @@+* 0.3.0.2 Libby Horacek <libby@positiondev.com> 2017-7-17++ - Don't send empty files to Digestive Functors.+ - Add support for Heist 1.0 and above.+ * 0.3.0.1 Daniel Patterson <dbp@dbpmail.net> 2016-3-11 - Change repository location, copyright.
fn-extra.cabal view
@@ -1,5 +1,5 @@ name: fn-extra-version: 0.3.0.1+version: 0.3.0.2 synopsis: Extras for Fn, a functional web framework. description: Please see README. homepage: http://github.com/positiondev/fn#readme@@ -18,7 +18,7 @@ hs-source-dirs: src exposed-modules: Web.Fn.Extra.Heist , Web.Fn.Extra.Digestive- build-depends: base >= 4.7 && < 5+ build-depends: base >= 4.7 && < 6 , heist , xmlhtml , http-types@@ -35,6 +35,7 @@ , either , digestive-functors , fn+ , map-syntax default-language: Haskell2010 ghc-options: -Wall
src/Web/Fn/Extra/Digestive.hs view
@@ -10,24 +10,21 @@ import Data.ByteString (ByteString) import Data.Maybe (fromMaybe) import Data.Text (Text)-import qualified Data.Text as T import qualified Data.Text.Encoding as T import Network.HTTP.Types.Method import Network.Wai (Request (..))-import Network.Wai.Parse (BackEnd, File, FileInfo (..),- fileContent, parseRequestBody,- tempFileBackEndOpts)-import System.Directory (getTemporaryDirectory)-import Text.Digestive-import Text.Digestive.Types-import Text.Digestive.View-import Web.Fn hiding (File, fileContent)+import Network.Wai.Parse (File, FileInfo (..), fileContent,+ parseRequestBody)+import Text.Digestive (Form, View, FormInput(..), Env, fromPath, postForm, getForm)+import Web.Fn hiding (File) queryFormEnv :: [(ByteString, Maybe ByteString)] -> [File FilePath] -> Env IO queryFormEnv qs fs = \pth ->- let qs' = map TextInput $ map (T.decodeUtf8 . fromMaybe "" . snd) $ filter ((==) (fromPath pth) . T.decodeUtf8 . fst) qs- fs' = map FileInput $ map (fileContent . snd) $ filter ((==) (fromPath pth) . T.decodeUtf8 . fst) fs+ let qs' = map (TextInput . T.decodeUtf8 . fromMaybe "" . snd) $ filter (forSubForm pth) qs+ fs' = map (FileInput . fileContent . snd) $ filter (forSubForm pth) $ filter fileNameNotEmpty fs in return $ qs' ++ fs'+ where fileNameNotEmpty (_formName, fileInfo) = Network.Wai.Parse.fileName fileInfo /= "\"\""+ forSubForm pth = (==) (fromPath pth) . T.decodeUtf8 . fst requestFormEnv :: FnRequest -> ResourceT IO (Env IO) requestFormEnv req = do@@ -39,36 +36,25 @@ case v of Nothing -> liftIO $ parseRequestBody (tempFileBackEnd' st) (fst req)- Just (q,_) -> return (q,[])- return $ queryFormEnv ((map (second Just) query) ++ queryString (fst req)) files--tempFileBackEnd' :: InternalState -> ignored1 -> FileInfo () -> IO ByteString -> IO FilePath-tempFileBackEnd' is x fi@(FileInfo nm _ _) = tempFileBackEndOpts getTemporaryDirectory (T.unpack $ T.decodeUtf8 nm) is x fi+ Just (q,_) -> return q+ return $ queryFormEnv (map (second Just) query ++ queryString (fst req)) files -- | This function runs a form and passes the function in it's last -- argument the result, which is a 'View' and an optional result. If -- the request is a get, or if the form failed to validate, the result -- will be 'Nothing' and you should render the form (with the errors -- from the 'View').------ WARNING: If you have already parsed the request body with '!=>'--- (even if the route didn't end up matching), this will _only_ get--- post parameters, it will not see any files that were posted. This--- is a current implementation limitation that will (hopefully) be--- resolved eventually, but for now, it is safest to just never use--- '!=>' if you are using digestive functors (as the expectation is--- that it will be handling all your POST needs!). runForm :: RequestContext ctxt =>- ctxt- -> Text- -> Form v IO a- -> ((View v, Maybe a) -> IO a1)- -> IO a1+ ctxt+ -> Text+ -> Form v IO a+ -> ((View v, Maybe a) -> IO a1)+ -> IO a1 runForm ctxt nm frm k = runResourceT $ let r = fst (getRequest ctxt) in if requestMethod r == methodPost then do env <- requestFormEnv (getRequest ctxt)- r <- liftIO $ postForm nm frm (const (return env))- liftIO $ k r- else do r <- (,Nothing) <$> liftIO (getForm nm frm)- liftIO $ k r+ r' <- liftIO $ postForm nm frm (const (return env))+ liftIO $ k r'+ else do r' <- (,Nothing) <$> liftIO (getForm nm frm)+ liftIO $ k r'
src/Web/Fn/Extra/Heist.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE CPP #-} {-| @@ -44,6 +45,9 @@ import Control.Lens import Control.Monad.State import Control.Monad.Trans.Either+#if MIN_VERSION_heist(1,0,0)+import Data.Map.Syntax ((##))+#endif import Data.Monoid import Data.Text (Text) import qualified Data.Text as T@@ -89,11 +93,16 @@ IO (Either [String] (FnHeistState ctxt)) heistInit templateLocations isplices csplices = do let ts = map (loadTemplates . T.unpack) templateLocations- runEitherT $ initHeist (emptyHeistConfig & hcTemplateLocations .~ ts- & hcInterpretedSplices .~ isplices- & hcLoadTimeSplices .~ defaultLoadTimeSplices- & hcCompiledSplices .~ csplices- & hcNamespace .~ "")+ let config = emptyHeistConfig & hcTemplateLocations .~ ts+ & hcInterpretedSplices .~ isplices+ & hcLoadTimeSplices .~ defaultLoadTimeSplices+ & hcCompiledSplices .~ csplices+ & hcNamespace .~ ""+#if MIN_VERSION_heist(1,0,0)+ initHeist config+#else+ runEitherT $ initHeist config+#endif -- | Render interpreted templates according to the request path. Note -- that if you have matched some parts of the path, those will not be