hesh 1.2.0 → 1.3.0
raw patch · 3 files changed
+27/−23 lines, 3 filesdep ~hesh
Dependency ranges changed: hesh
Files
- hesh.cabal +2/−2
- hesh/Main.hs +24/−18
- lib/Hesh/Shell.hs +1/−3
hesh.cabal view
@@ -1,5 +1,5 @@ name: hesh-version: 1.2.0+version: 1.3.0 synopsis: the Haskell Extensible Shell: Haskell for Bash-style scripts description: Hesh makes writing scripts in Haskell easier by providing Bash-style syntax for running commands, implicit module imports, and automatic dependency inference and Cabal file generation. It allows shebang execution of scripts. homepage: https://github.com/jekor/hesh@@ -32,7 +32,7 @@ filepath, hackage-db >= 1.8, haskell-src-exts,- hesh == 1.2.0,+ hesh == 1.3.0, parsec >= 3, process, text,
hesh/Main.hs view
@@ -27,9 +27,9 @@ import Distribution.Text (display) import Distribution.Version (versionBranch) import GHC.Generics (Generic)-import Language.Haskell.Exts (parseFileContents, ParseResult(..), fromParseResult)-import Language.Haskell.Exts.Syntax (Module(..), ModuleName(..), ImportDecl(..), QName(..), Name(..), Exp(..), Stmt(..), Type(..), SrcLoc(..), QOp(..))-import Language.Haskell.Exts.Pretty (prettyPrint)+import Language.Haskell.Exts (parseFileContentsWithMode, ParseMode(..), defaultParseMode, Extension(..), KnownExtension(..), ParseResult(..), fromParseResult)+import Language.Haskell.Exts.Syntax (Module(..), ModuleName(..), ModulePragma(..), ImportDecl(..), QName(..), Name(..), Exp(..), Stmt(..), Type(..), SrcLoc(..), QOp(..))+import Language.Haskell.Exts.Pretty (prettyPrintWithMode, defaultMode, PPHsMode(linePragmas)) import System.Console.CmdTheLine (Term, TermInfo(..), OptInfo(..), PosInfo(..), flag, value, pos, posAny, optInfo, posInfo, defTI) import System.Console.CmdTheLine.Term (run) import System.Console.CmdTheLine.Util (fileExists)@@ -40,7 +40,7 @@ import System.Process (ProcessHandle, waitForProcess, createProcess, CreateProcess(..), shell, proc, StdStream(..)) import Hesh.Process (pipeOps)-import Hesh.Shell (expandSyntax)+import Hesh.Shell (desugar) waitForSuccess :: String -> ProcessHandle -> IO () waitForSuccess cmd p = do@@ -102,7 +102,7 @@ -- do ... /> "..." => ... /> "..." :: IO () canDefaultToUnit (InfixApp exp1 (QVarOp op) exp2) = op `elem` (concatMap operatorNames pipeOps) canDefaultToUnit _ = False- defaultToUnit exp = ExpTypeSig (SrcLoc "" 0 0) exp (TyVar (Ident "IO ()"))+ defaultToUnit exp = ExpTypeSig (SrcLoc "<generated>" 0 0) exp (TyVar (Ident "IO ()")) functionNames name = [ UnQual (Ident name) , Qual (ModuleName "Hesh") (Ident name) ] operatorNames name = [ UnQual (Symbol name)@@ -115,13 +115,13 @@ importName (ImportDecl _ (ModuleName m) _ _ _ pkg (Just (ModuleName n)) _) = (m, Just n, pkg) importDeclQualified :: String -> ImportDecl-importDeclQualified m = ImportDecl (SrcLoc "" 0 0) (ModuleName m) True False False Nothing Nothing Nothing+importDeclQualified m = ImportDecl (SrcLoc "<generated>" 0 0) (ModuleName m) True False False Nothing Nothing Nothing importDeclUnqualified :: String -> ImportDecl-importDeclUnqualified m = ImportDecl (SrcLoc "" 0 0) (ModuleName m) False False False Nothing Nothing Nothing+importDeclUnqualified m = ImportDecl (SrcLoc "<generated>" 0 0) (ModuleName m) False False False Nothing Nothing Nothing packageFromModules modules (m, _, Just pkg)- | pkg == "hesh" = Cartel.package "hesh" Cartel.anyVersion -- [1, 2, 0] [1, 2, 0]+ | pkg == "hesh" = Cartel.package "hesh" Cartel.anyVersion -- [1, 3, 0] [1, 3, 0] | otherwise = Cartel.package pkg Cartel.anyVersion packageFromModules modules (m, _, Nothing) | m == "Hesh" || isPrefixOf "Hesh." m = Cartel.package "hesh" Cartel.anyVersion@@ -131,7 +131,7 @@ term = hesh <$> flagStdin <*> flagNoSugar <*> optionFile <*> arguments -termInfo = defTI { termName = "hesh", version = "1.2.0" }+termInfo = defTI { termName = "hesh", version = "1.3.0" } flagStdin :: Term Bool flagStdin = value . flag $ (optInfo [ "stdin", "s" ]) { optName = "STDIN", optDoc = "If this option is present, or if no arguments remain after option processing, then the script is read from standard input." }@@ -150,7 +150,8 @@ -- argument (rather than just relying on the script being provided -- on stdin). If no commandline argument is provided, we assume the -- script is on stdin.- let scriptName = if useStdin || (args' == []) then "script" else takeBaseName (head args')+ let scriptFile = if useStdin || (args' == []) then "<stdin>" else head args'+ scriptName = if useStdin || (args' == []) then "script" else takeBaseName (head args') (source'', args) <- if useStdin || (args' == []) then (\x -> (x, args')) `fmap` TIO.getContents else (\x -> (x, tail args')) `fmap` TIO.readFile (head args')@@ -160,7 +161,7 @@ else source'' source = if noSugar then source'- else Text.pack (expandSyntax (Text.unpack source'))+ else Text.pack (desugar (Text.unpack source')) md5 = hash $ encodeUtf8 source :: Digest MD5 -- -- First, create a directory for the script. One option would be to@@ -188,7 +189,7 @@ p <- modulesPath modules <- fromFileCache p =<< modulePackages -- Now, parse the script.- let ast = defaultToUnit (parseScript source)+ let ast = defaultToUnit (parseScript scriptFile noSugar source) -- Find all qualified module names to add module names to the import list (qualified). names = qualifiedNamesFromModule ast -- Find any import references.@@ -197,9 +198,10 @@ aliases = catMaybes (map (\ (_, y, _) -> y) imports) fqNames = filter (`notElem` aliases) (map fst names) -- Insert qualified module usages back into the import list.- (Module a b c d e importDecls f) = ast+ (Module a b pragmas d e importDecls g) = ast expandedImports = importDecls ++ map importDeclQualified fqNames ++ if noSugar then [] else [importDeclUnqualified "Hesh"]- expandedAst = Module a b c d e expandedImports f+ expandedPragmas = if noSugar then pragmas else pragmas ++ sugarPragmas+ expandedAst = Module a b expandedPragmas d e expandedImports g -- From the imports, build a list of necessary packages. -- First, remove fully qualified names that were previously -- imported explicitly. This is so that we don't override the@@ -207,7 +209,7 @@ -- manually in the import statement. packages = map (packageFromModules modules) (unionBy (\ (x, _, _) (x', _, _) -> x == x') imports (map fqNameModule fqNames) ++ if noSugar then [] else [("Hesh", Nothing, Just "hesh")]) -- packages = map (packageFromModules modules) (map fst imports ++ fqNames ++ if noSugar then [] else ["Hesh"])- writeFile (dir </> "Main.hs") (prettyPrint expandedAst)+ writeFile (dir </> "Main.hs") (prettyPrintWithMode (defaultMode { linePragmas = True }) expandedAst) now <- getZonedTime -- Cartel expects us to provide the version of the Cartel library -- but doesn't export the version for us, so we use 0.@@ -221,6 +223,7 @@ -- TODO: Set the program name appropriately. callCommand (dir </> "dist/build" </> scriptName </> scriptName) args where fqNameModule name = (name, Nothing, Nothing)+ sugarPragmas = [LanguagePragma (SrcLoc "<generated>" 0 0) [Ident "TemplateHaskell", Ident "QuasiQuotes", Ident "PackageImports"]] cartel packages name = mempty { Cartel.Ast.properties = properties , Cartel.Ast.sections = [executable] }@@ -278,8 +281,11 @@ else constraint exposedModules' = fromMaybe [] . fmap (exposedModules . condTreeData) . condLibrary -parseScript :: Text.Text -> Module-parseScript source =- case parseFileContents (Text.unpack source) of+parseScript :: String -> Bool -> Text.Text -> Module+parseScript filename noSugar source =+ case parseFileContentsWithMode+ (defaultParseMode {parseFilename = filename, extensions = exts})+ (Text.unpack source) of ParseOk m -> m r@(ParseFailed _ _) -> fromParseResult r+ where exts = if noSugar then [] else [EnableExtension TemplateHaskell, EnableExtension QuasiQuotes, EnableExtension PackageImports]
lib/Hesh/Shell.hs view
@@ -1,7 +1,7 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE QuasiQuotes #-} -module Hesh.Shell (sh, expandSyntax) where+module Hesh.Shell (sh, desugar) where import Control.Applicative ((<$>), (*>), (<*)) import Data.Char (isSpace, isAlphaNum)@@ -117,8 +117,6 @@ aux loc = uncurry (newPos (loc_filename loc)) (loc_start loc) -- The following parsers are for use by hesh before passing the script to the compiler.--expandSyntax s = "{-# LANGUAGE TemplateHaskell, QuasiQuotes, PackageImports #-}\n" ++ desugar s desugar :: String -> String desugar s =