diff --git a/example/src/fay/HelloWorld.hs b/example/src/fay/HelloWorld.hs --- a/example/src/fay/HelloWorld.hs +++ b/example/src/fay/HelloWorld.hs @@ -1,4 +1,3 @@ --- src/fay/HelloWorld.hs module HelloWorld where import Prelude diff --git a/scotty-fay.cabal b/scotty-fay.cabal --- a/scotty-fay.cabal +++ b/scotty-fay.cabal @@ -1,5 +1,5 @@ name: scotty-fay -version: 0.0.1 +version: 0.0.2 build-type: Simple cabal-version: >= 1.10 @@ -38,7 +38,8 @@ wai, transformers, text, - directory + directory, + filepath test-suite scotty-fay-tests type: exitcode-stdio-1.0 diff --git a/src/Web/Scotty/Fay.hs b/src/Web/Scotty/Fay.hs --- a/src/Web/Scotty/Fay.hs +++ b/src/Web/Scotty/Fay.hs @@ -10,6 +10,7 @@ import Web.Scotty.Trans hiding (file) import qualified Fay import System.Directory +import System.FilePath import Web.Scotty.Fay.Internal import Web.Scotty.Fay.Config @@ -19,14 +20,15 @@ | FileNotFound String compileFile :: Config -> FilePath -> IO CompileResult -compileFile conf file = do - exists <- doesFileExist file - if not exists - then return . FileNotFound $ +compileFile conf fullPath = do + let (dir, file) = splitFileName fullPath + let includeDirs = map (dir ) $ configIncludeDirs conf + file' <- findFile includeDirs file + case file' of + Nothing -> return . FileNotFound $ "scotty-fay: Could not find " ++ file -- TODO: hs relative path? - else do - file' <- canonicalizePath file - res <- Fay.compileFile (toFay conf) file' + Just file'' -> do + res <- Fay.compileFile (toFay conf) file'' case res of Right (out, _) -> return $ Success out Left err -> return . Error . Fay.showCompileError $ err @@ -42,8 +44,7 @@ path <- maybeParam "path" case path of Just path' -> do - let filePath = configSrcDir conf ++ "/" ++ path' - result <- liftIO (compileFile conf filePath) + result <- liftIO (compileFile conf path') case result of Success code -> respondWithJs code Error err -> raiseErr err diff --git a/src/Web/Scotty/Fay/Config.hs b/src/Web/Scotty/Fay/Config.hs --- a/src/Web/Scotty/Fay/Config.hs +++ b/src/Web/Scotty/Fay/Config.hs @@ -1,13 +1,4 @@ -module Web.Scotty.Fay.Config - ( Config - , ConfigBuilder - , configSrcDir - , configBasePath - , buildConfig - , under - , from - , toFay - ) where +module Web.Scotty.Fay.Config where import Data.Default import qualified Data.Text as T @@ -15,14 +6,14 @@ import qualified Fay.Compiler.Config as Fay data Config = Config - { configBasePath :: T.Text - , configSrcDir :: FilePath + { configBasePath :: T.Text + , configIncludeDirs :: [FilePath] } instance Default Config where def = Config - { configBasePath = "" - , configSrcDir = "" + { configBasePath = "" + , configIncludeDirs = [] } type ConfigBuilder = Config -> Config @@ -32,10 +23,14 @@ -- Convert a scotty-fay Config to a Fay CompileConfig toFay :: Config -> Fay.CompileConfig -toFay conf = Fay.addConfigDirectoryIncludePaths [configSrcDir conf] $ def +toFay conf = Fay.addConfigDirectoryIncludePaths (configIncludeDirs conf) $ def under :: T.Text -> ConfigBuilder under basePath conf = conf { configBasePath = basePath } from :: FilePath -> ConfigBuilder -from dir conf = conf { configSrcDir = dir } +from dir = fromDirs [dir] + +fromDirs :: [FilePath] -> ConfigBuilder +fromDirs dirs conf = + conf { configIncludeDirs = dirs ++ configIncludeDirs conf } diff --git a/src/Web/Scotty/Fay/Internal.hs b/src/Web/Scotty/Fay/Internal.hs --- a/src/Web/Scotty/Fay/Internal.hs +++ b/src/Web/Scotty/Fay/Internal.hs @@ -2,6 +2,7 @@ import Control.Monad import Control.Monad.IO.Class +import Data.List import Data.Maybe import qualified Data.Text as T import qualified Data.Text.Lazy as LT @@ -23,11 +24,27 @@ -- is sane. initialize :: Config -> IO () initialize conf = do - let srcDir = configSrcDir conf - exists <- doesDirectoryExist srcDir - unless exists $ do - warn $ "The source directory: " ++ show srcDir ++ - " does not exist. Continuing anyway..." + let includeDirs = configIncludeDirs conf + results <- getNonExistent includeDirs + warn $ nonExistentWarning results + +getNonExistent :: [FilePath] -> IO [FilePath] +getNonExistent = foldl f (return []) + where + f acc dir = do + dirs <- acc + exists <- doesDirectoryExist dir + if exists + then return (dir : dirs) + else return dirs + +nonExistentWarning :: [FilePath] -> String +nonExistentWarning dirs = concat + [ "The following include dirs:" + , showAll dirs + , "do not exist. scotty-fay might not work very well." + ] + where showAll = concat . intersperse "\n\t" -- The route matcher function, to be given to Scotty. Ensure the request path -- starts with the given base path, and then put the rest of the path into diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -1,5 +1,6 @@ module Main where +import Data.List import Control.Monad.IO.Class (liftIO) import Web.Scotty hiding (request) import Web.Scotty.Fay @@ -24,7 +25,7 @@ , waiTest "imports" test_imports , waiTest "directory traversal" test_directoryTraversal , return $ testGroup "configuration" $ - [ testCase "configuring src dir" test_configuringSrcDir + [ testCase "configuring include dirs" test_configuringIncludeDirs , testCase "configuring base path" test_configuringBasePath ] ] @@ -36,7 +37,10 @@ app :: ScottyM () app = do - serveFay (under "/fay" . from "test/fay-resources") + serveFay $ + ( under "/fay" + . fromDirs ["test/fay-resources1", "test/fay-resources2"] + ) get "/" $ do text "this is the root" @@ -87,18 +91,36 @@ test_directoryTraversal :: Session () test_directoryTraversal = do - let req = setPath defaultRequest "/fay/test/Fib/../Fib.hs" + let req = setPath defaultRequest "/fay/Fib/../Fib.hs" resp <- request req assertNotStatus 200 resp +test_multipleIncludeDirs :: Session () +test_multipleIncludeDirs = do + let req = setPath defaultRequest "/fay/HelloWorld.hs" + resp <- request req + + assertJavaScriptRenderedOk resp + +test_fayUnderDirectories :: Session () +test_fayUnderDirectories = do + let req = setPath defaultRequest "/fay/under-a-dir/HelloWorldAgain.hs" + resp <- request req + + assertJavaScriptRenderedOk resp + assertEq :: (Eq a, Show a) => a -> a -> H.Assertion assertEq = H.assertEqual "" -test_configuringSrcDir :: H.Assertion -test_configuringSrcDir = - assertEq "src" $ - (configSrcDir . buildConfig $ (under "/js" . from "src")) +assertSameElems :: (Ord a, Eq a, Show a) => [a] -> [a] -> H.Assertion +assertSameElems xs ys = assertEq (sort xs) (sort ys) + +test_configuringIncludeDirs :: H.Assertion +test_configuringIncludeDirs = + assertSameElems ["src", "src2", "src3"] $ + (configIncludeDirs . buildConfig $ + (under "/js" . from "src" . fromDirs ["src3", "src2"])) test_configuringBasePath :: H.Assertion test_configuringBasePath =