zoom (empty) → 0.1
raw patch · 9 files changed
+297/−0 lines, 9 filesdep +basedep +directorydep +filepathsetup-changed
Dependencies added: base, directory, filepath, ghc, hamlet, hint, mtl, template-haskell, text
Files
- LICENSE +30/−0
- Main.hs +12/−0
- Setup.hs +2/−0
- Zoom/Interpreter.hs +124/−0
- Zoom/Task.hs +10/−0
- Zoom/Task/Demo.hs +6/−0
- Zoom/Template.hs +10/−0
- Zoom/Template/TH.hs +31/−0
- zoom.cabal +72/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c)2011, Ian Duncan++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 Ian Duncan 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.
+ Main.hs view
@@ -0,0 +1,12 @@+module Main where+import Zoom.Interpreter+-- import System.Console.GetOpt +import Zoom.Task+import System.Environment++main = do + args <- getArgs+ result <- runZoomInterpreter $ map Args args+ case result of+ Left err -> putStrLn $ show err+ Right _ -> return ()
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ Zoom/Interpreter.hs view
@@ -0,0 +1,124 @@+module Zoom.Interpreter where+import Language.Haskell.Interpreter+import qualified GHC+import PackageConfig+import UniqFM+import qualified HscTypes as GHC+import Packages+import Control.Monad+import Control.Monad.Trans+import System.Directory+import System.FilePath+import Data.Monoid+import Zoom.Task+import Data.Maybe+import qualified Data.List as L+++ifM :: (Monad m, Monoid md) => m Bool -> md -> m md+ifM m x = do+ result <- m+ return $ if result+ then x+ else mempty++qualifyModule x = L.stripPrefix "Zoom.Task." x+qualifyFunctions (m, fs) = map (qualifyFun qualifyAs) fs+ where qualifyAs = fromMaybe m (qualifyModule m)++defaultModules = [("Prelude", Nothing), ("Zoom.Task", Just "Zoom.Task")]++ghcGetAvailableModules :: GHC.GhcMonad m => m [GHC.ModuleName]+ghcGetAvailableModules = do+ dflags <- GHC.getSessionDynFlags+ let pkg_db = pkgIdMap (GHC.pkgState dflags)+ return $ concat (map exposedModules (filter exposed (eltsUFM pkg_db)))+ +getAvailableModules :: MonadInterpreter m => m [ModuleName]+getAvailableModules = liftM (map GHC.moduleNameString) $ runGhc ghcGetAvailableModules++-- | entry point for the standard zoom interpreter+interpreterMain :: [Args] -> Interpreter ()+interpreterMain args = do+ set [ languageExtensions := [TemplateHaskell, QuasiQuotes]+ , searchPath := ["./tasks"]]+ loadLocalTaskModules+ qualified <- importZoomTasks+ tasks <- availableTasks qualified+ dispatchArgs tasks args++qualifyFun q f = q ++ ('.':f)++filterTaskFuns :: [String] -> Interpreter [String]+filterTaskFuns fs = do+ tasks <- filterM (\f -> typeOf f >>= \t -> return $ L.isPrefixOf "Zoom.Task" t) fs+ return tasks++-- | loads up modules located in the task subdirectory of the current directory.+-- note that this currently needs to be run before loading global tasks.+loadLocalTaskModules :: Interpreter () +loadLocalTaskModules = do+ dirs <- liftIO getTaskDirs+ allDirPaths <- liftIO $ mapM getAndQualifyContents dirs+ allModulePaths <- liftIO $ filterM (fmap not . doesDirectoryExist) $ join allDirPaths+ loadModules allModulePaths+ +-- | imports both local and global Zoom.Task.* modules. +-- returns the qualified module names of all Zoom.Task.* modules.+importZoomTasks :: Interpreter [ModuleName]+importZoomTasks = do+ localModules <- getLoadedModules+ globalModules <- getAvailableModules+ let + zoomModules = filter (L.isPrefixOf "Zoom.Task.") (localModules ++ globalModules)+ qualifiedModules = defaultModules ++ zip zoomModules (map qualifyModule zoomModules)+ setImportsQ qualifiedModules+ return zoomModules++getFunctionsFromImports :: [ModuleName] -> Interpreter [(ModuleName, [String])]+getFunctionsFromImports imps = do + exports <- mapM getModuleExports imps+ let pairs = zip imps $ map (map name . filter isFunction) exports+ return pairs+ +runZoomInterpreter :: [Args] -> IO (Either InterpreterError ())+runZoomInterpreter args = runInterpreter (interpreterMain args)+++isFunction x = case x of + Fun _ -> True+ _ -> False+ +executeTask x = interpret ("\\args -> (Zoom.Task.fromTask " ++ x ++ ") args >> return ()") (as :: [Args] -> IO ())++printTaskDescription taskName = do+ description <- interpret ("Zoom.Task.desc " ++ taskName) (as :: String)+ liftIO $ putStrLn description+-- get current working directory+-- TODO recurse all the way to home, getting tasks for each level.+-- TODO also, get them from some global location+getTaskDirs = do+ current <- getCurrentDirectory+ let taskDir = current </> "tasks"+ ifM (doesDirectoryExist taskDir) [taskDir]++getAndQualifyContents dir = do+ contents <- getDirectoryContents dir+ let realContents = filter (`notElem` [".", ".."]) contents+ return $ map (dir </>) realContents+ +availableTasks :: [String] -> Interpreter [String]+availableTasks qualified = do+ modsWithFuns <- getFunctionsFromImports qualified+ let qualifiedFuns = join $ map qualifyFunctions modsWithFuns+ filterTaskFuns qualifiedFuns++printAvailableTasks taskNames = do+ mapM_ (\t -> liftIO (putStr (t ++ ": ")) >> printTaskDescription t) $ taskNames++dispatchArgs availableTasks args = case args of+ [] -> do+ printAvailableTasks availableTasks+ (Args x):xs -> do + task <- executeTask x+ liftIO $ task xs
+ Zoom/Task.hs view
@@ -0,0 +1,10 @@+{-# LANGUAGE DeriveDataTypeable #-}+module Zoom.Task where+import Data.Typeable++data Args = Args String+ deriving (Show, Typeable)+ +data ZoomTask a = Task {desc :: String, fromTask :: [Args] -> IO a}+ deriving (Typeable)+
+ Zoom/Task/Demo.hs view
@@ -0,0 +1,6 @@+module Zoom.Task.Demo where+import Zoom.Task++demo = Task "Prints out the string, \"This is a demo!\"" $ \ args -> do+ putStrLn "This is a demo!"+
+ Zoom/Template.hs view
@@ -0,0 +1,10 @@+{-# LANGUAGE TemplateHaskell, QuasiQuotes #-}+module Zoom.Template (render, zoom, zoomFile) where+import Zoom.Template.TH++exampleHelper :: Int+exampleHelper = 21++example foo = render [zoom|Hi, my name is #{"Ian"}.+I am #{show exampleHelper} years old.+I also would like to say, "#{foo}".|]
+ Zoom/Template/TH.hs view
@@ -0,0 +1,31 @@+{-# LANGUAGE TemplateHaskell, QuasiQuotes, FlexibleInstances #-}+{-# OPTIONS_GHC -fno-warn-missing-fields #-}+module Zoom.Template.TH (render, zoom, zoomFile) where+import Language.Haskell.TH.Syntax+import Language.Haskell.TH.Quote+import Text.Romeo+import qualified Data.Text as TS+import qualified Data.Text.Lazy as TL+import Data.Text.Lazy.Builder++class ToZoomTemplate a where+ toZoom :: a -> Builder+instance ToZoomTemplate [Char] where toZoom = fromLazyText . TL.pack+instance ToZoomTemplate TS.Text where toZoom = fromText+instance ToZoomTemplate TL.Text where toZoom = fromLazyText++render x = x undefined++defaultZoomSettings = do+ wr <- [|id|]+ unwr <- [|id|]+ toZoomExpr <- [| toZoom |]+ return $ defaultRomeoSettings {toBuilder = toZoomExpr, wrap = wr, unwrap = unwr}+ +zoom = QuasiQuoter {quoteExp = \s -> do+ rs <- defaultZoomSettings+ quoteExp (romeo rs) s+ }+zoomFile fp = do + zs <- defaultZoomSettings+ romeoFile zs fp
+ zoom.cabal view
@@ -0,0 +1,72 @@+-- zoom.cabal auto-generated by cabal init. For additional options,+-- see+-- http://www.haskell.org/cabal/release/cabal-latest/doc/users-guide/authors.html#pkg-descr.+-- The name of the package.+Name: zoom++-- The package version. See the Haskell package versioning policy+-- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for+-- standards guiding when and how versions should be incremented.+Version: 0.1++-- A short (one-line) description of the package.+Synopsis: A rake/thor-like task runner written in Haskell++-- A longer description of the package.+Description: See documentation on the project homepage for more information++-- URL for the project homepage or repository.+Homepage: github.com/iand675/Zoom++-- The license under which the package is released.+License: BSD3++-- The file containing the license text.+License-file: LICENSE++-- The package author(s).+Author: Ian Duncan++-- An email address to which users can send suggestions, bug reports,+-- and patches.+Maintainer: iand675@gmail.com++-- A copyright notice.+-- Copyright: ++Category: Distribution++Build-type: Simple++-- Extra files to be distributed with the package, such as examples or+-- a README.+-- Extra-source-files: ++-- Constraint on the version of Cabal needed to build this package.+Cabal-version: >=1.2++Library+ Build-depends: ghc >= 7.0.3 && < 7.2,+ base >= 4.3 && < 5, + hamlet >= 0.8.2 && < 0.10, + text >= 0.11 && < 0.13, + template-haskell >= 2.5 && < 2.6+ Exposed-Modules: Zoom.Task, Zoom.Template, Zoom.Interpreter, Zoom.Task.Demo+ Other-Modules: Zoom.Template.TH+Executable zoom+ -- .hs or .lhs file containing the Main module.+ Main-is: Main.hs+ + -- Packages needed in order to build this package.+ Build-depends: ghc >= 7.0.3 && < 7.2, + base >= 4.3 && < 5, + hint >= 0.3 && < 0.4, + mtl >= 2.0.1 && < 2.0.3, + filepath >= 1.2.0 && < 1.4.0, + directory >= 1.1.0 && < 1.3.0+ + -- Modules not exported by this package.+ Other-modules: Zoom.Task, Zoom.Interpreter+ + -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source.+ -- Build-tools: