packages feed

hoe (empty) → 0.2

raw patch · 4 files changed

+193/−0 lines, 4 filesdep +basedep +cmdargsdep +hintsetup-changed

Dependencies added: base, cmdargs, hint, mtl

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c)2010, Hideyuki Tanaka++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 Hideyuki Tanaka 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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ hoe.cabal view
@@ -0,0 +1,33 @@+Name:                hoe+Version:             0.2+Synopsis:            Haskell One-liner Evaluator++Description:+  @hoe@ is a Haskell one-liner evaluator.+  It can evaluate a script in various ways depending on it's type.++License:             BSD3+License-file:        LICENSE+Author:              Hideyuki Tanaka+Maintainer:          tanaka.hideyuki@gmail.com+Copyright:           Copyright (c) 2010 Hideyuki Tanaka+Homepage:            http://github.com/tanakh/hoe+Category:            Compilers/Interpreters+Build-type:          Simple+Cabal-version:       >=1.6++Executable hoe+  Main-is:             Main.hs+  +  Build-depends:       base >= 4 && < 5,+                       hint >= 0.3.2 && < 0.3.3,+                       mtl >= 1.1 && < 1.2,+                       cmdargs >= 0.4 && < 0.5+  +  Hs-source-dirs:      src++  Ghc-options:         -Wall++Source-repository head+  Type:     git+  Location: git://github.com/tanakh/hoe.git
+ src/Main.hs view
@@ -0,0 +1,128 @@+{-# Language DeriveDataTypeable #-}++module Main (main) where++import Control.Monad hiding (join)+import Control.Monad.Error.Class+import System.Console.CmdArgs as CA+import System.IO++import Language.Haskell.Interpreter as HInt++data Option+  = Option+    { join :: Bool+    , inplace :: Maybe String+    , script :: String+    , inputFiles :: [String]+    }+  deriving (Show, Data, Typeable)++option =+  Option {+    join = def &= help "Join a type of script",+    inplace = def &= help "Edit files in place (make bkup if EXT supplied)" &= opt "" &= typ "EXT",+    script = def &= argPos 0 &= typ "SCRIPT", +    inputFiles = def &= args &= typ "FILES" }+  &= program "hoe"+  &= summary "Haskell One-liner Evaluator, (c) Hideyuki Tanaka 2010"++main :: IO ()+main = do+  opts <- cmdArgs option+  r <- evalOneLiner opts+  case r of+    Left err ->+      case err of+        WontCompile errs ->+          hPutStrLn stderr $ "compile error: " ++ unlines (map errMsg errs)+        UnknownError msg ->+          hPutStrLn stderr $ msg+        _ ->+          hPutStrLn stderr $ show err+    Right _ ->+      return ()++evalOneLiner opts = runInterpreter $ do+  reset+  setImportsQ+    [ ("Prelude", Nothing)+    , ("Control.Applicative", Nothing)+    , ("Control.Monad", Nothing)+    , ("Data.Char", Nothing)+    , ("Data.List", Nothing)+    , ("Data.Ord", Nothing)+    , ("System.IO", Nothing)+    , ("System.IO.Unsafe", Nothing)+    , ("Text.Printf", Nothing)+    ]+  set [ installedModulesInScope HInt.:= True ]+  +  let evals+        = [ evalShow+          , evalIO+          , evalIOShow+          , evalStrListToStrList+          , evalStrListToStr+          , evalStrToStrList+          , evalStrLineToStrLine+          , evalStrLineToStr+          , evalStrToStr+          , evalCharToChar+          , evalErr+          ]+  +  let intr = genInteract opts+  +  choice (if join opts then reverse evals else evals) (script opts) intr++genInteract :: Main.Option -> (String -> String) -> IO ()+genInteract opts =+  case (inputFiles opts, inplace opts) of+    ([], _) -> interact+    (files, Nothing) -> \f -> do+      forM_ files $ \file -> do+        s <- readFile file+        putStr $ f s+    (files, Just ext) -> \f -> do+      forM_ files $ \file -> do+        s <- readFile file+        when (ext /= "") $ do+          writeFile (file ++ ext) s+        length s `seq` writeFile file (f s)++choice fs s intr = foldl1 (<|>) (map (\f -> f s intr) fs)++f <|> g = catchError f (\e -> g)++evalStr s _ = do+  r <- interpret s (as :: IO String)+  liftIO $ putStrLn =<< r+evalStrI s intr = do+  r <- interpret s (as :: String -> String)+  liftIO $ intr r++evalShow s =+  evalStr $ "return $ show (" ++ s ++ ")"+evalIO s =+  evalStr $ "((" ++ s ++ ") >>= \\() -> return \"\")"+evalIOShow s =+  evalStr $ "return . show =<< (" ++ s ++ ")"+evalStrListToStrList s =+  evalStrI $ "unlines . (" ++ s ++ ") . lines"+evalStrListToStr s = do+  evalStrI $ "(++\"\\n\") . (" ++ s ++ ") . lines"+evalStrToStrList s =+  evalStrI $ "unlines . (" ++ s ++ ")"+evalStrLineToStrLine s = do+  evalStrI $ "unlines . map snd . sort . zipWith (" ++ s ++ ") [1..] . lines"+evalStrLineToStr s = do+  evalStrI $ "unlines . zipWith (" ++ s ++ ") [1..] . lines"+evalStrToStr s = do+  evalStrI $ "unlines . map (" ++ s ++ ") . lines"+evalCharToChar s = do+  evalStrI $ "map (" ++ s ++ ")"++evalErr s _ = do+  t <- typeOf s+  fail $ "cannot evaluate: " ++ t