diff --git a/hoe.cabal b/hoe.cabal --- a/hoe.cabal +++ b/hoe.cabal @@ -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 diff --git a/src/HOE.hs b/src/HOE.hs new file mode 100644 --- /dev/null +++ b/src/HOE.hs @@ -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 diff --git a/src/Main.hs b/src/Main.hs deleted file mode 100644 --- a/src/Main.hs +++ /dev/null @@ -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