packages feed

herringbone 0.0.7 → 0.1.0

raw patch · 27 files changed

+542/−893 lines, 27 filesdep −HUnitdep −herringbonedep −hspecdep ~base

Dependencies removed: HUnit, herringbone, hspec, wai, wai-app-static, warp

Dependency ranges changed: base

Files

Web/Herringbone.hs view
@@ -28,8 +28,13 @@ -} module Web.Herringbone (     -- * Creating a Herringbone-    Herringbone(..),-    module Web.Herringbone.Configuration,+    Herringbone,+    hbSourceDir,+    hbDestDir,+    hbPPs,+    hbVerbose,+    HerringboneSettings(..),+    module Web.Herringbone.Internal.Configuration,     -- * Assets     LogicalPath,     makeLogicalPath,@@ -44,13 +49,9 @@     AssetError(..),     CompileError,     PPReader(..),-    ppReaderFileName,     PPM,-    -- * WAI-    toApplication ) where -import Web.Herringbone.Configuration-import Web.Herringbone.Types-import Web.Herringbone.FindAsset-import Web.Herringbone.Adapter.Wai+import Web.Herringbone.Internal.Configuration+import Web.Herringbone.Internal.Types+import Web.Herringbone.Internal.FindAsset
− Web/Herringbone/Adapter/Wai.hs
@@ -1,93 +0,0 @@-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
@@ -1,81 +0,0 @@--- | This module contains functions to build assets (that is, run preprocessing--- if necessary, and copy to destination directory).-module Web.Herringbone.BuildAsset where--import Control.Monad.Reader-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 hb logPath 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 :: Herringbone-             -> LogicalPath-             -> FilePath -- ^ Source path-             -> FilePath -- ^ Dest path-             -> [PP]     -- ^ List of preprocessors to apply-             -> IO (Either CompileError ())-compileAsset hb logPath sourcePath destPath pps = do-    sourceData <- F.readFile sourcePath--    let computation = chainEither (map ppAction pps) sourceData-    let readerData = PPReader-            { ppReaderHb          = hb-            , ppReaderLogicalPath = logPath-            , ppReaderSourcePath  = sourcePath-            , ppReaderPPs         = pps-            }-    result <- runPPM computation readerData--    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
@@ -1,31 +0,0 @@-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
@@ -1,31 +0,0 @@-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/Internal/BuildAsset.hs view
@@ -0,0 +1,102 @@+-- | This module contains functions to build assets (that is, run preprocessing+-- if necessary, and copy to destination directory).+module Web.Herringbone.Internal.BuildAsset where++import Control.Monad.Reader+import Data.Maybe+import Data.Time+import Filesystem.Path.CurrentOS (FilePath, (</>))+import qualified Filesystem.Path.CurrentOS as F+import qualified Filesystem as F+import Prelude hiding (FilePath)++import Web.Herringbone.Internal.Types++-- | Build an asset based on a BuildSpec 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+            -> BuildSpec+            -> IO (Either AssetError Asset)+buildAsset hb spec = fmap (mapLeft AssetCompileError) (buildAsset' hb spec)+    where+    mapLeft :: (a -> b) -> Either a r -> Either b r+    mapLeft f (Left x)  = Left $ f x+    mapLeft _ (Right x) = Right x++buildAsset' :: Herringbone+           -> BuildSpec+           -> IO (Either CompileError Asset)+buildAsset' hb (BuildSpec sourcePath' destPath' pp) = do+    verbosePut hb $+        "asset requested: " ++ show sourcePath' +++        "\n\tto: " ++ show destPath' +++        maybe "" ("\n\twith preprocessor: " ++) (fmap show pp)++    let sourcePath = hbSourceDir hb </> sourcePath'+    let destPath = hbDestDir hb </> destPath'++    sourceModifiedTime <- F.getModified sourcePath+    compileNeeded <- shouldCompile hb sourceModifiedTime destPath++    result <- if compileNeeded+                then do+                    verbosePut hb "compiling asset..."+                    compileAsset hb sourcePath destPath (maybeToList pp)+                else do+                    verbosePut hb "asset compilation not needed"+                    return $ Right ()++    either (return . Left)+           (\_ -> do size <- F.getSize destPath+                     return . Right $ Asset+                                        size+                                        sourcePath+                                        destPath+                                        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 :: Herringbone -> UTCTime -> FilePath -> IO Bool+shouldCompile hb sourceModifiedTime destPath = do+    exists <- F.isFile destPath+    if not exists+        then return True+        else do+            destModifiedTime <- F.getModified destPath+            let changedTime = max sourceModifiedTime (herringboneStartTime hb)+            return $ changedTime > destModifiedTime++-- | Compile the given asset by invoking any preprocessors on the source path,+-- and copying the result to the destination path.+compileAsset :: Herringbone+             -> FilePath -- ^ Source path+             -> FilePath -- ^ Dest path+             -> [PP]     -- ^ List of preprocessors to apply+             -> IO (Either CompileError ())+compileAsset hb sourcePath destPath pps = do+    -- Ensure the destination directory exists+    let destDir = F.directory destPath+    verbosePut hb $ "creating dest dir: " ++ show destDir+    F.createTree destDir++    sourceData <- F.readFile sourcePath+    let computation = chainEither (map ppAction pps) sourceData+    let readerData = PPReader+            { ppReaderHb          = hb+            , ppReaderSourcePath  = sourcePath+            , ppReaderPPs         = pps+            }+    result <- runPPM computation readerData++    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/Internal/Configuration.hs view
@@ -0,0 +1,61 @@+module Web.Herringbone.Internal.Configuration where++import Data.Time.Clock (getCurrentTime)+import Filesystem.Path.CurrentOS (FilePath)+import Prelude hiding (FilePath)++import Web.Herringbone.Internal.Types++-- | For convenience.+herringbone :: ConfigBuilder -> IO Herringbone+herringbone = initHerringbone . makeSettings++-- | Creates a 'HerringboneSettings' instance from a 'ConfigBuilder'.+-- This just applies the config builder to the default settings:+--+-- > makeSettings builder = builder defaultSettings+makeSettings :: ConfigBuilder -> HerringboneSettings+makeSettings builder = builder defaultSettings++-- | Sets up internal state, and returns a Herringbone, ready to be used.+initHerringbone :: HerringboneSettings -> IO Herringbone+initHerringbone settings = do+    time <- getCurrentTime+    return Herringbone+        { herringboneStartTime = time+        , herringboneSettings = settings+        }++-- | Adds a directory to the list of source directories.+setSourceDir :: FilePath -> ConfigBuilder+setSourceDir dir settings =+    settings { settingsSourceDir = dir }++-- | Sets the destination directory. Note that this will overwrite the+-- destination directory if one is already set.+setDestDir :: FilePath -> ConfigBuilder+setDestDir dir settings =+    settings { settingsDestDir = dir }++-- | Set the preprocessor collection to the given list of preprocessors+setPreprocessors :: [PP] -> ConfigBuilder+setPreprocessors ppList settings =+    settings { settingsPPs = fromList ppList }++-- | Add a preprocessor to the 'HerringboneSettings'+addPreprocessor :: PP -> ConfigBuilder+addPreprocessor pp settings =+    settings { settingsPPs = insertPP pp (settingsPPs settings) }++-- | Displays detailed log information during requests. Useful for debugging.+setVerbose :: ConfigBuilder+setVerbose settings =+    settings { settingsVerbose = True }++defaultSettings :: HerringboneSettings+defaultSettings = HerringboneSettings+    { settingsSourceDir  = "."+    , settingsDestDir    = "compiled_assets"+    , settingsPPs        = emptyPPs+    , settingsVerbose    = False+    }
+ Web/Herringbone/Internal/FindAsset.hs view
@@ -0,0 +1,27 @@+module Web.Herringbone.Internal.FindAsset where++import Web.Herringbone.Internal.GetBuildMapping+import Web.Herringbone.Internal.BuildAsset+import Web.Herringbone.Internal.Types++findAsset :: Herringbone+          -> LogicalPath+          -> IO (Either AssetError Asset)+findAsset hb path = do+    mapping <- getBuildMapping hb+    findAssetWithMapping hb path mapping++findAssetWithMapping :: Herringbone+                     -> LogicalPath+                     -> BuildMapping+                     -> IO (Either AssetError Asset)+findAssetWithMapping hb path mapping =+    case specs of+            []  -> return . Left $ AssetNotFound+            [x] -> buildAsset hb x+            xs  -> return . Left $ AmbiguousSources (map getSource xs)+    where+    getSource (BuildSpec s _ _) = s+    getDest (BuildSpec _ d _) = d+    destPath = toFilePath path+    specs = filter ((== destPath) . getDest) mapping
+ Web/Herringbone/Internal/GetBuildMapping.hs view
@@ -0,0 +1,83 @@+-- | This module deals with locating assets on the disk, and determining which+-- assets needs preprocessing.+--+-- In development mode:+-- * At startup, build a mapping of source files to destination files together+--   with any preprocessors that should be run on them (based on extension)+-- * watch for filesystem changes, and rebuild relevant parts of this mapping+--   when necessary+-- * listen for HTTP requests and serve relevant files, performing+--   preprocessing where necessary.+-- (well, eventually do all that. For now just rebuild the BuildMapping for+-- each request).+--+-- In production mode:+-- * build the mapping+-- * preprocess all the files and output them to a particular directory.+--+-- This architecture should ensure that the file mapping is identical in each+-- mode.+--+module Web.Herringbone.Internal.GetBuildMapping where++import Control.Monad+import Control.Applicative ((<$>))+import Data.Maybe (fromMaybe)+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.Internal.Types+import Web.Herringbone.Internal.Utils++getBuildMapping :: Herringbone -> IO BuildMapping+getBuildMapping hb = do+    files <- getFilesRecursiveRelative $ hbSourceDir hb+    return $ map (getBuildSpec hb) files+++-- | Given a FilePath of a source file, construct a BuildSpec for the file.+getBuildSpec :: Herringbone -> FilePath -> BuildSpec+getBuildSpec hb sourcePath = BuildSpec sourcePath destPath pp+    where+    (destPath, pp) =+        fromMaybe (sourcePath, Nothing) $ do+            extension <- F.extension sourcePath+            pp'       <- lookupPP extension (hbPPs hb)+            destPath' <- swapExtension pp' sourcePath+            return (destPath', Just pp')++-- | Make the destination path of a BuildSpec absolute, using the destination+-- directory of the given Herringbone.+makeDestAbsolute :: Herringbone+                 -> BuildSpec+                 -> IO BuildSpec+makeDestAbsolute hb (BuildSpec sourcePath destPath pp) = do+    fullDestDir <- F.canonicalizePath $ hbDestDir hb+    let fullDestPath = fullDestDir </> destPath+    return $ BuildSpec sourcePath fullDestPath pp++swapExtension :: PP -> FilePath -> Maybe FilePath+swapExtension pp =+    swapExtension' (ppConsumes pp) (ppProduces pp)++swapExtension' :: Text -> Text -> FilePath -> Maybe FilePath+swapExtension' fromExt toExt path = do+    guard $ F.hasExtension path fromExt+    return $ F.replaceExtension path toExt++-- | Search for a file in a list of search paths. For example, if+-- @assets/test.txt@ exists, then+-- @searchForFile ["assets", "other_assets"] "test.txt"@ will return+-- @Just "assets/text.txt"@+searchForFile :: [FilePath]     -- ^ List of search paths+              -> FilePath       -- ^ File to search for+              -> IO (Maybe FilePath)+searchForFile searchPath path = do+    let fullPaths = map (</> path) searchPath+    matches <- filterM F.isFile fullPaths+    case matches of+        []    -> return Nothing+        (x:_) -> Just <$> F.canonicalizePath x
+ Web/Herringbone/Internal/Types.hs view
@@ -0,0 +1,192 @@+module Web.Herringbone.Internal.Types where++import Control.Monad.Reader+import Control.Applicative+import Data.Maybe+import Data.Map (Map)+import qualified Data.Map as M+import Data.Text (Text)+import qualified Data.Text as T+import Data.Time.Clock+import Data.Time.Format+import System.Locale+import System.IO hiding (FilePath)+import qualified Data.ByteString as B+import qualified Filesystem.Path.CurrentOS as F+import Filesystem.Path.CurrentOS (FilePath)+import Prelude hiding (FilePath)++data AssetError = AssetNotFound+                | AssetCompileError CompileError+                | AmbiguousSources [FilePath]+                deriving (Show, Eq)++-- | Data which is given to preprocessors on the off-chance that they need it+-- (eg, Fay)+data PPReader = PPReader+    { ppReaderHb          :: Herringbone+    -- ^ The Herringbone which was used to build the asset+    , ppReaderSourcePath  :: FilePath+    -- ^ The file path to the source file+    , ppReaderPPs         :: [PP]+    -- ^ Preprocessors being invoked.+    }++-- | A monad in which preprocessor actions happen.+newtype PPM a = PPM { unPPM :: ReaderT PPReader IO a }+    deriving (Functor, Applicative, Monad, MonadIO, (MonadReader PPReader))++runPPM :: PPM a -> PPReader -> IO a+runPPM comp = runReaderT (unPPM comp)++-- | A preprocessor something which is run on the asset before it is served.+-- Preprocessors are run when a file matches its rule.  For example, if you+-- have a preprocessor which takes \"coffee\" files and emits \"js\" files,+-- there is a file named \"application.coffee\", and you request+-- \"application.js\", Herringbone will run the coffee preprocessor on+-- \"application.coffee\" and serve you the result.+data PP = PP+    { ppName     :: Text+    -- ^ Identifies a preprocessor. Mainly useful for debugging compile errors.+    , ppConsumes :: Text+    -- ^ Extension for files this preprocessor consumes.+    , ppProduces :: Text+    -- ^ Extension for files this preprocessor produces.+    , ppAction :: PPAction+    -- ^ Performs the compilation.+    }++instance Show PP where+    show (PP name consumes produces _) = concat+        [ "<PP ", T.unpack name,+            " (", T.unpack consumes, " -> ", T.unpack produces, ")>"+        ]++-- | A function which performs the compilation.+type PPAction =+    B.ByteString ->+    -- ^ Input file contents+    PPM (Either CompileError B.ByteString)+    -- ^ Output file contents, or a compile error.++-- | A string which should contain information about why an asset failed to+-- compile.+type CompileError = B.ByteString++-- | A collection of preprocessors. This can store many preprocessors which+-- produce files with the same extension, but may not store more than one+-- preprocessor which consumes files of a particular extension.+newtype PPs = PPs { unPPs :: Map Text PP }+    deriving (Show)++emptyPPs :: PPs+emptyPPs = PPs M.empty++-- | Given a file extension, find the preprocessor (if any) which consumes it.+lookupPP :: Text -> PPs -> Maybe PP+lookupPP ext pps = M.lookup ext (unPPs pps)++-- | Inserts a preprocessor into a PPs. If a preprocessor already exists with+-- the given extension, it is discarded.+insertPP :: PP -> PPs -> PPs+insertPP pp pps = PPs $ M.insert (ppConsumes pp) pp (unPPs pps)++-- | Turn a list of PPs into a proper 'PPs'.+fromList :: [PP] -> PPs+fromList = foldr insertPP emptyPPs++-- | A BuildSpec specifies how an asset should be built.+data BuildSpec = BuildSpec+    FilePath    -- ^ Source path (relative)+    FilePath    -- ^ Destination path (again, relative)+    (Maybe PP)  -- ^ Preprocessor to run (if any)+    deriving (Show)++-- | A BuildMapping contains the information to build all of the assets+-- Herringbone is aware of.+type BuildMapping = [BuildSpec]++-- | The \'main\' datatype in this library.  All of the important functions+-- will take a 'Herringbone' as their first argument.+data Herringbone = Herringbone+    { herringboneSettings :: HerringboneSettings+    , herringboneStartTime :: UTCTime+    }++-- | Contains configuration.+data HerringboneSettings = HerringboneSettings+    { settingsSourceDir :: FilePath+    -- ^ The directory to take asset sources from.+    , settingsDestDir    :: FilePath+    -- ^ Where to copy assets to after they've been compiled.+    , settingsPPs        :: PPs+    -- ^ Preprocessors+    , settingsVerbose    :: Bool+    -- ^ Dump debugging data to stdout on every request.+    }+    deriving (Show)++type ConfigBuilder = HerringboneSettings -> HerringboneSettings++hbSourceDir :: Herringbone -> FilePath+hbSourceDir = settingsSourceDir . herringboneSettings++hbDestDir :: Herringbone -> FilePath+hbDestDir = settingsDestDir . herringboneSettings++hbPPs :: Herringbone -> PPs+hbPPs = settingsPPs . herringboneSettings++hbVerbose :: Herringbone -> Bool+hbVerbose = settingsVerbose . herringboneSettings++-- | Log a message to stdout if hbVerbose is enabled.+verbosePut :: Herringbone -> String -> IO ()+verbosePut hb msg = when (hbVerbose hb) $ do+    putStrLn ("herringbone: " ++ msg)+    hFlush stdout++-- | 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, Eq)++-- | 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.+    , assetModifiedTime :: UTCTime+    -- ^ Modification time of the asset's source file.+    }++instance Show Asset where+    show (Asset size sourcePath filePath modifiedTime) =+        "Asset { " +++        "assetSize = " ++ show size ++ ", " +++        "assetSourcePath = " ++ show sourcePath ++ ", " +++        "assetFilePath = " ++ show filePath ++ ", " +++        "assetModifiedTime = " ++ showTime modifiedTime ++ " }"++        where+        showTime = formatTime defaultTimeLocale (dateTimeFmt defaultTimeLocale)
+ Web/Herringbone/Internal/Utils.hs view
@@ -0,0 +1,37 @@+module Web.Herringbone.Internal.Utils where++import Control.Monad+import Data.Maybe (catMaybes)+import Filesystem.Path.CurrentOS (FilePath, (</>))+import qualified Filesystem.Path.CurrentOS as F+import qualified Filesystem as F+import Prelude hiding (FilePath)++-- | Return the absolute paths of all files (excluding directories and other+-- things) below the given root.+getFilesRecursive :: FilePath -> IO [FilePath]+getFilesRecursive root = do+    results         <- F.listDirectory root+    (files, others) <- partitionM F.isFile results+    (dirs, _)       <- partitionM F.isDirectory others+    subfiles        <- mapM getFilesRecursive dirs+    return $ files ++ concat subfiles++-- | Return the relative paths of all files (excluding directories and other+-- things) below the given root.+getFilesRecursiveRelative :: FilePath -> IO [FilePath]+getFilesRecursiveRelative root = do+    root' <- F.canonicalizePath (root </> "") -- this is required, because. :/+    files <- getFilesRecursive root'+    let maybes = map (F.stripPrefix root') files+    return $ catMaybes maybes++-- should this go in a utils module?+partitionM :: Monad m => (a -> m Bool) -> [a] -> m ([a], [a])+partitionM f = foldM g ([], [])+    where+    g (as, bs) x = do+        flag <- f x+        return $ if flag+            then (x : as, bs)+            else (as, x : bs)
− Web/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 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/Preprocessor/CoffeeScript.hs view
@@ -6,4 +6,5 @@ import Web.Herringbone.Preprocessor.StdIO  coffeeScript :: PP-coffeeScript = makeStdIOPP "coffee" "coffee" ["--stdio", "--print"]+coffeeScript =+    makeStdIOPP "CoffeeScript" "coffee" "js" "coffee" ["--stdio", "--print"]
Web/Herringbone/Preprocessor/Sass.hs view
@@ -8,8 +8,8 @@  -- | A preprocessor for the sass mode of Sass. sass :: PP-sass = makeStdIOPP "sass" "sass" ["--stdin"]+sass = makeStdIOPP "Sass (sass mode)" "sass" "css" "sass" ["--stdin"]  -- | A preprocessor for the scss mode of Sass. scss :: PP-scss = makeStdIOPP "scss" "sass" ["--stdin", "--scss"]+scss = makeStdIOPP "Sass (scss mode)" "scss" "css" "sass" ["--stdin", "--scss"]
Web/Herringbone/Preprocessor/StdIO.hs view
@@ -8,26 +8,30 @@ import Data.ByteString (ByteString) import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as C8-import System.Exit-import System.Process.ByteString+import System.Exit (ExitCode(..))+import System.Process.ByteString (readProcessWithExitCode) import Web.Herringbone  -- | Make a preprocessor which works over standard IO; reading input from -- stdin, and writing output to stdout.-makeStdIOPP :: Text     -- ^ File extension+makeStdIOPP :: Text     -- ^ Name (identifies the preprocessor)+            -> Text     -- ^ Source filename extension (eg "sass")+            -> Text     -- ^ Destination filename extension (eg "css")             -> String   -- ^ Program name             -> [String] -- ^ Arguments             -> PP-makeStdIOPP ext progname args = PP-    { ppExtension = ext-    , ppAction = compile progname args+makeStdIOPP name consumes produces progname args = PP+    { ppName     = name+    , ppConsumes = consumes+    , ppProduces = produces+    , ppAction   = compile progname args     }      compile :: String         -> [String]         -> ByteString         -> PPM (Either CompileError ByteString)-compile progname args source = do+compile progname args source =     liftIO $ readAllFromProcess progname args source  -- | Read from a process returning both std err and out.@@ -35,12 +39,12 @@                    -> [String]      -- ^ Args                    -> ByteString    -- ^ Stdin                    -> IO (Either ByteString ByteString)-readAllFromProcess program flags input = do-  (code,out,err) <- readProcessWithExitCode program flags input-  return $ case code of-    ExitFailure 127 -> Left $ "cannot find executable " <> C8.pack program-    ExitFailure _ -> Left $ join (err, out)-    ExitSuccess -> Right $ join (err, out)+readAllFromProcess program args input = do+    (code,out,err) <- readProcessWithExitCode program args input+    return $ case code of+        ExitFailure 127 -> Left $ "cannot find executable " <> C8.pack program+        ExitFailure _   -> Left $ join (err, out)+        ExitSuccess     -> Right $ join (err, out)   where   join (err, out) = if B.null err                         then out
− Web/Herringbone/Types.hs
@@ -1,175 +0,0 @@-module Web.Herringbone.Types where--import Control.Monad.Reader-import Control.Applicative-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)---- | Data which is given to preprocessors on the off-chance that they need it--- (eg, Fay)-data PPReader = PPReader-    { ppReaderHb          :: Herringbone -    -- ^ The Herringbone which was used to build the asset-    , ppReaderLogicalPath :: LogicalPath-    -- ^ The Logical path of the requested asset.-    , ppReaderSourcePath  :: FilePath-    -- ^ The file path to the source file-    , ppReaderPPs         :: [PP]-    -- ^ Preprocessors being invoked.-    }-    deriving (Show, Eq)--ppReaderFileName :: PPReader -> FilePath-ppReaderFileName = F.fromText . last . fromLogicalPath . ppReaderLogicalPath---- | A monad in which preprocessor actions happen.-newtype PPM a = PPM { unPPM :: ReaderT PPReader IO a }-    deriving (Functor, Applicative, Monad, MonadIO, (MonadReader PPReader))--runPPM :: PPM a -> PPReader -> IO a-runPPM comp readerData = runReaderT (unPPM comp) readerData---- | 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 -> PPM (Either CompileError B.ByteString)-    -- ^ Perform the preprocessing.-    }--instance Show PP where-    show pp = "<PP: " ++ show (ppExtension pp) ++ ">"---- | Beware: This instance only looks at the extensions to decide whether two--- 'PP's are equal.-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, Eq)--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, Eq)---- | 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, Eq)---- | 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.7+version:             0.1.0 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@@ -11,59 +11,24 @@ cabal-version:       >=1.10 extra-source-files:     README.md-    test/*.hs  source-repository head   type:     git   location: https://github.com/hdgarrood/herringbone -test-suite herringbone-tests-  type:                 exitcode-stdio-1.0-  main-is:              Spec.hs-  hs-source-dirs:       test .-  ghc-options:          -Wall-  build-depends:        base >=4.6 && <4.7,-                        wai  >= 2.0 && <3,-                        wai-app-static,-                        text,-                        bytestring,-                        containers,-                        transformers,-                        mtl,-                        system-filepath,-                        system-fileio,-                        process,-                        process-listlike,-                        directory,-                        unix-compat,-                        http-types,-                        time,-                        old-locale,-                        hspec,-                        HUnit,-                        warp-  default-extensions:   OverloadedStrings,-                        TypeSynonymInstances,-                        FlexibleInstances,-                        RankNTypes,-                        GeneralizedNewtypeDeriving-  default-language:     Haskell2010- library   ghc-options:          -Wall   exposed-modules:      Web.Herringbone,                         Web.Herringbone.Preprocessor.StdIO                         Web.Herringbone.Preprocessor.Sass                         Web.Herringbone.Preprocessor.CoffeeScript-  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,+                        Web.Herringbone.Internal.Types+                        Web.Herringbone.Internal.Configuration+                        Web.Herringbone.Internal.GetBuildMapping+                        Web.Herringbone.Internal.BuildAsset+                        Web.Herringbone.Internal.FindAsset+                        Web.Herringbone.Internal.Utils+  build-depends:        base >=4.5 && <5,                         text,                         bytestring,                         containers,@@ -82,12 +47,6 @@                         TypeSynonymInstances,                         FlexibleInstances,                         RankNTypes,+                        ViewPatterns,                         GeneralizedNewtypeDeriving   default-language:     Haskell2010--executable herringbone-test-server-  hs-source-dirs:       test-  build-depends:        base, herringbone, text, warp-  main-is:              TestServer.hs-  default-language:     Haskell2010-  default-extensions:   OverloadedStrings
− test/AssertionsHelper.hs
@@ -1,63 +0,0 @@-module AssertionsHelper where--import Control.Applicative-import Control.Monad-import Data.Text (Text)-import Data.List (sort)-import Test.HUnit hiding (path)-import Prelude hiding (FilePath)-import Filesystem.Path.CurrentOS (FilePath, (</>))-import Prelude hiding (FilePath)-import qualified Filesystem as F--import LazinessHelper-import TestHerringbone-import Web.Herringbone--testWithInputs :: String -> (a -> Assertion) -> [a] -> Test-testWithInputs groupName f =-    TestLabel groupName . TestList . map mkTest . zipWith assignName ([1,2..] :: [Int])-    where-        mkTest (name, input) = TestLabel name (TestCase (f input))-        assignName n input   = ("input #" ++ show n, input)--resultsDir :: FilePath-resultsDir = "test/resources/results"--testWithExpectedResult :: Text -> Assertion-testWithExpectedResult logicalPathText = do-    let logicalPath = lp logicalPathText-    let filePath = toFilePath logicalPath-    result <- findAsset testHB logicalPath-    either (fail . show)-           (assertResultMatches filePath . assetFilePath)-           result--assertResultMatches :: FilePath -> FilePath -> Assertion-assertResultMatches resultName filePath = do-    let resultPath = resultsDir </> resultName-    assertFileContentsMatch resultPath filePath---- Extra assertions-assertFileExists :: FilePath -> Assertion-assertFileExists path = do-    exists <- F.isFile path-    assertBool ("Expected a file to exist: " ++ es path) exists--assertFileContentsMatch :: FilePath -> FilePath -> Assertion-assertFileContentsMatch pathA pathB = do-    matches <- (==) <$> F.readFile pathA <*> F.readFile pathB-    assertBool ("expected file contents to match\n" ++-                "this file:       " ++ es pathA ++ "\n" ++-                "versus this one: " ++ es pathB ++ "\n") matches--assertEqual' :: (Eq a, Show a) => a -> a -> Assertion-assertEqual' = assertEqual ""--assertSameElems :: (Eq a, Show a, Ord a) => [a] -> [a] -> Assertion-assertSameElems xs ys = assertEqual' (sort xs) (sort ys)--assertIsRight :: Show a => Either a b -> Assertion-assertIsRight (Right _) = return ()-assertIsRight (Left x)  = assertFailure $-                            "Expected a Right value; got: Left " ++ show x
− test/FindAssetSpec.hs
@@ -1,57 +0,0 @@-module FindAssetSpec where--import Filesystem.Path.CurrentOS ((</>))-import Prelude hiding (FilePath)-import qualified Filesystem as F-import Test.Hspec-import Test.HUnit hiding (path)--import Web.Herringbone-import SpecHelper--spec :: Spec-spec = do-    let destDir = hbDestDir testHB--    context "without preprocessors" $ do-        let logPath = lp "buildNoPreprocessors.js"--        it "should copy a source file to the destination directory" $ do-            asset' <- findAsset testHB logPath--            assertIsRight asset'-            let Right asset = asset'-            assertFileExists (assetFilePath asset)-            assertFileContentsMatch (assetSourcePath asset)-                                    (assetFilePath asset)--        it "should get the modification time of the source file" $ do-            Right asset <- findAsset testHB logPath-            sourceMTime <- F.getModified (assetSourcePath asset)--            assertEqual' sourceMTime (assetModifiedTime asset)--        it "should not compile unless necessary" $ do-            Right asset  <- findAsset testHB logPath-            mTime        <- F.getModified (assetFilePath asset)-            Right asset' <- findAsset testHB logPath-            mTime'       <- F.getModified (assetFilePath asset')--            assertEqual' mTime mTime'--    context "with preprocessors" $ do-        it "should run a single preprocessor" $ do-            testWithExpectedResult "onePreprocessor.js"--        it "should run preprocessors in the correct order" $ do-            testWithExpectedResult "threePreprocessors.js"--    context "when there's a compile error" $ do-        it "should report the error" $ do-            Left result <- findAsset testHB (lp "compileError.css")-            assertEqual' (AssetCompileError "Oh snap!") result--        it "should not create the output file" $ do-            _ <- findAsset testHB (lp "compileError.css")-            exists <- F.isFile (destDir </> "compileError.css")-            assert (not exists)
− test/LazinessHelper.hs
@@ -1,14 +0,0 @@-module LazinessHelper where--import Web.Herringbone-import Data.Text (Text)-import qualified Data.Text as T-import Prelude hiding (FilePath)-import Filesystem.Path.CurrentOS (FilePath)-import qualified Filesystem.Path.CurrentOS as F--es :: FilePath -> String-es = F.encodeString--lp :: Text -> LogicalPath-lp = unsafeMakeLogicalPath . T.splitOn "/"
− test/LocateAssetsSpec.hs
@@ -1,86 +0,0 @@-module LocateAssetsSpec where--import Test.Hspec-import Test.Hspec.HUnit-import Test.HUnit hiding (path)-import Data.Text (Text)-import Filesystem.Path.CurrentOS (FilePath, (</>))-import Prelude hiding (FilePath)--import Web.Herringbone.LocateAssets-import Web.Herringbone.Types-import SpecHelper--spec :: Spec-spec = do-    fromHUnitTest $ testWithInputs "getExtraExtensions"-        test_getExtraExtensions-        data_getExtraExtensions--    fromHUnitTest $ testWithInputs "resolvePPs"-        test_resolvePPs-        data_resolvePPs--    fromHUnitTest $ testWithInputs "lookupPP"-        test_lookupPP-        data_lookupPP--    fromHUnitTest $ testWithInputs "locateAssets"-        test_locateAssets-        data_locateAssets--test_getExtraExtensions :: (FilePath, FilePath, Maybe [Text]) -> Assertion-test_getExtraExtensions (pathWithExts, path, expected) =-    assertEqual' expected (getExtraExtensions pathWithExts path)--data_getExtraExtensions :: [(FilePath, FilePath, Maybe [Text])]-data_getExtraExtensions =-    [ ("game.js"   , "game.js.coffee"     , Just ["coffee"])-    , ("style.css" , "game.js.coffee"     , Nothing)-    , ("game.js"   , "game.js.coffee.erb" , Just ["erb", "coffee"])-    ]--allPPs :: PPs-allPPs = fromList [pp1, pp2]--test_resolvePPs :: (PPs, FilePath, FilePath, Maybe [PP]) -> Assertion-test_resolvePPs (pps, assetPath, sourcePath, expected) =-    assertEqual' expected (resolvePPs pps assetPath sourcePath)--data_resolvePPs :: [(PPs, FilePath, FilePath, Maybe [PP])]-data_resolvePPs =-    [ (noPPs  , "test.js"   , "test.js"         , Just [])-    , (noPPs  , "test.js"   , "test.js.pp1"     , Nothing)-    , (allPPs , "test.js"   , "test.js.pp1"     , Just [pp1])-    , (allPPs , "test.js"   , "test.js.pp1.pp2" , Just [pp2, pp1])-    , (allPPs , "style.css" , "test.js.pp1"     , Nothing)-    ]--test_lookupPP :: (Text, PPs, Maybe PP) -> Assertion-test_lookupPP (ext, pps, expected) =-    assertEqual' expected (lookupPP ext pps)--data_lookupPP :: [(Text, PPs, Maybe PP)]-data_lookupPP =-    [ ("sass" , noPPs  , Nothing)-    , ("sass" , allPPs , Nothing)-    , ("pp1"  , allPPs , Just pp1)-    ]--test_locateAssets :: (LogicalPath, [(FilePath, [PP])]) -> Assertion-test_locateAssets (logPath, expected) = do-    assets <- locateAssets testHB logPath-    assertSameElems expected assets--data_locateAssets :: [(LogicalPath, [(FilePath, [PP])])]-data_locateAssets =-    [ (lp "locateAssets.js",  [(base1 </> "locateAssets.js", [])])-    , (lp "locateAssets.css", [ (base1 </> "locateAssets.css", [])-                              , (base1 </> "locateAssets.css.pp1", [pp1])-                              , (base2 </> "locateAssets.css", [])-                              ])-    , (lp "html/locateAssets.html", [(base1 </> "html/locateAssets.html", [])])-    ]-    where-    base1 = "test/resources/assets"-    base2 = "test/resources/assets2"
− test/PreprocessStdIOSpec.hs
@@ -1,9 +0,0 @@-module PreprocessStdIOSpec where--import Test.Hspec-import SpecHelper--spec :: Spec-spec = do-    it "should use stdIO" $ do-        testWithExpectedResult "hello.txt"
− test/Spec.hs
@@ -1,1 +0,0 @@-{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
− test/SpecHelper.hs
@@ -1,9 +0,0 @@-module SpecHelper (-    module AssertionsHelper,-    module LazinessHelper,-    module TestHerringbone-) where--import AssertionsHelper-import LazinessHelper-import TestHerringbone
− test/TestHerringbone.hs
@@ -1,55 +0,0 @@-module TestHerringbone where--import Data.Text (Text)-import qualified Data.Text.Encoding as T-import Data.Monoid-import Network.Wai.Handler.Warp--import Web.Herringbone-import Web.Herringbone.Preprocessor.StdIO-import Web.Herringbone.Preprocessor.CoffeeScript-import Web.Herringbone.Preprocessor.Sass--mkMockPP :: Text -> PP-mkMockPP ext = PP { ppExtension = ext-                  , ppAction = \sourceData -> do-                        return . Right $-                            "Preprocessed as: " <> T.encodeUtf8 ext <> "\n" <>-                            sourceData-                  }--pp1 :: PP-pp1 = mkMockPP "pp1"--pp2 :: PP-pp2 = mkMockPP "pp2"--pp3 :: PP-pp3 = mkMockPP "pp3"--failingPP :: PP-failingPP = PP { ppExtension = "fails"-               , ppAction = const . return . Left $ "Oh snap!"-               }--sed :: PP-sed = makeStdIOPP "sed" "sed" ["-e", "s/e/u/"]--testHB :: Herringbone-testHB = herringbone-    ( addSourceDir  "test/resources/assets"-    . addSourceDir  "test/resources/assets2"-    . setDestDir    "test/resources/compiled_assets"-    . addPreprocessors [ pp1-                       , pp2-                       , pp3-                       , failingPP-                       , coffeeScript-                       , sass-                       , scss-                       , sed-                       ]-    )--runTestHB :: Int -> IO ()-runTestHB port = run port (toApplication testHB)
− test/TestServer.hs
@@ -1,9 +0,0 @@-module Main where--import TestHerringbone--main :: IO ()-main = do-    let port = 3002 :: Int-    putStrLn $ "starting test server on port " ++ show port ++ "..."-    runTestHB port
− test/WaiAdapterTest.hs
@@ -1,15 +0,0 @@-module WaiAdapterTest where--import Network.Wai-import Network.Wai.Handler.Warp--import Web.Herringbone-import SpecHelper--app :: Application-app = toApplication testHB--runApp :: IO ()-runApp = do-    putStrLn "running on port 3002..."-    run 3002 app