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 +10/−9
- Web/Herringbone/Adapter/Wai.hs +0/−93
- Web/Herringbone/BuildAsset.hs +0/−81
- Web/Herringbone/Configuration.hs +0/−31
- Web/Herringbone/FindAsset.hs +0/−31
- Web/Herringbone/Internal/BuildAsset.hs +102/−0
- Web/Herringbone/Internal/Configuration.hs +61/−0
- Web/Herringbone/Internal/FindAsset.hs +27/−0
- Web/Herringbone/Internal/GetBuildMapping.hs +83/−0
- Web/Herringbone/Internal/Types.hs +192/−0
- Web/Herringbone/Internal/Utils.hs +37/−0
- Web/Herringbone/LocateAssets.hs +0/−89
- Web/Herringbone/Preprocessor/CoffeeScript.hs +2/−1
- Web/Herringbone/Preprocessor/Sass.hs +2/−2
- Web/Herringbone/Preprocessor/StdIO.hs +17/−13
- Web/Herringbone/Types.hs +0/−175
- herringbone.cabal +9/−50
- test/AssertionsHelper.hs +0/−63
- test/FindAssetSpec.hs +0/−57
- test/LazinessHelper.hs +0/−14
- test/LocateAssetsSpec.hs +0/−86
- test/PreprocessStdIOSpec.hs +0/−9
- test/Spec.hs +0/−1
- test/SpecHelper.hs +0/−9
- test/TestHerringbone.hs +0/−55
- test/TestServer.hs +0/−9
- test/WaiAdapterTest.hs +0/−15
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