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
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')
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
searchForFile :: [FilePath]
-> FilePath
-> 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