hoe 0.2 → 1.0
raw patch · 3 files changed
+159/−146 lines, 3 filesdep +exceptionsdep +regex-posixdep +splitdep ~basedep ~cmdargsdep ~hint
Dependencies added: exceptions, regex-posix, split, time
Dependency ranges changed: base, cmdargs, hint, mtl
Files
- hoe.cabal +21/−18
- src/HOE.hs +138/−0
- src/Main.hs +0/−128
hoe.cabal view
@@ -1,33 +1,36 @@ Name: hoe-Version: 0.2-Synopsis: Haskell One-liner Evaluator+Version: 1.0+Synopsis: hoe: 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.+ @hoe@ is AWK like text processor.+ This can evaluate scripts in various ways depending on types. License: BSD3 License-file: LICENSE Author: Hideyuki Tanaka Maintainer: tanaka.hideyuki@gmail.com-Copyright: Copyright (c) 2010 Hideyuki Tanaka+Copyright: (c) 2010-2015, 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+Cabal-version: >=1.8 Source-repository head Type: git Location: git://github.com/tanakh/hoe.git++Executable hoe+ Main-is: HOE.hs++ Build-depends: base >= 4.7 && < 5+ , cmdargs+ , exceptions+ , hint >= 0.4.2+ , mtl == 2.*+ , regex-posix+ , split+ , time++ Hs-source-dirs: src+ Ghc-options: -Wall
+ src/HOE.hs view
@@ -0,0 +1,138 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TupleSections #-}++module Main (main) where++import Control.Applicative+import Control.Monad+import Control.Monad.Catch+import Data.Version (showVersion)+import Language.Haskell.Interpreter (OptionVal ((:=)))+import Language.Haskell.Interpreter hiding (Option, name)+import System.Console.CmdArgs as CA hiding ((:=))+import System.Exit (exitFailure)+import System.IO++import Evaluator+import Paths_hoe (version)++imports :: [String]+imports =+ [ "Prelude"++ -- from base+ , "Control.Applicative"+ , "Control.Arrow"+ , "Control.Monad"+ , "Data.Bits"+ , "Data.Char"+ , "Data.Complex"+ , "Data.Either"+ , "Data.Function"+ , "Data.List"+ , "Data.Maybe"+ , "Data.Monoid"+ , "Data.Ord"+ , "Data.Ratio"+ , "Numeric"+ , "System.IO"+ , "System.IO.Unsafe"+ , "System.Info"+ , "System.Random"+ , "Text.Printf"++ -- other common modules+ , "Data.List.Split" -- from split+ , "Data.Time" -- from time+ , "Text.Regex.Posix" -- from regex-posix+ ]++data Option+ = Option+ { inplace :: Maybe String+ , script :: String+ , inputFiles :: [String]+ , modules :: [String]+ }+ deriving (Show, Data, Typeable)++option :: Option+option = Option+ { inplace =+ def &= help "Edit files in place (make backup if EXT supplied)" &= opt "" &= typ "EXT"+ , script =+ def &= argPos 0 &= typ "SCRIPT"+ , inputFiles =+ def &= args &= typ "FILES"+ , modules =+ def &= help "Import a module before running the script"+ &= opt ""+ &= explicit+ &= name "mod"+ &= name "m"+ }+ &= verbosity+ &= program "hoe"+ &= summary ("hoe-" ++ showVersion version ++ " Haskell One-liner Evaluator, (c) Hideyuki Tanaka")+ &= details [ "The Awk like text processor, but it can use Haskell."+ , ""+ ]++printLog :: String -> IO ()+printLog msg = whenLoud $ hPutStrLn stderr msg++main :: IO ()+main = do+ opts <- cmdArgs option+ r <- evalOneLiner opts+ case r of+ Left err -> do+ case err of+ WontCompile errs ->+ hPutStrLn stderr $ "compile error: " ++ unlines (map errMsg errs)+ UnknownError msg ->+ hPutStrLn stderr msg+ _ ->+ hPrint stderr err+ exitFailure+ Right _ ->+ return ()++evalOneLiner :: Option -> IO (Either InterpreterError ())+evalOneLiner opts = runInterpreter $ do+ reset+ setImportsQ $+ [ (m, Nothing) | m <- imports ] +++ [ (m, Nothing) | m <- modules opts ]+ set [ installedModulesInScope := True ]++ (ty, descr, f) <-+ choice [ (ty, descr, ) <$> compile (script opts)+ | (ty, descr, compile) <- evals+ ]++ liftIO $ printLog $ "Interpret as: " ++ ty ++ " :: " ++ descr+ liftIO $ exec opts f++choice :: [Interpreter a] -> Interpreter a+choice = foldl1 $ \a b -> catch a (\(_e :: SomeException) -> b)++exec :: Main.Option -> Script -> IO ()+exec opts f =+ case (inputFiles opts, inplace opts) of+ ([], _) -> do+ s <- getContents+ putStr =<< f s++ (files, Nothing) ->+ forM_ files $ \file -> do+ s <- readFile file+ putStr =<< f s++ (files, Just ext) ->+ forM_ files $ \file -> do+ s <- readFile file+ when (ext /= "") $+ writeFile (file ++ "." ++ ext) s+ length s `seq` writeFile file =<< f s
− src/Main.hs
@@ -1,128 +0,0 @@-{-# 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