diff --git a/haskell-awk.cabal b/haskell-awk.cabal --- a/haskell-awk.cabal +++ b/haskell-awk.cabal @@ -1,5 +1,5 @@ Name: haskell-awk -Version: 1.0 +Version: 1.0.1 Author: Mario Pastorelli , Samuel Gélineau Maintainer: Mario Pastorelli , Samuel Gélineau Synopsis: Transform text from the command-line using Haskell expressions. @@ -12,8 +12,9 @@ License-File: LICENSE Build-Type: Simple Cabal-version: >=1.10 -Extra-Source-Files: src/System/Console/Hawk.hs +Extra-Source-Files: src/System/Console/*.hs , src/System/Console/Hawk/*.hs + , src/System/Console/Hawk/Config/*.hs , README.md , tests/System/Console/Hawk/Representable/Test.hs diff --git a/src/System/Console/Hawk/Config/Base.hs b/src/System/Console/Hawk/Config/Base.hs new file mode 100644 --- /dev/null +++ b/src/System/Console/Hawk/Config/Base.hs @@ -0,0 +1,25 @@ +-- Copyright 2013 Mario Pastorelli (pastorelli.mario@gmail.com) Samuel Gélineau (gelisam@gmail.com) +-- +-- Licensed under the Apache License, Version 2.0 (the "License"); +-- you may not use this file except in compliance with the License. +-- You may obtain a copy of the License at +-- +-- http://www.apache.org/licenses/LICENSE-2.0 +-- +-- Unless required by applicable law or agreed to in writing, software +-- distributed under the License is distributed on an "AS IS" BASIS, +-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +-- See the License for the specific language governing permissions and +-- limitations under the License. + +module System.Console.Hawk.Config.Base where + +import Data.ByteString.Char8 + + +type ExtensionName = String +type QualifiedModule = (String, Maybe String) +type Source = ByteString + +defaultModuleName :: String +defaultModuleName = "System.Console.Hawk.CachedPrelude" diff --git a/src/System/Console/Hawk/Config/Cache.hs b/src/System/Console/Hawk/Config/Cache.hs new file mode 100644 --- /dev/null +++ b/src/System/Console/Hawk/Config/Cache.hs @@ -0,0 +1,91 @@ +-- Copyright 2013 Mario Pastorelli (pastorelli.mario@gmail.com) Samuel Gélineau (gelisam@gmail.com) +-- +-- Licensed under the Apache License, Version 2.0 (the "License"); +-- you may not use this file except in compliance with the License. +-- You may obtain a copy of the License at +-- +-- http://www.apache.org/licenses/LICENSE-2.0 +-- +-- Unless required by applicable law or agreed to in writing, software +-- distributed under the License is distributed on an "AS IS" BASIS, +-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +-- See the License for the specific language governing permissions and +-- limitations under the License. + +{-# LANGUAGE OverloadedStrings #-} +module System.Console.Hawk.Config.Cache + ( getConfigDir + , getConfigFile + , getCacheDir + , getConfigInfosFile + , getExtensionsFile + , getModulesFile + , getCompiledFile + , getSourceFile + , cacheExtensions + , cacheModules + , cacheSource + ) + where + +import Control.Applicative ((<$>)) + +import qualified Data.ByteString.Char8 as B +import qualified Language.Haskell.Interpreter as Interpreter +import System.EasyFile + +import System.Console.Hawk.Config.Base + + +() :: IO FilePath -- the left filepath in the IO monad + -> FilePath -- the right filepath + -> IO FilePath -- the filepath resulting +lpath rpath = ( rpath) <$> lpath + +getConfigDir :: IO FilePath +getConfigDir = getHomeDirectory ".hawk" + +getConfigFile :: IO FilePath +getConfigFile = getConfigDir "prelude.hs" + +getCacheDir :: IO FilePath +getCacheDir = getConfigDir "cache" + +getConfigInfosFile :: IO FilePath +getConfigInfosFile = getCacheDir "configInfos" + +getModulesFile :: IO FilePath +getModulesFile = getCacheDir "modules" + +getExtensionsFile :: IO FilePath +getExtensionsFile = getCacheDir "extensions" + + +getSourceBasename :: IO String +getSourceBasename = getCacheDir "cached_prelude" + +getCompiledFile :: IO String +getCompiledFile = getSourceBasename + +getSourceFile :: IO String +getSourceFile = (++ ".hs") <$> getSourceBasename + + +cacheExtensions :: FilePath + -> [ExtensionName] + -> IO () +cacheExtensions extensionsFile extensions = + writeFile extensionsFile $ show extensions' + where + extensions' :: [Interpreter.Extension] + extensions' = map read extensions + +cacheModules :: FilePath + -> [QualifiedModule] + -> IO () +cacheModules modulesFile modules = writeFile modulesFile $ show modules + +cacheSource :: FilePath + -> Source + -> IO () +cacheSource = B.writeFile diff --git a/src/System/Console/Hawk/Config/Compile.hs b/src/System/Console/Hawk/Config/Compile.hs new file mode 100644 --- /dev/null +++ b/src/System/Console/Hawk/Config/Compile.hs @@ -0,0 +1,55 @@ +-- Copyright 2013 Mario Pastorelli (pastorelli.mario@gmail.com) Samuel Gélineau (gelisam@gmail.com) +-- +-- Licensed under the Apache License, Version 2.0 (the "License"); +-- you may not use this file except in compliance with the License. +-- You may obtain a copy of the License at +-- +-- http://www.apache.org/licenses/LICENSE-2.0 +-- +-- Unless required by applicable law or agreed to in writing, software +-- distributed under the License is distributed on an "AS IS" BASIS, +-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +-- See the License for the specific language governing permissions and +-- limitations under the License. + +{-# LANGUAGE OverloadedStrings #-} +module System.Console.Hawk.Config.Compile + ( compile + ) + where + +import Control.Monad (when) + +import System.Exit +import System.IO +import System.Process + +import System.Console.Hawk.Sandbox (extraGhcArgs) + + +-- compile a haskell file +-- TODO: this should return the error instead of print it and exit +compile :: FilePath -- ^ the source file + -> FilePath -- ^ the output file + -> FilePath -- ^ the directory used for compiler files + -> IO () +compile sourceFile outputFile dir = do + let basicArgs = [ "--make" + , sourceFile + , "-i" + , "-ilib" + , "-fforce-recomp" + , "-v0" + , "-o",outputFile] + extraArgs <- extraGhcArgs + let args = basicArgs ++ extraArgs + compExitCode <- + waitForProcess =<< runProcess "ghc" + args + (Just dir) + Nothing + Nothing + Nothing + (Just stderr) + when (compExitCode /= ExitSuccess) $ do + exitFailure diff --git a/src/System/Console/Hawk/Config/Extend.hs b/src/System/Console/Hawk/Config/Extend.hs new file mode 100644 --- /dev/null +++ b/src/System/Console/Hawk/Config/Extend.hs @@ -0,0 +1,115 @@ +-- Copyright 2013 Mario Pastorelli (pastorelli.mario@gmail.com) Samuel Gélineau (gelisam@gmail.com) +-- +-- Licensed under the Apache License, Version 2.0 (the "License"); +-- you may not use this file except in compliance with the License. +-- You may obtain a copy of the License at +-- +-- http://www.apache.org/licenses/LICENSE-2.0 +-- +-- Unless required by applicable law or agreed to in writing, software +-- distributed under the License is distributed on an "AS IS" BASIS, +-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +-- See the License for the specific language governing permissions and +-- limitations under the License. + +{-# LANGUAGE OverloadedStrings #-} +module System.Console.Hawk.Config.Extend + ( extendModules + , extendSource + , getModuleName + ) + where + +import Data.ByteString.Char8 (ByteString) +import qualified Data.ByteString.Char8 as C8 +import qualified Data.ByteString.Search as BSS +import Data.Char +import Data.Maybe +import Data.Monoid ((<>)) +import Text.Printf + +import System.Console.Hawk.Config.Base + + +extendModules :: [ExtensionName] + -> [QualifiedModule] + -> [QualifiedModule] +extendModules extensions modules = addIfNecessary (shouldAddPrelude extensions modules) + (unqualified_prelude:) + modules + where + unqualified_prelude = ("Prelude", Nothing) + + +-- adjust the prelude to make it loadable from hint. +extendSource :: FilePath + -> [ExtensionName] + -> [QualifiedModule] + -> Source + -> Source +extendSource configFile extensions modules = addPreludeIfMissing . addModuleIfMissing + where + addModuleIfMissing s = addIfNecessary (shouldAddModule s) + (addModule configFile) + s + addPreludeIfMissing = addIfNecessary (shouldAddPrelude extensions modules) + (addImport "Prelude" configFile) + + +addIfNecessary :: Bool -> (a -> a) -> a -> a +addIfNecessary True f x = f x +addIfNecessary False _ x = x + +shouldAddModule :: Source -> Bool +shouldAddModule = (== Nothing) . parseModuleName + +shouldAddPrelude :: [ExtensionName] -> [QualifiedModule] -> Bool +shouldAddPrelude extensions _ | "NoImplicitPrelude" `elem` extensions = False +shouldAddPrelude _ modules | "Prelude" `elem` map fst modules = False +shouldAddPrelude _ _ | otherwise = True + + +-- add a module to a string representing a Haskell source file +addModule :: FilePath -> Source -> Source +addModule configFile source = + let strippedCode = C8.dropWhile isSpace source + maybePragma = if "{-#" `C8.isPrefixOf` strippedCode + then let (pragma,afterPragma) = BSS.breakAfter "#-}" strippedCode + in (Just pragma, afterPragma) + else (Nothing,strippedCode) + line :: Int -> ByteString + line n = C8.pack $ printf "{-# LINE %d %s #-}" n $ show configFile + moduleLine = C8.pack $ unwords ["module", defaultModuleName, "where"] + in case maybePragma of + (Nothing,c) -> C8.unlines [moduleLine,c] + (Just pragma,c) -> let n = 1 + C8.length (C8.filter (=='\n') pragma) + in C8.unlines [line 1,pragma,moduleLine,line n,c] + +-- add an import statement to a string representing a Haskell source file +addImport :: String -> FilePath -> Source -> Source +addImport moduleName configFile source = + let (premodule,postmodule) = BSS.breakAfter "module " source + (prewhere,postwhere) = BSS.breakAfter " where" postmodule + (prenewline,postnewline) = BSS.breakAfter "\n" postwhere + preimports = premodule <> prewhere <> prenewline + postimports = postnewline + line :: Int -> ByteString + line n = C8.pack $ printf "{-# LINE %d %s #-}" n $ show configFile + importLine = C8.pack $ unwords ["import", moduleName] + m = 1 + C8.length (C8.filter (=='\n') preimports) + extraLines = C8.unlines [importLine, line m] + in preimports <> extraLines <> postimports + + +-- get the module name from a file if it exists +parseModuleName :: Source -> Maybe ByteString +parseModuleName bs = case BSS.indices (C8.pack "module") bs of + [] -> Nothing + (i:_) -> Just + . C8.takeWhile (\c -> isAlphaNum c || c == '.') + . C8.dropWhile isSpace + . C8.drop (i + 6) $ bs + +-- same, but crash if there is no module +getModuleName :: Source -> String +getModuleName = C8.unpack . fromJust . parseModuleName diff --git a/src/System/Console/Hawk/Config/Parse.hs b/src/System/Console/Hawk/Config/Parse.hs new file mode 100644 --- /dev/null +++ b/src/System/Console/Hawk/Config/Parse.hs @@ -0,0 +1,89 @@ +-- Copyright 2013 Mario Pastorelli (pastorelli.mario@gmail.com) Samuel Gélineau (gelisam@gmail.com) +-- +-- Licensed under the Apache License, Version 2.0 (the "License"); +-- you may not use this file except in compliance with the License. +-- You may obtain a copy of the License at +-- +-- http://www.apache.org/licenses/LICENSE-2.0 +-- +-- Unless required by applicable law or agreed to in writing, software +-- distributed under the License is distributed on an "AS IS" BASIS, +-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +-- See the License for the specific language governing permissions and +-- limitations under the License. + +{-# LANGUAGE OverloadedStrings #-} +module System.Console.Hawk.Config.Parse + ( ExtensionName + , QualifiedModule + , parseExtensions + , parseModules + , parseSource + ) + where + +import Control.Applicative ((<$>)) + +import qualified Data.ByteString.Char8 as C8 +import Data.Maybe +import Language.Haskell.Exts ( parseFileWithExts ) +import Language.Haskell.Exts.Extension ( parseExtension, Extension (..) ) +import Language.Haskell.Exts.Parser + ( getTopPragmas + , ParseResult (..) + ) +import Language.Haskell.Exts.Syntax +import System.Exit +import Text.Printf + +import System.Console.Hawk.Config.Base + + +getResult :: FilePath -> ParseResult a -> IO a +getResult _ (ParseOk x) = return x +getResult sourceFile (ParseFailed srcLoc err) = do + putStrLn $ printf "error parsing file %s:%s: %s" sourceFile (show srcLoc) err + exitFailure + + +parseExtensions :: FilePath -> IO [ExtensionName] +parseExtensions sourceFile = do + result <- getTopPragmas <$> readFile sourceFile + listExtensions <$> getResult sourceFile result + where + listExtensions :: [ModulePragma] -> [ExtensionName] + listExtensions = map getName . concat . mapMaybe extensionNames + + extensionNames :: ModulePragma -> Maybe [Name] + extensionNames (LanguagePragma _ names) = Just names + extensionNames _ = Nothing + + getName :: Name -> ExtensionName + getName (Ident s) = s + getName (Symbol s) = s + + +parseModules :: FilePath -> [ExtensionName] -> IO [QualifiedModule] +parseModules sourceFile extensions = do + result <- parseFileWithExts extensions' sourceFile + Module _ _ _ _ _ importDeclarations _ <- getResult sourceFile result + return $ concatMap toHintModules importDeclarations + where + extensions' :: [Extension] + extensions' = map parseExtension extensions + + toHintModules :: ImportDecl -> [QualifiedModule] + toHintModules importDecl = + case importDecl of + ImportDecl _ (ModuleName mn) False _ _ Nothing _ -> [(mn,Nothing)] + ImportDecl _ (ModuleName mn) False _ _ (Just (ModuleName s)) _ -> + [(mn,Nothing),(mn,Just s)] + ImportDecl _ (ModuleName mn) True _ _ Nothing _ -> [(mn,Just mn)] + ImportDecl _ (ModuleName mn) True _ _ (Just (ModuleName s)) _ -> + [(mn,Just s)] + + +-- the configuration format is designed to look like a Haskell module, +-- so we just return the whole file. +parseSource :: FilePath -> IO Source +parseSource = C8.readFile