-- Preprocessor.hs
-- Copyright 2015 Remy E. Goldschmidt <taktoa@gmail.com>
-- This file is part of wai-middleware-preprocessor.
-- wai-middleware-preprocessor is free software: you can redistribute it and/or modify
-- it under the terms of the GNU General Public License as published by
-- the Free Software Foundation, either version 3 of the License, or
-- (at your option) any later version.
--
-- wai-middleware-preprocessor is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY-- without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-- GNU General Public License for more details.
--
-- You should have received a copy of the GNU General Public License
-- along with wai-middleware-preprocessor. If not, see <http://www.gnu.org/licenses/>.
-- | Serve files subject to a preprocessing function. This library makes it
-- easy to integrate Javascript or CSS preprocessors into a WAI application
-- that will compile the relevant files at runtime
module Network.Wai.Middleware.Preprocessor
( -- * Middleware
ppMiddleware, ppFileMiddleware
, -- * Preprocessors
Preprocessor, preprocessor, runPreprocessor, preprocess
, -- * Policies
Policy, (<|>), (>->), policy, predicate
, addBase, addSlash, contains, hasPrefix, hasSuffix, noDots, isNotAbsolute, only
, -- * Utilities
tryPolicy
) where
import Control.Monad (when)
import Control.Monad.Trans (liftIO)
import Data.Functor ((<$>))
import Data.List.Split (splitOn)
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.IO as TIO
import Network.Wai
import Network.Wai.Middleware.Static
import System.Directory (doesFileExist)
-- | Newtype wrapper for 'String's that represent file extensions
newtype Extension = Extension { fromExt :: String -- ^ Extract extension
}
-- | Preprocessors are comprised of an input file extension ('String'),
-- an output file extension ('String'), and a transforming function
-- ('Text' -> 'Maybe' 'Text')
newtype Preprocessor = PP { runPP :: (Extension, Extension, Text -> Maybe Text)
-- ^ Extract a preprocessor
}
-- | Constructor for a preprocessor.
preprocessor :: String -- ^ input extension
-> String -- ^ output extension
-> (Text -> Maybe Text) -- ^ transforming function
-> Preprocessor -- ^ preprocessor
preprocessor ei eo f = PP (Extension ei, Extension eo, f)
-- | Run the preprocessor on a given file
runPreprocessor :: Preprocessor -> FilePath -> IO ()
runPreprocessor pp fp = do
let (iext, oext, prepro) = runPP pp
when (fromExt oext == last (extensions fp))
(preprocess (replaceExt iext fp) fp prepro)
-- | Read in the input file, run through the preprocessor, and write it out
preprocess :: FilePath -> FilePath -> (Text -> Maybe Text) -> IO ()
preprocess ifp ofp pp = do
input <- maybeRead ifp
case input >>= pp of
Just o -> TIO.writeFile ofp o
Nothing -> return ()
-- | Lazily read in a file as 'Text' if the file exists
maybeRead :: FilePath -> IO (Maybe Text)
maybeRead fp = do
exists <- doesFileExist fp
if exists then Just <$> TIO.readFile fp else return Nothing
-- | Replace the file extension of a 'FilePath' with a given extension
replaceExt :: Extension -> FilePath -> FilePath
replaceExt ext fp = concatMap (++ ".") (init (extensions fp)) ++ fromExt ext
-- | Run a preprocessor on incoming requests
--
-- For example, if your preprocessor has input extension ".fay" and output
-- extension ".js" (and just does the identity function)
--
-- > ppMiddleware (preprocessor ".fay" ".js" (Just))
--
-- and a request to "index.js" goes through the generated middleware
--
-- > GET "/index.js"
--
-- If "index.js" exists, it does nothing
--
-- If "index.js" does not exist, it does the following:
--
-- If "index.fay" exists, it will read it in, run the function on its content,
-- and it will write the output to "index.js"
--
-- Otherwise, it will do nothing
--
-- Finally, in all cases, it will pass the request along
ppMiddleware :: Preprocessor -> Middleware
ppMiddleware pp app req callback = do
let fp = T.unpack $ T.intercalate "/" $ pathInfo req
exists <- liftIO $ doesFileExist fp
if exists
then app req callback
else liftIO (runPreprocessor pp fp) >> app req callback
-- | Preprocessor composed with static file server
--
-- This function is just the composition of staticPolicy from wai-middleware-static
-- and ppMiddleware. The policy creation functions from that library are also
-- exported from this library for ease of use.
ppFileMiddleware :: Policy -> Preprocessor -> Middleware
ppFileMiddleware pol pp = ppMiddleware pp . staticPolicy pol
-- | Split a 'FilePath' into period-delimited sections
extensions :: FilePath -> [String]
extensions = splitOn "."