packages feed

herringbone 0.0.1 → 0.0.2

raw patch · 15 files changed

+526/−524 lines, 15 files

Files

− Network/Wai/Herringbone.hs 
@@ -1,51 +0,0 @@-{- |-wai-herringbone is a Haskell/Wai library for compiling and serving web assets.-It aims to make it dead simple to create a 'Network.Wai.Middleware' or-'Network.Wai.Application' which deals with all of your static assets, including-preprocessing for languages like Fay, CoffeeScript, Sass, and LESS.--It takes most of its inspiration from the Ruby library,-<https://github.com/sstephenson/sprockets Sprockets>, hence the name.--Example:--> import Network.Wai.Herringbone->-> fay, sass :: PP->-> hb = Herringbone-> hb = herringbone->     ( addSourceDir "assets"->     . setDestDir   "compiled_assets"->     . addPreprocessors [fay, sass]->     )->-> -- You can now access assets programmatically-> asset <- findAsset hb (makeLogicalPath ["application.js"])->-> -- Or make a WAI Application to do it for you-> app = toApplication hb--}-module Network.Wai.Herringbone (-    -- * Creating a Herringbone-    Herringbone(..),-    module Network.Wai.Herringbone.Configuration,-    -- * Assets-    LogicalPath,-    fromLogicalPath,-    toFilePath,-    Asset(..),-    findAsset,-    -- * Preprocessors-    PP(..),-    PPs,-    AssetError(..),-    CompileError,-    -- * WAI-    toApplication-) where--import Network.Wai.Herringbone.Configuration-import Network.Wai.Herringbone.Types-import Network.Wai.Herringbone.FindAsset-import Network.Wai.Herringbone.WaiAdapter
− Network/Wai/Herringbone/BuildAsset.hs 
@@ -1,71 +0,0 @@-{-# LANGUAGE RankNTypes #-}--- | This module contains functions to build assets (that is, run preprocessing--- if necessary, and copy to destination directory).-module Network.Wai.Herringbone.BuildAsset where--import Data.Time-import Filesystem.Path.CurrentOS (FilePath, (</>))-import qualified Filesystem as F-import Prelude hiding (FilePath)--import Network.Wai.Herringbone.Types---- | Build an asset to produce a 'Asset'. This action checks whether the--- compilation is necessary based on the modified times of the source and--- destination files.-buildAsset :: Herringbone-           -> LogicalPath -- ^ Logical path of asset to build-           -> FilePath    -- ^ Source file path-           -> [PP]        -- ^ List of preprocessors to run-           -> IO (Either CompileError Asset)-buildAsset hb logPath sourcePath pps = do-    let destPath = hbDestDir hb </> toFilePath logPath--    sourceModifiedTime <- F.getModified sourcePath-    compileNeeded <- shouldCompile sourceModifiedTime destPath--    result <- if compileNeeded-                then compileAsset sourcePath destPath pps-                else return $ Right ()--    either (return . Left)-           (\_ -> do size <- F.getSize destPath-                     return . Right $ Asset-                                        size-                                        sourcePath-                                        destPath-                                        logPath-                                        sourceModifiedTime)-           result---- | Should we compile an asset? True if either the asset doesn't exist, or if--- its modified time is older than the supplied source modification time.-shouldCompile :: UTCTime -> FilePath -> IO Bool-shouldCompile sourceModifiedTime destPath = do-    exists <- F.isFile destPath-    if not exists-        then return True-        else do-            destModifiedTime <- F.getModified destPath-            return $ sourceModifiedTime > destModifiedTime---- | Compile the given asset by invoking any preprocessors on the source path,--- and copying the result to the destination path.-compileAsset :: FilePath -- ^ Source path-             -> FilePath -- ^ Dest path-             -> [PP]     -- ^ List of preprocessors to apply-             -> IO (Either CompileError ())-compileAsset sourcePath destPath pps = do-    sourceData <- F.readFile sourcePath--    result <- chainEither (map ppAction pps) sourceData-    either (return . Left)-           (\resultData -> do F.writeFile destPath resultData-                              return (Right ()))-           result--chainEither :: Monad m => [a -> m (Either b a)] -> a -> m (Either b a)-chainEither fs m = foldl go z fs-    where-        go = \acc f -> acc >>= either (return . Left) f-        z  = return (Right m)
− Network/Wai/Herringbone/Configuration.hs 
@@ -1,31 +0,0 @@-module Network.Wai.Herringbone.Configuration where--import Network.Wai.Herringbone.Types-import Filesystem.Path.CurrentOS (FilePath)-import Prelude hiding (FilePath)---- | Preferred way of creating 'Herringbone' instances.-herringbone :: ConfigBuilder -> Herringbone-herringbone builder = builder defaultHerringbone--type ConfigBuilder = Herringbone -> Herringbone---- | Adds a directory to the list of source directories.-addSourceDir :: FilePath -> ConfigBuilder-addSourceDir dir hb = hb { hbSourceDirs = dir : hbSourceDirs hb }---- | Sets the destination directory. Note that this will overwrite the--- destination directory if one is already set.-setDestDir :: FilePath -> ConfigBuilder-setDestDir dir hb = hb { hbDestDir = dir }---- | Add the preprocessors in the list to the preprocessor collection.-addPreprocessors :: [PP] -> ConfigBuilder-addPreprocessors ppList hb = hb { hbPPs = insertAllPPs ppList (hbPPs hb) }--defaultHerringbone :: Herringbone-defaultHerringbone = Herringbone-    { hbSourceDirs = []-    , hbDestDir    = error "herringbone: destination dir must be specified"-    , hbPPs        = noPPs-    }
− Network/Wai/Herringbone/FindAsset.hs 
@@ -1,30 +0,0 @@-module Network.Wai.Herringbone.FindAsset where--import Network.Wai.Herringbone.LocateAssets-import Network.Wai.Herringbone.BuildAsset-import Network.Wai.Herringbone.Types-import Prelude hiding (FilePath)-import Filesystem.Path.CurrentOS (FilePath)--findAsset :: Herringbone-          -> LogicalPath-          -> IO (Either AssetError Asset)-findAsset hb path = do-    assets <- locateAssets hb path-    case assets of-        []               -> return . Left $ AssetNotFound-        [(srcPath, pps)] -> buildAsset' hb path srcPath pps-        xs               -> return . Left $ AmbiguousSources (map fst xs)--buildAsset' :: Herringbone-            -> LogicalPath-            -> FilePath-            -> [PP]-            -> IO (Either AssetError Asset)-buildAsset' hb path srcPath pps = do-    result <- buildAsset hb path srcPath pps-    return $ mapLeft AssetCompileError result-    where-    mapLeft :: (a -> b) -> Either a r -> Either b r-    mapLeft f (Left x)  = Left $ f x-    mapLeft _ (Right x) = Right x
− Network/Wai/Herringbone/LocateAssets.hs 
@@ -1,89 +0,0 @@--- | This module deals with locating assets on the disk, and calculating how to--- create assets which need preprocessing.-module Network.Wai.Herringbone.LocateAssets where--import Data.Maybe-import Data.Text (Text)-import Filesystem.Path.CurrentOS (FilePath, (</>))-import qualified Filesystem.Path.CurrentOS as F-import qualified Filesystem as F-import Prelude hiding (FilePath)--import Network.Wai.Herringbone.Types--locateAssets :: Herringbone -> LogicalPath -> IO [(FilePath, [PP])]-locateAssets hb logPath = do-    let sourceDirs = hbSourceDirs hb-    let pps        = hbPPs hb-    let pathPieces = fromLogicalPath logPath-    assets <- sequence $ map (getAssetsFrom pps pathPieces) sourceDirs-    return $ concat assets--getAssetsFrom :: PPs-              -> [Text]      -- ^ requested path pieces-              -> FilePath    -- ^ Directory to look in-              -> IO [(FilePath, [PP])]-getAssetsFrom _   []          _    = return []-getAssetsFrom pps pathPieces' dir' = do-    let pathPieces        = map F.fromText pathPieces'-    let dir               = foldl (</>) dir' (init pathPieces)-    let assetName         = last pathPieces--    exists <- F.isDirectory dir-    if exists-        then do contents <- F.listDirectory dir-                let filenames = getAssetsFrom'-                                    pps-                                    assetName-                                    (map F.filename contents)-                return $ map (\(path, xs) -> (dir </> path, xs)) filenames-        else return []---- Given a list of preprocessors, the path of an asset we want to serve, and--- a list of potential source files, return a list of all the files which could--- be used as a source for that file, together with the preprocessors which--- would need to be applied (in the correct order) to preprocess that file.------ For example, given preprocessors for "sass" and "erb", the asset path--- "style.css", and the following list of potential files:------  "style.css"---  "style.css.sass"---  "style.css.sass.erb"---  "style.css.unrecognised-ext"---  "javascript.js"------ we should get back:------  [ ("style.css", [])---  , ("style.css.sass", [sass])---  , ("style.css.sass.erb", [erb, sass])---  ]-getAssetsFrom' :: PPs-               -> FilePath      -- ^ Asset to serve-               -> [FilePath]    -- ^ Potential source files-               -> [(FilePath, [PP])]-getAssetsFrom' pps assetPath = catMaybes . map resolve-    where-    resolve :: FilePath -> Maybe (FilePath, [PP])-    resolve fp = fmap (\xs -> (fp, xs)) $ (resolvePPs pps assetPath fp)---- Can we apply a sequence of the given preprocessors to the given source file--- path to get the given asset? If so, return the list of preprocessors which--- should be applied to it to make this happen.-resolvePPs :: PPs -> FilePath -> FilePath -> Maybe [PP]-resolvePPs pps assetPath source = do-    exts   <- getExtraExtensions assetPath source-    ppList <- sequence $ map (\e -> lookupPP e pps) exts-    return ppList---- Check if a file path is formed from another file path plus a list of--- extensions, and if so, return those extensions, in reverse order.--- Eg:---  getExtraExtensions "game.js" "game.js.coffee"     == Just ["coffee"]---  getExtraExtensions "style.css" "game.js.coffee"   == Nothing---  getExtraExtensions "game.js" "game.js.coffee.erb" == Just ["erb", "coffee"]-getExtraExtensions :: FilePath -> FilePath -> Maybe [Text]-getExtraExtensions fp fpWithExts = do-    stripped <- F.stripPrefix fp fpWithExts-    return $ (reverse . F.extensions) stripped
− Network/Wai/Herringbone/Types.hs 
@@ -1,149 +0,0 @@-module Network.Wai.Herringbone.Types where--import Data.Char-import Data.Time.Clock-import Data.Time.Format-import System.Locale-import Data.Text (Text)-import qualified Data.Map as M-import qualified Data.ByteString as B-import qualified Data.ByteString.Lazy as BL-import qualified Filesystem.Path.CurrentOS as F-import Filesystem.Path.CurrentOS (FilePath)-import Prelude hiding (FilePath)--class ToLazyByteString a where-    toLazyByteString :: a -> BL.ByteString--instance ToLazyByteString String where-    toLazyByteString = BL.pack . map (fromIntegral . ord)--instance ToLazyByteString FilePath where-    toLazyByteString = toLazyByteString . F.encode--instance ToLazyByteString B.ByteString where-    toLazyByteString = BL.fromChunks . (: [])--data AssetError = AssetNotFound-                | AssetCompileError CompileError-                | AmbiguousSources [FilePath]-                deriving (Show, Eq)---- | A string which should contain information about why an asset failed to--- compile.-type CompileError = B.ByteString---- | A preprocessor something which is run on the asset before it is served.--- Preprocessors are run when a file extension matches the preprocessor--- extension. For example, if you have a preprocessor for \"coffee\" files, you--- request \"application.js\", and there is a file named--- \"application.js.coffee\", Herringbone will run the coffee preprocessor on--- that file and serve you the result.------ You can add more preprocessors by adding more file extensions;--- \"application.js.coffee.erb\" will be preprocessed first by \"erb\", then by--- \"coffee\" (assuming you have registered preprocessors for those files).-data PP = PP-    { ppExtension :: Text-    -- ^ The file extension this preprocessor acts upon, eg \"sass\" or-    -- \"hamlet\"-    , ppAction    :: B.ByteString -> IO (Either CompileError B.ByteString)-    -- ^ Perform the preprocessing.-    }--instance Show PP where-    show pp = "<PP: " ++ show (ppExtension pp) ++ ">"---- | Beware: This instance is only here for testing. It only looks at the--- extensions to decide whether two 'PP's are equal. Don't use this!-instance Eq PP where-    (PP ext1 _) == (PP ext2 _) = ext1 == ext2--instance Ord PP where-    compare (PP ext1 _) (PP ext2 _) = compare ext1 ext2---- | A collection of preprocessors.-newtype PPs = PPs { unPPs :: M.Map Text PP }-    deriving (Show)--noPPs :: PPs-noPPs = PPs M.empty--supportedBy :: PPs -> Text -> Bool-supportedBy pps = flip M.member (unPPs pps)--supportedExts :: PPs -> [Text]-supportedExts = M.keys . unPPs--insertPP :: PP -> PPs -> PPs-insertPP pp = PPs . M.insert (ppExtension pp) pp . unPPs--lookupPP :: Text -> PPs -> Maybe PP-lookupPP ext = M.lookup ext . unPPs--fromList :: [PP] -> PPs-fromList ppList = insertAllPPs ppList noPPs--insertAllPPs :: [PP] -> PPs -> PPs-insertAllPPs ppList pps = foldr insertPP pps ppList---- | The \'main\' datatype in this library. Just a container for the--- configuration. All of the important functions will take a 'Herringbone' as--- their first argument.-data Herringbone = Herringbone-    { hbSourceDirs :: [FilePath]-    -- ^ A list of source directories; this is where assets should be placed.-    , hbDestDir    :: FilePath-    -- ^ Where to copy assets to after they've been compiled.-    , hbPPs        :: PPs-    -- ^ Preprocessors-    }-    deriving (Show)---- | All assets in Herringbone are referenced by their logical path. This is--- the path to an asset, relative to any of the source directories.-newtype LogicalPath = LogicalPath { fromLogicalPath :: [Text] }-    deriving (Show)---- | Create a LogicalPath from a list of Text values. This returns Nothing if--- the path would be unsafe (that is, if it contains \"..\"), to prevent--- directory traversal attacks.-makeLogicalPath :: [Text] -> Maybe LogicalPath-makeLogicalPath xs = if safe xs then Just $ LogicalPath xs else Nothing-    where-        safe = all (not . (==) "..")---- | Create a LogicalPath without checking any of the values.-unsafeMakeLogicalPath :: [Text] -> LogicalPath-unsafeMakeLogicalPath = LogicalPath--toFilePath :: LogicalPath -> FilePath-toFilePath = F.concat . map F.fromText . fromLogicalPath---- | A preprocessed asset. Any function that returns this will already have--- done the preprocessing (if necessary).-data Asset = Asset-    { assetSize         :: Integer-    -- ^ Size of the asset in bytes.-    , assetSourcePath   :: FilePath-    -- ^ Path to the asset's source file on disk.-    , assetFilePath     :: FilePath-    -- ^ Path to the preprocessed asset on disk. Note that assets which do not-    -- require preprocessing will still be copied to the destination directory.-    , assetLogicalPath  :: LogicalPath-    -- ^ The logical path referencing this asset.-    , assetModifiedTime :: UTCTime-    -- ^ Modification time of the asset's source file.-    }--instance Show Asset where-    show (Asset size sourcePath filePath logicalPath modifiedTime) =-        "BundledAsset { " ++-        "assetSize = " ++ show size ++ ", " ++-        "assetSourcePath = " ++ show sourcePath ++ ", " ++-        "assetFilePath = " ++ show filePath ++ ", " ++-        "assetLogicalPath = " ++ show logicalPath ++ ", " ++-        "assetModifiedTime = " ++ showTime modifiedTime ++ " }"--        where-        showTime = formatTime defaultTimeLocale (dateTimeFmt defaultTimeLocale)
− Network/Wai/Herringbone/WaiAdapter.hs 
@@ -1,93 +0,0 @@-module Network.Wai.Herringbone.WaiAdapter where--import Control.Monad-import qualified Data.ByteString.Lazy as BL-import Data.Time-import Data.Time.Clock.POSIX-import System.Posix.Types (EpochTime)-import Data.Monoid-import Data.List-import Data.Maybe-import Network.Wai-import Network.Wai.Application.Static-import WaiAppStatic.Types-import Network.HTTP.Types-import Prelude hiding (FilePath)-import Filesystem.Path.CurrentOS (FilePath)-import qualified Filesystem.Path.CurrentOS as F-import qualified Filesystem as F--import Network.Wai.Herringbone.FindAsset-import Network.Wai.Herringbone.Types---- | Convert a 'Herringbone' to a WAI 'Application'.-toApplication :: Herringbone -> Application-toApplication hb@(Herringbone { hbDestDir = dest }) =-    staticApp $ (defaultWebAppSettings dest) { ssLookupFile = lookupFile hb }--lookupFile :: Herringbone -> Pieces -> IO LookupResult-lookupFile hb pieces = do-    asset <- findAsset hb (toLogicalPath pieces)-    either assetErrorToLR bundledAssetToLR asset--    where-    assetErrorToLR = return . go--    go AssetNotFound           = LRNotFound-    go (AssetCompileError err) = LRFile . assetCompileError $ err-    go (AmbiguousSources xs)   = LRFile . ambiguousSources $ xs--    bundledAssetToLR asset = do-        file <- toFile (assetSourcePath asset)-                       (assetFilePath asset)-                       (last pieces)-        return . LRFile $ file--toLogicalPath :: Pieces -> LogicalPath-toLogicalPath = LogicalPath . map fromPiece---- This is just given to wai-app-static which takes care of serving it.-toFile :: FilePath -- ^ source path-       -> FilePath -- ^ dest path-       -> Piece    -- ^ file name-       -> IO File-toFile source dest name = do-    size  <- F.getSize dest-    mtime <- F.getModified source-    let strDest = F.encodeString dest-    return File-        { fileGetSize     = fromIntegral size-        , fileToResponse  = \s h -> responseFile s h strDest Nothing-        , fileName        = name-        , fileGetHash     = return Nothing -- TODO-        , fileGetModified = Just . toEpochTime $ mtime-        }--toEpochTime :: UTCTime -> EpochTime-toEpochTime = fromIntegral . toSecs-    where-    toSecs :: UTCTime -> Int-    toSecs = floor . utcTimeToPOSIXSeconds--assetCompileError :: CompileError -> File-assetCompileError err =-    fileError (toLazyByteString err) (unsafeToPiece "compile-error.html")--ambiguousSources :: [FilePath] -> File-ambiguousSources sources =-    let body = "<h1>Ambiguous asset source</h1>" <>-                "<p>List of possible asset sources:</p>" <>-                "<ul>" <>-                BL.concat (map (\s -> "<li>" <> toLazyByteString s <> "</li>") sources) <>-                "</ul>"-    in fileError body (unsafeToPiece "error-ambiguous-source.html")--fileError :: BL.ByteString -> Piece -> File-fileError body name =-    File-        { fileGetSize     = fromIntegral $ BL.length body-        , fileToResponse  = \_ headers -> responseLBS status500 headers body-        , fileName        = name-        , fileGetHash     = return Nothing-        , fileGetModified = Nothing-        }
+ Web/Herringbone.hs view
@@ -0,0 +1,51 @@+{- |+wai-herringbone is a Haskell/Wai library for compiling and serving web assets.+It aims to make it dead simple to create a 'Network.Wai.Middleware' or+'Network.Wai.Application' which deals with all of your static assets, including+preprocessing for languages like Fay, CoffeeScript, Sass, and LESS.++It takes most of its inspiration from the Ruby library,+<https://github.com/sstephenson/sprockets Sprockets>, hence the name.++Example:++> import Web.Herringbone+>+> fay, sass :: PP+>+> hb = Herringbone+> hb = herringbone+>     ( addSourceDir "assets"+>     . setDestDir   "compiled_assets"+>     . addPreprocessors [fay, sass]+>     )+>+> -- You can now access assets programmatically+> asset <- findAsset hb (makeLogicalPath ["application.js"])+>+> -- Or make a WAI Application to do it for you+> app = toApplication hb+-}+module Web.Herringbone (+    -- * Creating a Herringbone+    Herringbone(..),+    module Web.Herringbone.Configuration,+    -- * Assets+    LogicalPath,+    fromLogicalPath,+    toFilePath,+    Asset(..),+    findAsset,+    -- * Preprocessors+    PP(..),+    PPs,+    AssetError(..),+    CompileError,+    -- * WAI+    toApplication+) where++import Web.Herringbone.Configuration+import Web.Herringbone.Types+import Web.Herringbone.FindAsset+import Web.Herringbone.Adapter.Wai
+ Web/Herringbone/Adapter/Wai.hs view
@@ -0,0 +1,93 @@+module Web.Herringbone.Adapter.Wai where++import Control.Monad+import qualified Data.ByteString.Lazy as BL+import Data.Time+import Data.Time.Clock.POSIX+import System.Posix.Types (EpochTime)+import Data.Monoid+import Data.List+import Data.Maybe+import Network.Wai+import Network.Wai.Application.Static+import WaiAppStatic.Types+import Network.HTTP.Types+import Prelude hiding (FilePath)+import Filesystem.Path.CurrentOS (FilePath)+import qualified Filesystem.Path.CurrentOS as F+import qualified Filesystem as F++import Web.Herringbone.FindAsset+import Web.Herringbone.Types++-- | Convert a 'Herringbone' to a WAI 'Application'.+toApplication :: Herringbone -> Application+toApplication hb@(Herringbone { hbDestDir = dest }) =+    staticApp $ (defaultWebAppSettings dest) { ssLookupFile = lookupFile hb }++lookupFile :: Herringbone -> Pieces -> IO LookupResult+lookupFile hb pieces = do+    asset <- findAsset hb (toLogicalPath pieces)+    either assetErrorToLR bundledAssetToLR asset++    where+    assetErrorToLR = return . go++    go AssetNotFound           = LRNotFound+    go (AssetCompileError err) = LRFile . assetCompileError $ err+    go (AmbiguousSources xs)   = LRFile . ambiguousSources $ xs++    bundledAssetToLR asset = do+        file <- toFile (assetSourcePath asset)+                       (assetFilePath asset)+                       (last pieces)+        return . LRFile $ file++toLogicalPath :: Pieces -> LogicalPath+toLogicalPath = LogicalPath . map fromPiece++-- This is just given to wai-app-static which takes care of serving it.+toFile :: FilePath -- ^ source path+       -> FilePath -- ^ dest path+       -> Piece    -- ^ file name+       -> IO File+toFile source dest name = do+    size  <- F.getSize dest+    mtime <- F.getModified source+    let strDest = F.encodeString dest+    return File+        { fileGetSize     = fromIntegral size+        , fileToResponse  = \s h -> responseFile s h strDest Nothing+        , fileName        = name+        , fileGetHash     = return Nothing -- TODO+        , fileGetModified = Just . toEpochTime $ mtime+        }++toEpochTime :: UTCTime -> EpochTime+toEpochTime = fromIntegral . toSecs+    where+    toSecs :: UTCTime -> Int+    toSecs = floor . utcTimeToPOSIXSeconds++assetCompileError :: CompileError -> File+assetCompileError err =+    fileError (toLazyByteString err) (unsafeToPiece "compile-error.html")++ambiguousSources :: [FilePath] -> File+ambiguousSources sources =+    let body = "<h1>Ambiguous asset source</h1>" <>+                "<p>List of possible asset sources:</p>" <>+                "<ul>" <>+                BL.concat (map (\s -> "<li>" <> toLazyByteString s <> "</li>") sources) <>+                "</ul>"+    in fileError body (unsafeToPiece "error-ambiguous-source.html")++fileError :: BL.ByteString -> Piece -> File+fileError body name =+    File+        { fileGetSize     = fromIntegral $ BL.length body+        , fileToResponse  = \_ headers -> responseLBS status500 headers body+        , fileName        = name+        , fileGetHash     = return Nothing+        , fileGetModified = Nothing+        }
+ Web/Herringbone/BuildAsset.hs view
@@ -0,0 +1,70 @@+-- | This module contains functions to build assets (that is, run preprocessing+-- if necessary, and copy to destination directory).+module Web.Herringbone.BuildAsset where++import Data.Time+import Filesystem.Path.CurrentOS (FilePath, (</>))+import qualified Filesystem as F+import Prelude hiding (FilePath)++import Web.Herringbone.Types++-- | Build an asset to produce a 'Asset'. This action checks whether the+-- compilation is necessary based on the modified times of the source and+-- destination files.+buildAsset :: Herringbone+           -> LogicalPath -- ^ Logical path of asset to build+           -> FilePath    -- ^ Source file path+           -> [PP]        -- ^ List of preprocessors to run+           -> IO (Either CompileError Asset)+buildAsset hb logPath sourcePath pps = do+    let destPath = hbDestDir hb </> toFilePath logPath++    sourceModifiedTime <- F.getModified sourcePath+    compileNeeded <- shouldCompile sourceModifiedTime destPath++    result <- if compileNeeded+                then compileAsset sourcePath destPath pps+                else return $ Right ()++    either (return . Left)+           (\_ -> do size <- F.getSize destPath+                     return . Right $ Asset+                                        size+                                        sourcePath+                                        destPath+                                        logPath+                                        sourceModifiedTime)+           result++-- | Should we compile an asset? True if either the asset doesn't exist, or if+-- its modified time is older than the supplied source modification time.+shouldCompile :: UTCTime -> FilePath -> IO Bool+shouldCompile sourceModifiedTime destPath = do+    exists <- F.isFile destPath+    if not exists+        then return True+        else do+            destModifiedTime <- F.getModified destPath+            return $ sourceModifiedTime > destModifiedTime++-- | Compile the given asset by invoking any preprocessors on the source path,+-- and copying the result to the destination path.+compileAsset :: FilePath -- ^ Source path+             -> FilePath -- ^ Dest path+             -> [PP]     -- ^ List of preprocessors to apply+             -> IO (Either CompileError ())+compileAsset sourcePath destPath pps = do+    sourceData <- F.readFile sourcePath++    result <- chainEither (map ppAction pps) sourceData+    either (return . Left)+           (\resultData -> do F.writeFile destPath resultData+                              return (Right ()))+           result++chainEither :: Monad m => [a -> m (Either b a)] -> a -> m (Either b a)+chainEither fs m = foldl go z fs+    where+        go = \acc f -> acc >>= either (return . Left) f+        z  = return (Right m)
+ Web/Herringbone/Configuration.hs view
@@ -0,0 +1,31 @@+module Web.Herringbone.Configuration where++import Web.Herringbone.Types+import Filesystem.Path.CurrentOS (FilePath)+import Prelude hiding (FilePath)++-- | Preferred way of creating 'Herringbone' instances.+herringbone :: ConfigBuilder -> Herringbone+herringbone builder = builder defaultHerringbone++type ConfigBuilder = Herringbone -> Herringbone++-- | Adds a directory to the list of source directories.+addSourceDir :: FilePath -> ConfigBuilder+addSourceDir dir hb = hb { hbSourceDirs = dir : hbSourceDirs hb }++-- | Sets the destination directory. Note that this will overwrite the+-- destination directory if one is already set.+setDestDir :: FilePath -> ConfigBuilder+setDestDir dir hb = hb { hbDestDir = dir }++-- | Add the preprocessors in the list to the preprocessor collection.+addPreprocessors :: [PP] -> ConfigBuilder+addPreprocessors ppList hb = hb { hbPPs = insertAllPPs ppList (hbPPs hb) }++defaultHerringbone :: Herringbone+defaultHerringbone = Herringbone+    { hbSourceDirs = []+    , hbDestDir    = error "herringbone: destination dir must be specified"+    , hbPPs        = noPPs+    }
+ Web/Herringbone/FindAsset.hs view
@@ -0,0 +1,31 @@+module Web.Herringbone.FindAsset where++import Prelude hiding (FilePath)+import Filesystem.Path.CurrentOS (FilePath)++import Web.Herringbone.LocateAssets+import Web.Herringbone.BuildAsset+import Web.Herringbone.Types++findAsset :: Herringbone+          -> LogicalPath+          -> IO (Either AssetError Asset)+findAsset hb path = do+    assets <- locateAssets hb path+    case assets of+        []               -> return . Left $ AssetNotFound+        [(srcPath, pps)] -> buildAsset' hb path srcPath pps+        xs               -> return . Left $ AmbiguousSources (map fst xs)++buildAsset' :: Herringbone+            -> LogicalPath+            -> FilePath+            -> [PP]+            -> IO (Either AssetError Asset)+buildAsset' hb path srcPath pps = do+    result <- buildAsset hb path srcPath pps+    return $ mapLeft AssetCompileError result+    where+    mapLeft :: (a -> b) -> Either a r -> Either b r+    mapLeft f (Left x)  = Left $ f x+    mapLeft _ (Right x) = Right x
+ Web/Herringbone/LocateAssets.hs view
@@ -0,0 +1,89 @@+-- | This module deals with locating assets on the disk, and calculating how to+-- create assets which need preprocessing.+module Web.Herringbone.LocateAssets where++import Data.Maybe+import Data.Text (Text)+import Filesystem.Path.CurrentOS (FilePath, (</>))+import qualified Filesystem.Path.CurrentOS as F+import qualified Filesystem as F+import Prelude hiding (FilePath)++import Web.Herringbone.Types++locateAssets :: Herringbone -> LogicalPath -> IO [(FilePath, [PP])]+locateAssets hb logPath = do+    let sourceDirs = hbSourceDirs hb+    let pps        = hbPPs hb+    let pathPieces = fromLogicalPath logPath+    assets <- sequence $ map (getAssetsFrom pps pathPieces) sourceDirs+    return $ concat assets++getAssetsFrom :: PPs+              -> [Text]      -- ^ requested path pieces+              -> FilePath    -- ^ Directory to look in+              -> IO [(FilePath, [PP])]+getAssetsFrom _   []          _    = return []+getAssetsFrom pps pathPieces' dir' = do+    let pathPieces        = map F.fromText pathPieces'+    let dir               = foldl (</>) dir' (init pathPieces)+    let assetName         = last pathPieces++    exists <- F.isDirectory dir+    if exists+        then do contents <- F.listDirectory dir+                let filenames = getAssetsFrom'+                                    pps+                                    assetName+                                    (map F.filename contents)+                return $ map (\(path, xs) -> (dir </> path, xs)) filenames+        else return []++-- Given a list of preprocessors, the path of an asset we want to serve, and+-- a list of potential source files, return a list of all the files which could+-- be used as a source for that file, together with the preprocessors which+-- would need to be applied (in the correct order) to preprocess that file.+--+-- For example, given preprocessors for "sass" and "erb", the asset path+-- "style.css", and the following list of potential files:+--+--  "style.css"+--  "style.css.sass"+--  "style.css.sass.erb"+--  "style.css.unrecognised-ext"+--  "javascript.js"+--+-- we should get back:+--+--  [ ("style.css", [])+--  , ("style.css.sass", [sass])+--  , ("style.css.sass.erb", [erb, sass])+--  ]+getAssetsFrom' :: PPs+               -> FilePath      -- ^ Asset to serve+               -> [FilePath]    -- ^ Potential source files+               -> [(FilePath, [PP])]+getAssetsFrom' pps assetPath = catMaybes . map resolve+    where+    resolve :: FilePath -> Maybe (FilePath, [PP])+    resolve fp = fmap (\xs -> (fp, xs)) $ (resolvePPs pps assetPath fp)++-- Can we apply a sequence of the given preprocessors to the given source file+-- path to get the given asset? If so, return the list of preprocessors which+-- should be applied to it to make this happen.+resolvePPs :: PPs -> FilePath -> FilePath -> Maybe [PP]+resolvePPs pps assetPath source = do+    exts   <- getExtraExtensions assetPath source+    ppList <- sequence $ map (\e -> lookupPP e pps) exts+    return ppList++-- Check if a file path is formed from another file path plus a list of+-- extensions, and if so, return those extensions, in reverse order.+-- Eg:+--  getExtraExtensions "game.js" "game.js.coffee"     == Just ["coffee"]+--  getExtraExtensions "style.css" "game.js.coffee"   == Nothing+--  getExtraExtensions "game.js" "game.js.coffee.erb" == Just ["erb", "coffee"]+getExtraExtensions :: FilePath -> FilePath -> Maybe [Text]+getExtraExtensions fp fpWithExts = do+    stripped <- F.stripPrefix fp fpWithExts+    return $ (reverse . F.extensions) stripped
+ Web/Herringbone/Types.hs view
@@ -0,0 +1,149 @@+module Web.Herringbone.Types where++import Data.Char+import Data.Time.Clock+import Data.Time.Format+import System.Locale+import Data.Text (Text)+import qualified Data.Map as M+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as BL+import qualified Filesystem.Path.CurrentOS as F+import Filesystem.Path.CurrentOS (FilePath)+import Prelude hiding (FilePath)++class ToLazyByteString a where+    toLazyByteString :: a -> BL.ByteString++instance ToLazyByteString String where+    toLazyByteString = BL.pack . map (fromIntegral . ord)++instance ToLazyByteString FilePath where+    toLazyByteString = toLazyByteString . F.encode++instance ToLazyByteString B.ByteString where+    toLazyByteString = BL.fromChunks . (: [])++data AssetError = AssetNotFound+                | AssetCompileError CompileError+                | AmbiguousSources [FilePath]+                deriving (Show, Eq)++-- | A string which should contain information about why an asset failed to+-- compile.+type CompileError = B.ByteString++-- | A preprocessor something which is run on the asset before it is served.+-- Preprocessors are run when a file extension matches the preprocessor+-- extension. For example, if you have a preprocessor for \"coffee\" files, you+-- request \"application.js\", and there is a file named+-- \"application.js.coffee\", Herringbone will run the coffee preprocessor on+-- that file and serve you the result.+--+-- You can add more preprocessors by adding more file extensions;+-- \"application.js.coffee.erb\" will be preprocessed first by \"erb\", then by+-- \"coffee\" (assuming you have registered preprocessors for those files).+data PP = PP+    { ppExtension :: Text+    -- ^ The file extension this preprocessor acts upon, eg \"sass\" or+    -- \"hamlet\"+    , ppAction    :: B.ByteString -> IO (Either CompileError B.ByteString)+    -- ^ Perform the preprocessing.+    }++instance Show PP where+    show pp = "<PP: " ++ show (ppExtension pp) ++ ">"++-- | Beware: This instance is only here for testing. It only looks at the+-- extensions to decide whether two 'PP's are equal. Don't use this!+instance Eq PP where+    (PP ext1 _) == (PP ext2 _) = ext1 == ext2++instance Ord PP where+    compare (PP ext1 _) (PP ext2 _) = compare ext1 ext2++-- | A collection of preprocessors.+newtype PPs = PPs { unPPs :: M.Map Text PP }+    deriving (Show)++noPPs :: PPs+noPPs = PPs M.empty++supportedBy :: PPs -> Text -> Bool+supportedBy pps = flip M.member (unPPs pps)++supportedExts :: PPs -> [Text]+supportedExts = M.keys . unPPs++insertPP :: PP -> PPs -> PPs+insertPP pp = PPs . M.insert (ppExtension pp) pp . unPPs++lookupPP :: Text -> PPs -> Maybe PP+lookupPP ext = M.lookup ext . unPPs++fromList :: [PP] -> PPs+fromList ppList = insertAllPPs ppList noPPs++insertAllPPs :: [PP] -> PPs -> PPs+insertAllPPs ppList pps = foldr insertPP pps ppList++-- | The \'main\' datatype in this library. Just a container for the+-- configuration. All of the important functions will take a 'Herringbone' as+-- their first argument.+data Herringbone = Herringbone+    { hbSourceDirs :: [FilePath]+    -- ^ A list of source directories; this is where assets should be placed.+    , hbDestDir    :: FilePath+    -- ^ Where to copy assets to after they've been compiled.+    , hbPPs        :: PPs+    -- ^ Preprocessors+    }+    deriving (Show)++-- | All assets in Herringbone are referenced by their logical path. This is+-- the path to an asset, relative to any of the source directories.+newtype LogicalPath = LogicalPath { fromLogicalPath :: [Text] }+    deriving (Show)++-- | Create a LogicalPath from a list of Text values. This returns Nothing if+-- the path would be unsafe (that is, if it contains \"..\"), to prevent+-- directory traversal attacks.+makeLogicalPath :: [Text] -> Maybe LogicalPath+makeLogicalPath xs = if safe xs then Just $ LogicalPath xs else Nothing+    where+        safe = all (not . (==) "..")++-- | Create a LogicalPath without checking any of the values.+unsafeMakeLogicalPath :: [Text] -> LogicalPath+unsafeMakeLogicalPath = LogicalPath++toFilePath :: LogicalPath -> FilePath+toFilePath = F.concat . map F.fromText . fromLogicalPath++-- | A preprocessed asset. Any function that returns this will already have+-- done the preprocessing (if necessary).+data Asset = Asset+    { assetSize         :: Integer+    -- ^ Size of the asset in bytes.+    , assetSourcePath   :: FilePath+    -- ^ Path to the asset's source file on disk.+    , assetFilePath     :: FilePath+    -- ^ Path to the preprocessed asset on disk. Note that assets which do not+    -- require preprocessing will still be copied to the destination directory.+    , assetLogicalPath  :: LogicalPath+    -- ^ The logical path referencing this asset.+    , assetModifiedTime :: UTCTime+    -- ^ Modification time of the asset's source file.+    }++instance Show Asset where+    show (Asset size sourcePath filePath logicalPath modifiedTime) =+        "BundledAsset { " +++        "assetSize = " ++ show size ++ ", " +++        "assetSourcePath = " ++ show sourcePath ++ ", " +++        "assetFilePath = " ++ show filePath ++ ", " +++        "assetLogicalPath = " ++ show logicalPath ++ ", " +++        "assetModifiedTime = " ++ showTime modifiedTime ++ " }"++        where+        showTime = formatTime defaultTimeLocale (dateTimeFmt defaultTimeLocale)
herringbone.cabal view
@@ -1,5 +1,5 @@ name:                herringbone-version:             0.0.1+version:             0.0.2 synopsis:            A library for compiling and serving static web assets. description:         A library for compiling and serving static web assets. For more information, please see <https://github.com/hdgarrood/herringbone>. license:             MIT@@ -37,18 +37,19 @@                         warp   default-extensions:   OverloadedStrings,                         TypeSynonymInstances,-                        FlexibleInstances+                        FlexibleInstances,+                        RankNTypes   default-language:     Haskell2010  library   ghc-options:          -Wall-  exposed-modules:      Network.Wai.Herringbone-  other-modules:        Network.Wai.Herringbone.Types-                        Network.Wai.Herringbone.Configuration-                        Network.Wai.Herringbone.LocateAssets-                        Network.Wai.Herringbone.BuildAsset-                        Network.Wai.Herringbone.FindAsset-                        Network.Wai.Herringbone.WaiAdapter+  exposed-modules:      Web.Herringbone+  other-modules:        Web.Herringbone.Types+                        Web.Herringbone.Configuration+                        Web.Herringbone.LocateAssets+                        Web.Herringbone.BuildAsset+                        Web.Herringbone.FindAsset+                        Web.Herringbone.Adapter.Wai   build-depends:        base >=4.6 && <4.7,                         wai  >= 2.0 && <3,                         wai-app-static,@@ -64,5 +65,6 @@                         old-locale   default-extensions:   OverloadedStrings,                         TypeSynonymInstances,-                        FlexibleInstances+                        FlexibleInstances,+                        RankNTypes   default-language:     Haskell2010