Permalink
Browse files

initial commit. Works.

  • Loading branch information...
0 parents commit b338dc3565ce6a7a264e5e9823beb42881666053 @bergmark bergmark committed Aug 9, 2012
Showing with 202 additions and 0 deletions.
  1. +2 −0 .gitignore
  2. +30 −0 LICENSE
  3. +2 −0 Setup.hs
  4. +73 −0 fay-mover.cabal
  5. +41 −0 src/Fay/Mover.hs
  6. +31 −0 src/Fay/Mover/Util.hs
  7. +23 −0 src/Test.hs
@@ -0,0 +1,2 @@
+dist
+test-dest
30 LICENSE
@@ -0,0 +1,30 @@
+Copyright (c) 2012, Adam Bergmark
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+ * Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+
+ * Redistributions in binary form must reproduce the above
+ copyright notice, this list of conditions and the following
+ disclaimer in the documentation and/or other materials provided
+ with the distribution.
+
+ * Neither the name of Adam Bergmark nor the names of other
+ contributors may be used to endorse or promote products derived
+ from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
@@ -0,0 +1,73 @@
+-- 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.*
@@ -0,0 +1,41 @@
+{-# 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"
@@ -0,0 +1,31 @@
+{-# 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
@@ -0,0 +1,23 @@
+module Main where
+
+import Control.Applicative
+import Control.Monad
+import System.Directory
+
+import Fay.Mover
+import Fay.Mover.Util
+
+config :: Config
+config = Config {
+ srcDir = "/Users/adam/repos/fay/examples"
+ , destDir = "/Users/adam/repos/fay-mover/test-dest"
+ }
+
+main :: IO ()
+main = do
+ mapM removeFile =<< (extFiles "js" . destDir) config
+ buildFay config
+ len <- length <$> extFiles "js" (destDir config)
+ putStrLn $ if len == 0
+ then "Test Failed, destination folder is empty"
+ else "Test OK"

0 comments on commit b338dc3

Please sign in to comment.