scotty-fay 0.0.1 → 0.0.2
raw patch · 6 files changed
+75/−40 lines, 6 filesdep +filepath
Dependencies added: filepath
Files
- example/src/fay/HelloWorld.hs +0/−1
- scotty-fay.cabal +3/−2
- src/Web/Scotty/Fay.hs +10/−9
- src/Web/Scotty/Fay/Config.hs +11/−16
- src/Web/Scotty/Fay/Internal.hs +22/−5
- test/Main.hs +29/−7
example/src/fay/HelloWorld.hs view
@@ -1,4 +1,3 @@--- src/fay/HelloWorld.hs module HelloWorld where import Prelude
scotty-fay.cabal view
@@ -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
src/Web/Scotty/Fay.hs view
@@ -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
src/Web/Scotty/Fay/Config.hs view
@@ -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 }
src/Web/Scotty/Fay/Internal.hs view
@@ -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
test/Main.hs view
@@ -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 =