----------------------------------------------------------------------------- -- | -- Module : Static.Resources -- Copyright : (c) Scrive 2012 -- License : BSD-style (see the LICENSE file in the distribution) -- -- Maintainer : mariusz@scrive.com -- Stability : development -- Portability : portable -- -- Put resources.spec into your public HTTP directory. List there your -- css, less and js files. Devide them over some sets. -- -- Sample resources.spec: -- -- > set mainPage -- > css mainPage.css -- > js mainPage.js -- > js jQuery.js -- -- Usage: -- -- > do -- > rs <- getResourceSetsForImport Development "public/resources.js" "" -- > return ""++(htmlImportList "mainPage" rs)++"" -- module Static.Resources ( -- * Main interface htmlImportList , getResourceSetsForImport , cleanResourceFiles -- * Parsing specification , ResourceSpec , parseSpec -- * Check if your spec file is compleate and consistent with FS , check -- | Generation , ImportType(..) , ResourceSetsForImport(..) , generateResources , resourcesMTime ) where import Static.Resources.Types import Static.Resources.Spec import Static.Resources.Checker import Static.Resources.Generation import Static.Resources.Import import Control.Monad import Control.Monad.Error import Data.List import Data.Maybe import System.Directory import System.FilePath import Data.Time.Clock import Data.Time.Calendar -- | Make 'ResourceSetsForImport' ready. It will generate aggregated -- css and js files if needed. It will change directory to one of -- spec file. Aggregated files will be placed there. -- Will change back to original dir when done. getResourceSetsForImport :: ImportType -- ^ Import for production or dev. -> FilePath -- ^ Configuration file. -> FilePath -- ^ Outputted import declaration path prefix (if any). -> IO (Either String ResourceSetsForImport) getResourceSetsForImport it fp pathPrefix = do spec <- parseSpec fp do cleanResourceFiles (takeDirectory fp) spec res <- runErrorT $ do when (null $ sets spec) $ throwError "No resource sets are defined" checkRes <- lift $ check (takeDirectory fp) spec either (throwError . ("Error while checking spec. Error : " ++)) (const (return ())) checkRes lift $ generateResources it (takeDirectory fp) spec pathPrefix case res of Left s -> putStrLn $ "Static resource generation failed. " ++ s Right (ResourceSetsForImport rs _) -> putStrLn $ "Static resource generation done. Generated " ++ show (length rs) ++ " sets." return res -- | Cleans all files that could be created by this system based on -- spec. It requires current directory to be in specification file -- directory cleanResourceFiles :: String -> ResourceSpec -> IO () cleanResourceFiles dir = getGeneratedFiles dir >=> mapM_ removeFile -- | Get the static generated files. getGeneratedFiles :: String -> ResourceSpec -> IO [FilePath] getGeneratedFiles dir spec = do mainFiles <- fmap (filter (\fn -> any (`isPrefixOf` fn) (map name (sets spec)) && isStaticResourceFile fn)) (getDirectoryContents dir) let potentialCompiledLessLocalFiles = map (\r -> dir ++ "/" ++ (path r) ++ ".css") $ filter (\r -> LESS == rtype r) $ concatMap resources $ sets spec compiledLessLocalFiles <- forM potentialCompiledLessLocalFiles $ \fn -> do exists <- doesFileExist fn if (exists) then return $ Just fn else return $ Nothing return $ (map (\r -> dir ++ "/" ++ r) mainFiles) ++ (nub $ map fromJust $ filter isJust compiledLessLocalFiles) -- | Time when last resource file was changed. Param is configuration file location (same that was used for generation). -- This time can be compared to 'generationTime' of 'ResourceSetsForImport' resourcesMTime :: FilePath -> IO UTCTime resourcesMTime fp = resourcesMTime' (takeDirectory fp) resourcesMTime' :: FilePath -> IO UTCTime resourcesMTime' fp = do fs <- getDirectoryContents fp let zeroTime = UTCTime (ModifiedJulianDay 0) 0 fmap maximum $ forM fs $ \f -> do isDirectory <- doesDirectoryExist (fp ++ "/" ++f) case ("." == f || ".." == f, isDirectory, isStaticResourceFile f) of (True,_,_) -> return zeroTime (_,True,_) -> resourcesMTime' $ fp ++ "/" ++f (_,_,True) -> getModificationTime $ fp ++ "/" ++ f (_,_,_) -> return zeroTime