hoe 1.0.1 → 1.1.0
raw patch · 3 files changed
+191/−235 lines, 3 filesdep +optparse-declarativedep +textdep −cmdargsdep ~mtl
Dependencies added: optparse-declarative, text
Dependencies removed: cmdargs
Dependency ranges changed: mtl
Files
- hoe.cabal +33/−38
- src/Evaluator.hs +74/−59
- src/HOE.hs +84/−138
hoe.cabal view
@@ -1,38 +1,33 @@-Name: hoe-Version: 1.0.1-Synopsis: hoe: Haskell One-liner Evaluator--Description:- @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: (c) 2010-2015, Hideyuki Tanaka-Homepage: http://github.com/tanakh/hoe-Category: Compilers/Interpreters-Build-type: Simple-Cabal-version: >=1.8--Source-repository head- Type: git- Location: git://github.com/tanakh/hoe.git--Executable hoe- Main-is: HOE.hs-- Other-Modules: Evaluator-- 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+name: hoe +version: 1.1.0 +synopsis: hoe: Haskell One-liner Evaluator +description: Please see README.md +homepage: http://github.com/tanakh/hoe +license: BSD3 +license-file: LICENSE +author: Hideyuki Tanaka +maintainer: tanaka.hideyuki@gmail.com +copyright: (c) 2010-2015, Hideyuki Tanaka +category: Compilers/Interpreters +build-type: Simple +cabal-version: >=1.10 + +executable hoe + hs-source-dirs: src + main-is: HOE.hs + other-modules: Evaluator + ghc-options: -Wall + build-depends: base >= 4.7 && < 5 + , exceptions + , hint >= 0.4.2 + , mtl + , optparse-declarative >= 0.3 + , regex-posix + , split + , text + , time + default-language: Haskell2010 + +source-repository head + type: git + location: git://github.com/tanakh/hoe.git
src/Evaluator.hs view
@@ -1,59 +1,74 @@-module Evaluator (- Script,- Evaluator,- evals- ) where--import Language.Haskell.Interpreter--type Script = String -> IO String-type Evaluator = String -> Interpreter Script--types :: Bool -> [(String, String, String, String)]-types isInput- | isInput = ss ++ reverse (vs "Read r")- | otherwise = reverse ss ++ reverse (vs "Show s")- where- ss =- [ ("String", "string", "id", "id")- , ("[String]", "lines", "lines", "unlines")- , ("[[String]]", "table", "map words . lines", "unlines . map unwords")- ]- vs t =- [ (t, "value", "read", "(++ \"\\n\") . show")- , ("[" ++ t ++ "]", "value lines", "map read . lines", "unlines . map show")- , ("[[" ++ t ++ "]]", "value table", "map (map read . words) . lines", "unlines . map (unwords . map show)")- ]--evals :: [(String, String, Evaluator)]-evals =- [ evaluator "IO ()" "execute action"- (\expr -> "\\_ -> " ++ expr ++ " >>= \\() -> return \"\"")- , evaluator "Char -> Char" "map input string"- (\expr -> "return . map " ++ expr)- ] ++- [ evaluator outputType ("output " ++ outputDescr)- (\expr -> "\\_ -> return . " ++ outputCode ++ " $ " ++ expr)- | (outputType, outputDescr, _, outputCode) <- types False- ] ++- [ evaluator ("IO " ++ outputType) ("output result" ++ outputDescr)- (\expr -> "\\_ -> return . " ++ outputCode ++ " =<< " ++ expr)- | (outputType, outputDescr, _, outputCode) <- types False- ] ++- [ evaluator- (inputType ++ " -> " ++ outputType)- ("transform " ++ inputDescr ++ " to " ++ outputDescr)- (\expr -> "return . " ++ outputCode ++ " . " ++ expr ++ " . " ++ inputCode)- | (inputType, inputDescr, inputCode, _) <- types True- , (outputType, outputDescr, _, outputCode) <- types False- ] ++- [ ( "a", "error", evalErr ) ]--evaluator :: String -> String -> (String -> String) -> (String, String, Evaluator)-evaluator typ description templ =- (typ, description, \expr -> interpret (templ $ "(" ++ expr ++ ")") (as :: Script))--evalErr :: Evaluator-evalErr expr = do- typ <- typeOf expr- fail $ "cannot evaluate type of: " ++ typ+{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TupleSections #-} + +module Evaluator + ( Script + , Evaluator + , evals + , compile + ) where + +import Control.Applicative +import Control.Monad.Catch +import Language.Haskell.Interpreter + +type Script = String -> IO String +type Evaluator = String -> Interpreter Script + +types :: Bool -> [(String, String, String, String)] +types isInput + | isInput = ss ++ reverse (vs "Read r") + | otherwise = reverse ss ++ reverse (vs "Show s") + where + ss = + [ ("String", "string", "id", "id") + , ("[String]", "lines", "lines", "unlines") + , ("[[String]]", "table", "map words . lines", "unlines . map unwords") + ] + vs t = + [ (t, "value", "read", "(++ \"\\n\") . show") + , ("[" ++ t ++ "]", "value lines", "map read . lines", "unlines . map show") + , ("[[" ++ t ++ "]]", "value table", "map (map read . words) . lines", "unlines . map (unwords . map show)") + ] + +evals :: [(String, String, Evaluator)] +evals = + [ evaluator "IO ()" "execute action" + (\expr -> "\\_ -> " ++ expr ++ " >>= \\() -> return \"\"") + , evaluator "Char -> Char" "map input string" + (\expr -> "return . map " ++ expr) + ] ++ + [ evaluator outputType ("output " ++ outputDescr) + (\expr -> "\\_ -> return . " ++ outputCode ++ " $ " ++ expr) + | (outputType, outputDescr, _, outputCode) <- types False + ] ++ + [ evaluator ("IO " ++ outputType) ("output result " ++ outputDescr) + (\expr -> "\\_ -> return . " ++ outputCode ++ " =<< " ++ expr) + | (outputType, outputDescr, _, outputCode) <- types False + ] ++ + [ evaluator + (inputType ++ " -> " ++ outputType) + ("transform " ++ inputDescr ++ " to " ++ outputDescr) + (\expr -> "return . " ++ outputCode ++ " . " ++ expr ++ " . " ++ inputCode) + | (inputType, inputDescr, inputCode, _) <- types True + , (outputType, outputDescr, _, outputCode) <- types False + ] ++ + [ ( "a", "error", evalErr ) ] + +evaluator :: String -> String -> (String -> String) -> (String, String, Evaluator) +evaluator typ description templ = + (typ, description, \expr -> interpret (templ $ "(" ++ expr ++ ")") (as :: Script)) + +evalErr :: Evaluator +evalErr expr = do + typ <- typeOf expr + fail $ "cannot evaluate type of: " ++ typ + +compile :: String -> Interpreter (String, String, Script) +compile script = + choice [ (ty, descr, ) <$> comp script + | (ty, descr, comp) <- evals + ] + +choice :: [Interpreter a] -> Interpreter a +choice = foldl1 $ \a b -> catch a (\(_e :: SomeException) -> b)
src/HOE.hs view
@@ -1,138 +1,84 @@-{-# 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+{-# LANGUAGE DataKinds #-} + +module Main (main) where + +import Control.Monad +import Control.Monad.Trans +import Data.Version (showVersion) +import Language.Haskell.Interpreter hiding (get) +import Options.Declarative +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 + ] + +hoe :: Flag "i" '["inplace"] "EXT" "Edit files in-place (make backup if EXT is not null)" (Maybe String) + -> Arg "SCRIPT" String + -> Arg "[FILES]" [String] + -> Flag "m" '["mod"] "MODULES" "Import modules before running the script" (Def "" String) + -> Cmd "hoe: Haskell One-liner Evaluator" () +hoe inplace script files modules = do + compiled <- liftIO $ runInterpreter $ do + reset + setImportsQ $ + [ (m, Nothing) | m <- imports ] ++ + [ (m, Nothing) | m <- words $ get modules ] + set [ installedModulesInScope := True ] + compile $ get script + + case compiled of + Left (WontCompile errs) -> + liftIO $ hPutStr stderr $ "compile error: " ++ unlines (map errMsg errs) + Left (UnknownError msg) -> + liftIO $ hPutStrLn stderr msg + Left err -> + liftIO $ hPrint stderr err + + Right (ty, descr, f) -> do + logStr 1 $ "Interpret as: " ++ ty ++ " :: " ++ descr + liftIO $ exec (get files) (get inplace) f + +exec :: [String] -> Maybe String -> Script -> IO () +exec [] _ f = putStr =<< f =<< getContents +exec files mbext f = + forM_ files $ \file -> do + s <- readFile file + case mbext of + Nothing -> putStr =<< f s + Just ext -> do + when (ext /= "") $ writeFile (file ++ "." ++ ext) s + length s `seq ` writeFile file =<< f s + +main :: IO () +main = run "hoe" (Just $ showVersion version) hoe