run-haskell-module (empty) → 0.0.1
raw patch · 5 files changed
+253/−0 lines, 5 filesdep +basedep +data-defaultdep +filepath
Dependencies added: base, data-default, filepath, process
Files
- LICENSE +34/−0
- README.md +3/−0
- changelog.md +4/−0
- run-haskell-module.cabal +45/−0
- src/Language/Haskell/RunHaskellModule.hs +167/−0
+ LICENSE view
@@ -0,0 +1,34 @@+This repository contains some test JSON examples in test/*.json+that is downloaded from Twitter API and http://www.jquery4u.com/json/.+Naturally these are covered by other licenses.++Code copyright (c) 2014, Michal J. Gajda++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 Michal J. Gajda 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.
+ README.md view
@@ -0,0 +1,3 @@+run-haskell-module+==================+Run freshly generated Haskell source code module.
+ changelog.md view
@@ -0,0 +1,4 @@+Changelog+=========+ 0.0.1 Jan 2020+ * Initial version
+ run-haskell-module.cabal view
@@ -0,0 +1,45 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.33.0.+--+-- see: https://github.com/sol/hpack+--+-- hash: 0d105f0142c4fbea46fc0f0bd6aaf9f891f5f4b75a748c0bc2d94e68f7ae8005++name: run-haskell-module+version: 0.0.1+synopsis: Running newly generated Haskell source module.+description: To make sure freshly generated code runs,+ we need to make it run in Stack/Cabal/GHC environment.+license: BSD3+license-file: LICENSE+stability: beta+author: Michal J. Gajda,+ Dmitrii Krylov+maintainer: simons@cryp.to,+ mjgajda@gmail.com+copyright: Copyright by Michal J. Gajda '2014-'2020+category: Data, Tools+build-type: Simple+extra-source-files:+ README.md+ changelog.md+tested-with: GHC==8.4.4 GHC==8.6.5 GHC==8.8.2 GHC==8.10.1++source-repository head+ type: git+ location: https://gitlab.com/migamake/json-autotype.git++library+ exposed-modules:+ Language.Haskell.RunHaskellModule+ other-modules:+ Paths_run_haskell_module+ hs-source-dirs:+ src+ build-depends:+ base >=4.3 && <5+ , data-default >=0.7 && <0.8+ , filepath >=1.3 && <1.5+ , process >=1.1 && <1.7+ default-language: Haskell2010
+ src/Language/Haskell/RunHaskellModule.hs view
@@ -0,0 +1,167 @@+-- | Functions for running generated modules+--+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+module Language.Haskell.RunHaskellModule+ ( RunOptions(..)+ , compileHaskellModule+ , compileHaskellModule'+ , runHaskellModule+ , runHaskellModule'+ ) where+++import Control.Exception+import Control.Monad+import Data.Char+import Data.Default+import System.Environment+import System.Exit+import System.FilePath.Posix+import System.IO+import System.Process+++data RunOptions = RunOptions+ { verbose :: Bool+ , showStdout :: Bool+ , compileArgs :: [String]+ }+++instance Default RunOptions where+ def = RunOptions { verbose = False+ , showStdout = False+ , compileArgs = []+ }+++data GhcTool = Runner | Compiler+++-- | Call specified process with args and print its output when it fails.+--+callProcess' :: RunOptions -> FilePath -> [String] -> IO ExitCode+callProcess' RunOptions{..} cmd args = do+ when verbose $ putStrLn $ "Run \"" ++ cmd ++ "\" with args: " ++ show args+ (_, pstdout, pstderr, p) <- createProcess ((proc cmd args) { std_out = if showStdout then Inherit else CreatePipe, std_err = CreatePipe })+ waitForProcess p >>= \case+ ExitSuccess -> do+ unless showStdout $ whenMaybe hClose pstdout+ whenMaybe hClose pstderr+ return ExitSuccess+ ExitFailure r -> do+ whenMaybe (dumpHandle stdout) pstdout+ whenMaybe (dumpHandle stderr) pstderr+ fail $ concat ["Running \"", cmd, "\" \"", show args, "\" has failed with \"", show r, "\""]+ where+ dumpHandle outhndl inhnd = hGetContents inhnd >>= hPutStr outhndl+ whenMaybe a m = maybe (return ()) a m+++-- | Splits commandline-like strings into "words", i.e.+-- ```+-- -O0 --ghc-arg="-package scientific" --ghc-arg="-package xml-typelift"+-- ```+-- transformed into 3 "words":+-- ```+-- -O0+-- --ghc-arg="-package scientific"+-- --ghc-arg="-package xml-typelift"+-- ```+splitWithQuotes :: String -> [String]+splitWithQuotes [] = []+splitWithQuotes (ch:cs)+ | isSpace ch = splitWithQuotes $ dropWhile isSpace cs+ | otherwise = word : splitWithQuotes strrest+ where+ (word, strrest) = takeWordOrQuote (ch:cs)+ takeWordOrQuote :: String -> (String, String)+ takeWordOrQuote str = let (w', rest) = takeWordOrQuote' "" False str in (reverse w', rest)+ where+ takeWordOrQuote' acc _ "" = (acc, "")+ takeWordOrQuote' acc True ('"':"") = (acc, "")+ takeWordOrQuote' acc True ('"':c:rest)+ | isSpace c = ('"':acc, rest)+ | otherwise = takeWordOrQuote' ('"':acc) False (c:rest)+ takeWordOrQuote' acc True (c :rest) = takeWordOrQuote' (c:acc) True rest+ takeWordOrQuote' acc False ('"':rest) = takeWordOrQuote' ('"':acc) True rest+ takeWordOrQuote' acc False (c :rest)+ | isSpace c = (acc, rest)+ | otherwise = takeWordOrQuote' (c:acc) False rest+++findGhc :: RunOptions+ -> GhcTool+ -> IO (FilePath, [String]) -- ^ returns (exe, special tool arguments)+findGhc RunOptions{..} ghcTool = do+ when verbose $ do+ let showEnv env = lookupEnv env >>= (\e -> putStrLn $ ">>> " ++ show env ++ " = " ++ show e)+ showEnv "STACK_EXE"+ showEnv "CABAL_SANDBOX_CONFIG"+ showEnv "GHC_ENVIRONMENT"+ showEnv "GHC_PACKAGE_PATH"+ showEnv "HASKELL_DIST_DIR"+ showEnv "CI_GHC_ADDITIONAL_FLAGS"+ showEnv "CI_GHC_ADDITIONAL_PACKAGES"+ showEnv "CI_GHC_CABAL_STYLE"+ -- putStrLn "Environment: -----------"+ -- getEnvironment >>= (mapM_ $ \(env,val) -> putStrLn $ env ++ " = " ++ val)+ -- putStrLn "End of environment -----"+ stack <- lookupEnv "STACK_EXE"+ oldCabal <- lookupEnv "CABAL_SANDBOX_CONFIG"+ newCabal <- lookupEnv "HASKELL_DIST_DIR"+ additionalFlags <- (maybe [] splitWithQuotes) <$> lookupEnv "CI_GHC_ADDITIONAL_FLAGS"+ additionalPackages <- ((additionalPackagesDef ++) . (maybe [] words)) <$> lookupEnv "CI_GHC_ADDITIONAL_PACKAGES"+ cabalStyle <- (maybe "v2" id) <$> lookupEnv "CI_GHC_CABAL_STYLE"+ let cabalExec = cabalStyle ++ "-exec"+ let additionalPackagesArgs = map mkAdditionalPackagesArg additionalPackages+ let res@(exe, exeArgs') | Just stackExec <- stack = (stackExec, additionalFlags ++ [tool, "--"])+ | Just _ <- oldCabal = ("cabal", ["exec", tool, "--"])+ | Just _ <- newCabal = ("cabal", [cabalExec, tool, "--"] ++ additionalPackagesArgs)+ | otherwise = (tool, [])+ exeArgs = case ghcTool of+ Compiler -> exeArgs' ++ ["-O0"]+ Runner -> exeArgs'+ when verbose $ putStrLn $ "Use exe \"" ++ exe ++ "\", and additional arguments: " ++ show exeArgs+ return res+ where+ tool = case ghcTool of+ Runner -> "runghc"+ Compiler -> "ghc"+ mkAdditionalPackagesArg arg = case ghcTool of+ Runner -> "--ghc-arg=-package " ++ arg+ Compiler -> "-package " ++ arg+ additionalPackagesDef = []+++passModuleToGhc :: RunOptions -> GhcTool -> FilePath -> [String] -> IO ExitCode+passModuleToGhc ro ghcTool moduleFilename args =+ handle (\(e::SomeException) -> do print e >> throw e) $ do+ (exe, exeArgs) <- findGhc ro ghcTool+ callProcess' ro exe (exeArgs ++ moduleFilename:args)+++-- | Find ghc with cabal or stack and compile Haskell module with specified arguments and run options+--+compileHaskellModule' :: RunOptions -> FilePath -> [String] -> IO ExitCode+compileHaskellModule' ro moduleFilename args = passModuleToGhc ro Compiler moduleFilename args++-- | Find ghc with cabal or stack and compile Haskell module with specified arguments+--+compileHaskellModule :: FilePath -> [String] -> IO ExitCode+compileHaskellModule = compileHaskellModule' def++-- | Find ghc with cabal or stack and run Haskell module in specified file with arguments and run options+--+runHaskellModule' :: RunOptions -> FilePath -> [String] -> IO ExitCode+runHaskellModule' ro moduleFilename args = passModuleToGhc ro Runner moduleFilename args+++-- | Find ghc with cabal or stack and run Haskell module in specified file with arguments+--+runHaskellModule :: FilePath -> [String] -> IO ExitCode+runHaskellModule = runHaskellModule' def++