Permalink
Browse files

Initial commit. Functioning!

  • Loading branch information...
1 parent b338dc3 commit e94b997ee5463f9ce2e64b0fe725bcae29ba2b22 @bergmark bergmark committed Aug 9, 2012
Showing with 291 additions and 155 deletions.
  1. +51 −0 README.md
  2. +0 −73 fay-mover.cabal
  3. +59 −0 snaplet-fay.cabal
  4. +0 −41 src/Fay/Mover.hs
  5. +0 −31 src/Fay/Mover/Util.hs
  6. +44 −0 src/Snap/Snaplet/Fay.hs
  7. +75 −0 src/Snap/Snaplet/Fay/Internal.hs
  8. +45 −10 src/Test.hs
  9. +1 −0 test-files/Imported.hs
  10. +3 −0 test-files/Importing.hs
  11. +13 −0 test-files/alert.hs
View
@@ -0,0 +1,51 @@
+Snaplet Fay
+===========
+
+Snaplet Fay integrates [Snap](http://www.snapframework.com) with
+[Fay](http://www.fay-lang.org). Snap is a
+[Haskell](http://www.haskell.org) web framework and Fay is a compiler
+for a proper subset of Haskell to JavaScript. Snaplet Fay integrates
+them nicely with each other allowing automatic (re)compilation of Fay
+source files. Snap provides this for both static content and haskell
+sources preventing web server restarts and here we add Fay to this
+list as well. Now we can seamlessly code Haskell for both front-end
+and back-end.
+
+Installation
+------------
+
+You will need Haskell, Snap and Fay installed. The simplest way to get
+up and running with Haskell is to install
+[The Haskell Platform](http://hackage.haskell.org/platform/).
+
+Snap and Fay are available on hackage:
+
+```
+cabal install snap fay
+```
+
+Clone this repository and install the package:
+```
+cabal install
+````
+
+Development Status
+------------------
+
+Snaplet Fay is functioning as is and will be updated to keep up with
+both Snap and Fay.
+
+
+Contributions
+-----------
+
+Fork on!
+
+Any enhancements are welcome.
+
+To run the tests, do:
+```
+cabal configure -ftest
+cabal build
+./dist/build/test/test
+```
View
@@ -1,73 +0,0 @@
--- Initial fay-mover.cabal generated by cabal init. For further
--- documentation, see http://haskell.org/cabal/users-guide/
-
--- The name of the package.
-name: fay-mover
-
--- The package version. See the Haskell package versioning policy (PVP)
--- for standards guiding when and how versions should be incremented.
--- http://www.haskell.org/haskellwiki/Package_versioning_policy
--- PVP summary: +-+------- breaking API changes
--- | | +----- non-breaking API additions
--- | | | +--- code changes with no API change
-version: 0.1.0.0
-
--- A short (one-line) description of the package.
-synopsis: Helper script for running fay on js files and moving them
-
--- A longer description of the package.
--- description:
-
--- The license under which the package is released.
-license: BSD3
-
--- The file containing the license text.
-license-file: LICENSE
-
--- The package author(s).
-author: Adam Bergmark
-
--- An email address to which users can send suggestions, bug reports, and
--- patches.
-maintainer: adam@edea.se
-
--- A copyright notice.
--- copyright:
-
-category: Web
-
-build-type: Simple
-
--- Constraint on the version of Cabal needed to build this package.
-cabal-version: >=1.8
-
-
-library
- ghc-options: -Wall
- hs-source-dirs: src
-
- -- Modules exported by the library.
- exposed-modules:
- Fay.Mover
-
- -- Modules included in this library but not exported.
- -- other-modules:
- Fay.Mover.Util
-
- -- Other library packages from which modules are imported.
- build-depends:
- base == 4.5.*,
- process == 1.1.*,
- filepath == 1.3.*,
- directory == 1.1.*
-
-Executable fay-mover-test
- ghc-options: -Wall
- hs-source-dirs: src
- main-is: Test.hs
-
- build-depends:
- base == 4.5.*,
- process == 1.1.*,
- filepath == 1.3.*,
- directory == 1.1.*
View
@@ -0,0 +1,59 @@
+name: snaplet-fay
+-- The package version. See the Haskell package versioning policy (PVP)
+-- for standards guiding when and how versions should be incremented.
+-- http://www.haskell.org/haskellwiki/Package_versioning_policy
+-- PVP summary: +-+------- breaking API changes
+-- | | +----- non-breaking API additions
+-- | | | +--- code changes with no API change
+version: 0.1.0.0
+synopsis: Fay integration for Snap that provides automatic (re)compilation during development
+license: BSD3
+license-file: LICENSE
+author: Adam Bergmark
+maintainer: adam@edea.se
+category: Web
+build-type: Simple
+cabal-version: >=1.8
+
+Flag test
+ Description: Whether to build the test executable
+ Default: False
+
+library
+ ghc-options: -Wall
+ hs-source-dirs: src
+
+ exposed-modules:
+ Snap.Snaplet.Fay
+
+ other-modules:
+ Snap.Snaplet.Fay.Internal
+
+ build-depends:
+ base == 4.5.*,
+ data-default == 0.5.*,
+ directory == 1.1.*,
+ fay == 0.5.*,
+ filepath == 1.3.*,
+ mtl == 2.1.*,
+ snap == 0.9.*,
+ snap-core == 0.9.*
+
+
+
+Executable test
+ if !flag(test)
+ buildable: False
+ ghc-options: -Wall
+ hs-source-dirs: src
+ main-is: Test.hs
+
+ build-depends:
+ base == 4.5.*,
+ data-default == 0.5.*,
+ directory == 1.1.*,
+ fay == 0.5.*,
+ filepath == 1.3.*,
+ mtl == 2.1.*,
+ snap == 0.9.*,
+ snap-core == 0.9.*
View
@@ -1,41 +0,0 @@
-{-# LANGUAGE DeriveDataTypeable #-}
-
-module Fay.Mover (
- Config (..)
- , buildFay
- ) where
-
-import Control.Applicative
-import Control.Monad
-import Data.Typeable
-import System.Directory
-import System.Exit
-import System.FilePath
-import System.Process
-
-import Fay.Mover.Util
-
--- import qualified Language.Fay.Compiler as Fay
-
--- | Configuration
-
-data Config = Config {
- srcDir :: FilePath
- , destDir :: FilePath
- , includeDirs :: [FilePath]
- } deriving Typeable
-
--- | Build
-
-buildFay :: Config -> IO ()
-buildFay config = do
- files <- extFiles "hs" (srcDir config)
- forM_ files $ \f -> do
- let dest = (destDir config </> filename (toJsName f))
- putStrLn $ "compiling " ++ filename f
- code <- system $ "fay -include=" ++ intercalate "," includeDirs ++ "-autorun \"" ++ f ++ "\""
- if (code == ExitSuccess) then do
- putStrLn $ "OK"
- renameFile (toJsName f) dest
- else
- putStrLn $ "FAIL"
View
@@ -1,31 +0,0 @@
-{-# LANGUAGE ViewPatterns #-}
-
-module Fay.Mover.Util where
-
-import Control.Applicative
-import Control.Monad
-import System.Directory
-import System.Exit
-import System.FilePath
-import System.Process
-
--- | Generic Helpers
-
-hasPrefix :: String -> String -> Bool
-hasPrefix s prefix = prefix == take (length prefix) s
-
-hasSuffix :: String -> String -> Bool
-hasSuffix s suffix = reverse suffix == take (length suffix) (reverse s)
-
-filename :: FilePath -> FilePath
-filename = reverse . takeWhile (/= '/') . reverse
-
--- | Convert a Haskell filename to a JS filename.
-toJsName :: String -> String
-toJsName x = case reverse x of
- ('s':'h':'.': (reverse -> file)) -> file ++ ".js"
- _ -> x
-
--- | Gets all files with the given file extension in a folder.
-extFiles :: String -> FilePath -> IO [FilePath]
-extFiles ext dir = map (dir </>) . filter (`hasSuffix` ('.' : ext)) <$> getDirectoryContents dir
View
@@ -0,0 +1,44 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# OPTIONS -fno-warn-name-shadowing #-}
+
+module Snap.Snaplet.Fay (
+ Fay
+ , initFay
+ , fayServe
+ ) where
+
+
+import Control.Monad
+import Control.Monad.Reader
+import Control.Monad.State.Class
+import Snap.Snaplet
+import Snap.Util.FileServe
+import System.Directory
+
+import Snap.Snaplet.Fay.Internal
+
+-- | Snaplet initialization
+
+initFay :: FilePath -- ^ The location of the Fay source files
+ -> Bool -- ^ Print information when compiling or deleting files
+ -> SnapletInit b Fay
+initFay srcDir verbose =
+ makeSnaplet "fay"
+ "Fay integration that provides automatic (re)compilation during development"
+ Nothing $
+ do
+ fp <- getSnapletFilePath
+ dirExists <- liftIO $ doesDirectoryExist fp
+ -- Create the snaplet directory
+ unless dirExists . liftIO $ createDirectory fp
+ return $ Fay srcDir fp [srcDir] verbose
+
+
+-- | Serves the compiled Fay scripts
+
+fayServe :: Handler b Fay ()
+fayServe = do
+ s <- getSnapletFilePath
+ cfg <- get
+ liftIO (buildFay cfg)
+ serveDirectory s
@@ -0,0 +1,75 @@
+{-# LANGUAGE ViewPatterns #-}
+
+module Snap.Snaplet.Fay.Internal where
+
+import Control.Applicative
+import Control.Monad
+import Data.Default
+import qualified Language.Fay.Compiler as F
+import qualified Language.Fay.Types as F
+import System.Directory
+import System.FilePath
+
+
+-- | Configuration
+
+data Fay = Fay {
+ srcDir :: FilePath
+ , destDir :: FilePath
+ , includeDirs :: [FilePath]
+ , verbose :: Bool
+ }
+
+
+-- | Checks the specified source folder and compiles all new and modified scripts.
+-- Also removes any js files whose Fay source has been deleted.
+-- At the moment all files are checked each request. This will change.
+
+buildFay :: Fay -> IO ()
+buildFay config = do
+ -- Compile/recompile all hs files that don't have a corresponding js
+ -- file or has been updated since the js file was last compiled.
+ files <- do
+ fs <- extFiles "hs" (srcDir config)
+ flip filterM fs $ \f -> do
+ jsExists <- doesFileExist (jsPath f)
+ if not jsExists
+ then return True
+ else do
+ hsmod <- getModificationTime f
+ jsmod <- getModificationTime (jsPath f)
+ return $ hsmod > jsmod
+
+ forM_ files $ \f -> do
+ when (verbose config) $ putStrLn ("compiling " ++ filename f)
+ F.compileFromTo (def { F.configDirectoryIncludes = includeDirs config }) True f (jsPath f)
+
+ -- Remove js files that don't have a corresponding source hs file
+ oldFiles <- extFiles "js" (destDir config) >>= filterM (liftM not . doesFileExist . hsPath)
+ forM_ oldFiles $ \f -> removeFile f >> when (verbose config) (putStrLn $ "Removed " ++ f)
+
+ where
+ -- Convert back and forth between the filepaths of hs and js files
+ jsPath f = destDir config </> filename (F.toJsName f)
+ hsPath f = srcDir config </> filename (toHsName f)
+
+
+-- | Helpers
+
+-- | Checks if a string ends with another string
+hasSuffix :: String -> String -> Bool
+hasSuffix s suffix = reverse suffix == take (length suffix) (reverse s)
+
+-- | Extract the filename from a filepath
+filename :: FilePath -> FilePath
+filename = reverse . takeWhile (/= '/') . reverse
+
+-- | Convert a JS filename to a Haskell filename
+toHsName :: String -> String
+toHsName x = case reverse x of
+ ('s':'j':'.': (reverse -> file)) -> file ++ ".hs"
+ _ -> x
+
+-- | Gets the filepath of the files with the given file extension in a folder
+extFiles :: String -> FilePath -> IO [FilePath]
+extFiles ext dir = map (dir </>) . filter (`hasSuffix` ('.' : ext)) <$> getDirectoryContents dir
Oops, something went wrong.

0 comments on commit e94b997

Please sign in to comment.