diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,202 @@ + + Apache License + Version 2.0, January 2004 + http://www.apache.org/licenses/ + + TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION + + 1. Definitions. + + "License" shall mean the terms and conditions for use, reproduction, + and distribution as defined by Sections 1 through 9 of this document. + + "Licensor" shall mean the copyright owner or entity authorized by + the copyright owner that is granting the License. + + "Legal Entity" shall mean the union of the acting entity and all + other entities that control, are controlled by, or are under common + control with that entity. For the purposes of this definition, + "control" means (i) the power, direct or indirect, to cause the + direction or management of such entity, whether by contract or + otherwise, or (ii) ownership of fifty percent (50%) or more of the + outstanding shares, or (iii) beneficial ownership of such entity. + + "You" (or "Your") shall mean an individual or Legal Entity + exercising permissions granted by this License. + + "Source" form shall mean the preferred form for making modifications, + including but not limited to software source code, documentation + source, and configuration files. + + "Object" form shall mean any form resulting from mechanical + transformation or translation of a Source form, including but + not limited to compiled object code, generated documentation, + and conversions to other media types. + + "Work" shall mean the work of authorship, whether in Source or + Object form, made available under the License, as indicated by a + copyright notice that is included in or attached to the work + (an example is provided in the Appendix below). + + "Derivative Works" shall mean any work, whether in Source or Object + form, that is based on (or derived from) the Work and for which the + editorial revisions, annotations, elaborations, or other modifications + represent, as a whole, an original work of authorship. For the purposes + of this License, Derivative Works shall not include works that remain + separable from, or merely link (or bind by name) to the interfaces of, + the Work and Derivative Works thereof. + + "Contribution" shall mean any work of authorship, including + the original version of the Work and any modifications or additions + to that Work or Derivative Works thereof, that is intentionally + submitted to Licensor for inclusion in the Work by the copyright owner + or by an individual or Legal Entity authorized to submit on behalf of + the copyright owner. For the purposes of this definition, "submitted" + means any form of electronic, verbal, or written communication sent + to the Licensor or its representatives, including but not limited to + communication on electronic mailing lists, source code control systems, + and issue tracking systems that are managed by, or on behalf of, the + Licensor for the purpose of discussing and improving the Work, but + excluding communication that is conspicuously marked or otherwise + designated in writing by the copyright owner as "Not a Contribution." + + "Contributor" shall mean Licensor and any individual or Legal Entity + on behalf of whom a Contribution has been received by Licensor and + subsequently incorporated within the Work. + + 2. Grant of Copyright License. Subject to the terms and conditions of + this License, each Contributor hereby grants to You a perpetual, + worldwide, non-exclusive, no-charge, royalty-free, irrevocable + copyright license to reproduce, prepare Derivative Works of, + publicly display, publicly perform, sublicense, and distribute the + Work and such Derivative Works in Source or Object form. + + 3. Grant of Patent License. Subject to the terms and conditions of + this License, each Contributor hereby grants to You a perpetual, + worldwide, non-exclusive, no-charge, royalty-free, irrevocable + (except as stated in this section) patent license to make, have made, + use, offer to sell, sell, import, and otherwise transfer the Work, + where such license applies only to those patent claims licensable + by such Contributor that are necessarily infringed by their + Contribution(s) alone or by combination of their Contribution(s) + with the Work to which such Contribution(s) was submitted. If You + institute patent litigation against any entity (including a + cross-claim or counterclaim in a lawsuit) alleging that the Work + or a Contribution incorporated within the Work constitutes direct + or contributory patent infringement, then any patent licenses + granted to You under this License for that Work shall terminate + as of the date such litigation is filed. + + 4. Redistribution. You may reproduce and distribute copies of the + Work or Derivative Works thereof in any medium, with or without + modifications, and in Source or Object form, provided that You + meet the following conditions: + + (a) You must give any other recipients of the Work or + Derivative Works a copy of this License; and + + (b) You must cause any modified files to carry prominent notices + stating that You changed the files; and + + (c) You must retain, in the Source form of any Derivative Works + that You distribute, all copyright, patent, trademark, and + attribution notices from the Source form of the Work, + excluding those notices that do not pertain to any part of + the Derivative Works; and + + (d) If the Work includes a "NOTICE" text file as part of its + distribution, then any Derivative Works that You distribute must + include a readable copy of the attribution notices contained + within such NOTICE file, excluding those notices that do not + pertain to any part of the Derivative Works, in at least one + of the following places: within a NOTICE text file distributed + as part of the Derivative Works; within the Source form or + documentation, if provided along with the Derivative Works; or, + within a display generated by the Derivative Works, if and + wherever such third-party notices normally appear. The contents + of the NOTICE file are for informational purposes only and + do not modify the License. You may add Your own attribution + notices within Derivative Works that You distribute, alongside + or as an addendum to the NOTICE text from the Work, provided + that such additional attribution notices cannot be construed + as modifying the License. + + You may add Your own copyright statement to Your modifications and + may provide additional or different license terms and conditions + for use, reproduction, or distribution of Your modifications, or + for any such Derivative Works as a whole, provided Your use, + reproduction, and distribution of the Work otherwise complies with + the conditions stated in this License. + + 5. Submission of Contributions. Unless You explicitly state otherwise, + any Contribution intentionally submitted for inclusion in the Work + by You to the Licensor shall be under the terms and conditions of + this License, without any additional terms or conditions. + Notwithstanding the above, nothing herein shall supersede or modify + the terms of any separate license agreement you may have executed + with Licensor regarding such Contributions. + + 6. Trademarks. This License does not grant permission to use the trade + names, trademarks, service marks, or product names of the Licensor, + except as required for reasonable and customary use in describing the + origin of the Work and reproducing the content of the NOTICE file. + + 7. Disclaimer of Warranty. Unless required by applicable law or + agreed to in writing, Licensor provides the Work (and each + Contributor provides its Contributions) on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or + implied, including, without limitation, any warranties or conditions + of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A + PARTICULAR PURPOSE. You are solely responsible for determining the + appropriateness of using or redistributing the Work and assume any + risks associated with Your exercise of permissions under this License. + + 8. Limitation of Liability. In no event and under no legal theory, + whether in tort (including negligence), contract, or otherwise, + unless required by applicable law (such as deliberate and grossly + negligent acts) or agreed to in writing, shall any Contributor be + liable to You for damages, including any direct, indirect, special, + incidental, or consequential damages of any character arising as a + result of this License or out of the use or inability to use the + Work (including but not limited to damages for loss of goodwill, + work stoppage, computer failure or malfunction, or any and all + other commercial damages or losses), even if such Contributor + has been advised of the possibility of such damages. + + 9. Accepting Warranty or Additional Liability. While redistributing + the Work or Derivative Works thereof, You may choose to offer, + and charge a fee for, acceptance of support, warranty, indemnity, + or other liability obligations and/or rights consistent with this + License. However, in accepting such obligations, You may act only + on Your own behalf and on Your sole responsibility, not on behalf + of any other Contributor, and only if You agree to indemnify, + defend, and hold each Contributor harmless for any liability + incurred by, or claims asserted against, such Contributor by reason + of your accepting any such warranty or additional liability. + + END OF TERMS AND CONDITIONS + + APPENDIX: How to apply the Apache License to your work. + + To apply the Apache License to your work, attach the following + boilerplate notice, with the fields enclosed by brackets "[]" + replaced with your own identifying information. (Don't include + the brackets!) The text should be enclosed in the appropriate + comment syntax for the file format. We also recommend that a + file or class name and description of purpose be included on the + same "printed page" as the copyright notice for easier + identification within third-party archives. + + Copyright [yyyy] [name of copyright owner] + + 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. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,70 @@ +# Hawk + +Transform text from the command-line using Haskell expressions. Similar to [awk](http://cm.bell-labs.com/cm/cs/awkbook/index.html), but using Haskell as the text-processing language. + +## Examples + +In [Unix](http://en.wikipedia.org/wiki/Unix) the file `/etc/passwd` is used to +keep track of every registered user in the system. Each entry in the file +contains information about a single user, using a simple colon-separated format. +For example: + +``` +root:x:0:0:root:/root:/bin/bash +``` + +The first field is the username. We can use Hawk to list all usernames as follows: + +```bash +> cat /etc/passwd | hawk -d: -m 'head' +root +``` + +The `-d` option tells Hawk to use `:` as word delimiters, causing the first line to be interpreted as `["root", "x", "0", "0", "root", "/root", "/bin/bash"]`. +The `-m` tells Hawk to map a function over each line of the input. In this case, the function `head` extracts the first word of the line, which happens to be the username. + +We could of course have achieved identical results by using awk instead of Hawk: + +```bash +> cat /etc/passwd | awk -F: '{print $1}' +root +``` + +While Hawk and awk have similar use cases, the philosophy behind the two is very +different. Awk uses a specialized language designed to concisely express many text transformations, +while Hawk uses the general-purpose language Haskell, which is also known for being concise, among other things. +There are many standard command-line tools that can be easily approximated using +[short Haskell expressions](http://www.haskell.org/haskellwiki/Simple_Unix_tools). + +Another important difference is that while awk one-liners are self-contained, Hawk encourages the use of libraries and user-defined functions. By adding function definitions, module imports and language pragmas to Hawk's user-configurable [prelude file](https://github.com/gelisam/hawk/tree/master/doc#user-prelude), those functions, libraries and language extensions become available to Hawk one-liners. +For instance, we could add a `takeLast` function extracting the last `n` elements from a list, and use it to (inefficiently) approximate `tail`: + +```bash +> echo 'takeLast n = reverse . take n . reverse' >> ~/.hawk/prelude.hs +> seq 0 100 | hawk -a 'takeLast 3' +98 +99 +100 +``` + + +For more details, see the [documentation](doc/README.md). + +## Installation + +To install the stable version, simply use `cabal install haskell-hawk` and +add `~/.cabal/bin` (or your sandbox's `bin` folder) to your PATH. You should +be ready to use Hawk: + +```bash +> hawk '[1..3]' +1 +2 +3 +``` + +To install the development version, clone this repository and use `cabal +install` or `cabal-dev install` to compile Hawk and its dependencies. Cabal +installs the binary to `~/.cabal/bin/hawk`, while cabal-dev installs it to +`./cabal-dev/bin/hawk`. The first run will create a default configuration into +`~/.hawk/prelude.hs` if it doesn't exist. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,16 @@ +-- 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. + +import Distribution.Simple +main = defaultMain diff --git a/haskell-awk.cabal b/haskell-awk.cabal new file mode 100644 --- /dev/null +++ b/haskell-awk.cabal @@ -0,0 +1,78 @@ +Name: haskell-awk +Version: 1.0 +Author: Mario Pastorelli , Samuel Gélineau +Maintainer: Mario Pastorelli , Samuel Gélineau +Synopsis: Transform text from the command-line using Haskell expressions. +Description: Hawk is a command line utility to process streams of text + using Haskell code. It is intended to be used in a UNIX + pipeline. It offers a configuration system to personalize + imported modules and a way to represent values on the console. +Category: Console +License: Apache-2.0 +License-File: LICENSE +Build-Type: Simple +Cabal-version: >=1.10 +Extra-Source-Files: src/System/Console/Hawk.hs + , src/System/Console/Hawk/*.hs + , README.md + , tests/System/Console/Hawk/Representable/Test.hs + +Source-Repository head + type: git + location: https://github.com/gelisam/hawk + +Executable hawk + Main-is: Main.hs + Default-Language: Haskell98 + ghc-options: -Wall + build-depends: base >=4.6.0.1 && <5 + , bytestring >=0.10.0.2 + , containers -any + , directory >=1.2.0.1 + , easy-file >=0.1.1 + , filepath >=1.3.0.1 + , haskell-src-exts >=1.14.0 + , hint >=0.3.3.5 + , MonadCatchIO-mtl >=0.3.0.0 + , network >=2.3.1.0 + , stringsearch >=0.3.6.4 + , process >=1.1.0.2 + , time -any + hs-source-dirs: src + +Library + exposed-modules: System.Console.Hawk.Representable + ,System.Console.Hawk.Runtime + ,System.Console.Hawk.IO + ghc-options: -Wall + hs-source-dirs: src + build-depends: base >=4.6.0.1 + , bytestring >=0.10.0.2 + , containers -any + , stringsearch >=0.3.6.4 + Default-Language: Haskell98 + +Test-suite reference + Hs-Source-Dirs: src,tests + Main-Is: RunTests.hs + Type: exitcode-stdio-1.0 + Ghc-Options: -Wall + Build-Depends: base>=4.6.0.1 && <5 + , bytestring>=0.10.0.2 + , containers -any + , directory >=1.2.0.1 + , doctest >= 0.8 + , test-framework + , test-framework-hunit + , temporary + , hspec + , HUnit + , easy-file >=0.1.1 + , haskell-src-exts >= 1.14.0 + , hint >=0.3.3.5 + , filepath >=1.3.0.1 + , network >=2.3.1.0 + , process >=1.1.0.2 + , stringsearch >=0.3.6.4 + , time -any + Default-Language: Haskell98 diff --git a/src/Main.hs b/src/Main.hs new file mode 100644 --- /dev/null +++ b/src/Main.hs @@ -0,0 +1,20 @@ +-- 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 Main where + +import qualified System.Console.Hawk as Hawk + +main :: IO () +main = Hawk.main diff --git a/src/System/Console/Hawk.hs b/src/System/Console/Hawk.hs new file mode 100644 --- /dev/null +++ b/src/System/Console/Hawk.hs @@ -0,0 +1,236 @@ +-- 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 NoImplicitPrelude + , OverloadedStrings + , ScopedTypeVariables + , TupleSections #-} + +module System.Console.Hawk ( + + hawk + , main + +) where + + +import Control.Applicative ((<$>)) +import Control.Monad +import qualified Data.List as L +import Data.List ((++),(!!)) +import Data.Either +import Data.Function +import Data.Ord +import Data.Maybe +import Data.String +import qualified Data.Typeable.Internal as Typeable +import Data.Typeable.Internal + (TypeRep(..) + ,tyConName) +import qualified Data.ByteString as B +import qualified Data.ByteString.Lazy as LB +import Data.Version (versionBranch) +import Language.Haskell.Interpreter +import qualified Prelude as P +import System.Console.GetOpt (usageInfo) +import System.Environment (getArgs,getProgName) +import System.Exit (exitFailure,exitSuccess) +import qualified System.IO as IO +import System.IO (IO) +import Text.Printf (printf) + +import System.Console.Hawk.Sandbox +import System.Console.Hawk.Config +import System.Console.Hawk.Lock +import System.Console.Hawk.IO +import System.Console.Hawk.Options + +-- magic self-referential module created by cabal +import Paths_haskell_awk (version) + + +initInterpreter :: (String, String) -- ^ config file and module name + -> [(String,Maybe String)] -- ^ the modules maybe qualified + -> [Extension] + -> InterpreterT IO () +initInterpreter (preludeFile,preludeModule) userModules extensions = do + + set [languageExtensions := extensions] + + -- load the config file + loadModules [preludeFile] + + -- load the config module plus representable + setImportsQ $ (preludeModule,Nothing):defaultModules + ++ userModules + +printErrors :: InterpreterError -> IO () +printErrors e = case e of + WontCompile es' -> do + IO.hPutStrLn IO.stderr "\nWon't compile:" + forM_ es' $ \e' -> + case e' of + GhcError e'' -> IO.hPutStrLn IO.stderr $ '\t':e'' ++ "\n" + _ -> IO.print e + +runHawk :: Options + -> (String,String) + -> [String] + -> IO () +runHawk os prelude nos = do + let file = if L.length nos > 1 then Just (nos !! 1) else Nothing + extensions <- P.read <$> (getExtensionsFile >>= IO.readFile) + modules <- maybe (return []) (\f -> P.read <$> IO.readFile f) (optModuleFile os) + + maybe_f <- hawk os prelude modules extensions (L.head nos) + case maybe_f of + Left ie -> printErrors ie + Right f -> getInput file >>= printOutput . f + +runLockedHawkInterpreter :: forall a . InterpreterT IO a + -> IO (Either InterpreterError a) +runLockedHawkInterpreter i = do + withLock $ runHawkInterpreter i + +data StreamFormat = StreamFormat | LinesFormat | WordsFormat + deriving (P.Eq,P.Show,P.Read) + +streamFormat :: B.ByteString + -> B.ByteString + -> StreamFormat +streamFormat ld wd = if B.null ld + then StreamFormat + else if B.null wd + then LinesFormat + else WordsFormat + +-- | 'ByteString' wrapper used to override the 'ByteString' @typeOf@ into +-- a qualified version +-- @typeOf (ByteString.pack "test") == "ByteString"@ +-- @typeof (QualifiedByteString $ ByteString.pack "test") == "Data.ByteString.Lazy.Char8.Bytestring"@ +newtype QualifiedByteString = QB { unQB :: LB.ByteString } + +instance Typeable.Typeable QualifiedByteString where + typeOf (QB bs) = let TypeRep fp tc trs = Typeable.typeOf bs + in TypeRep fp + tc{ tyConName = "Data.ByteString.Lazy.Char8." + ++ tyConName tc } + trs + +hawk :: Options -- ^ Program options + -> (String,String) -- ^ The prelude file and module name + -> [(String,Maybe String)] -- ^ The modules maybe qualified + -> [Extension] -- ^ The extensions to enable + -> String -- ^ The user expression to evaluate + -> IO (Either InterpreterError (LB.ByteString -> LB.ByteString)) +hawk opts prelude modules extensions userExpr = do + eitherErrorF <- runLockedHawkInterpreter $ do + + initInterpreter prelude modules extensions + + -- eval program based on the existence of a delimiter + case (optMode opts,streamFormat linesDelim wordsDelim) of + (EvalMode,_) -> interpret' $ evalExpr userExpr + (ApplyMode,StreamFormat) -> interpret' $ streamExpr userExpr + (ApplyMode,LinesFormat) -> interpret' $ linesExpr userExpr + (ApplyMode,WordsFormat) -> interpret' $ wordsExpr userExpr + (MapMode,StreamFormat) -> interpret' $ mapStreamExpr userExpr + (MapMode,LinesFormat) -> interpret' $ mapLinesExpr userExpr + (MapMode,WordsFormat) -> interpret' $ mapWordsExpr userExpr + + return ((\f -> unQB . f . QB) <$> eitherErrorF) + where + interpret' expr = do + -- print the user expression + -- lift $ IO.hPutStrLn IO.stderr expr + interpret expr (as :: QualifiedByteString -> QualifiedByteString) + evalExpr = printf "const (%s (%s))" showRows + mapStreamExpr = streamExpr . listMap + mapLinesExpr = linesExpr . listMap + mapWordsExpr = wordsExpr . listMap + streamExpr expr = compose [showRows, expr] + linesExpr expr = compose [showRows, expr, parseRows] + wordsExpr expr = compose [showRows, expr, parseWords] + linesDelim = optLinesDelim opts + wordsDelim = optWordsDelim opts + outLinesDelim = case optOutLinesDelim opts of + Nothing -> linesDelim + Just delim -> delim + outWordsDelim = case optOutWordsDelim opts of + Nothing -> wordsDelim + Just delim -> delim + compose :: [String] -> String + compose = L.intercalate (prel ".") . P.map (printf "(%s)") + listMap :: String -> String + listMap = printf (runtime "listMap (%s)") + c8pack :: String -> String + c8pack = printf (runtime "c8pack (%s)") + sc8pack :: String -> String + sc8pack = printf (runtime "sc8pack (%s)") + showRows :: String + showRows = printf (runtime "showRows (%s) (%s)") + (c8pack $ P.show outLinesDelim) + (c8pack $ P.show outWordsDelim) + parseRows :: String + parseRows = printf (runtime "parseRows (%s)") + (sc8pack $ P.show linesDelim) + + parseWords :: String + parseWords = printf (runtime "parseWords (%s) (%s)") + (sc8pack $ P.show linesDelim) + (sc8pack $ P.show wordsDelim) + + qualify :: String -> String -> String + qualify moduleName = printf "%s.%s" moduleName + + prel = qualify "Prelude" + runtime = qualify "System.Console.Hawk.Runtime" + +getUsage :: IO String +getUsage = do + pn <- getProgName + return $ usageInfo ("Usage: " ++ pn ++ " [] []") + options + +main :: IO () +main = do + moduleFile <- getModulesFile + optsArgs <- processArgs moduleFile <$> getArgs + either printErrorAndExit go optsArgs + where processArgs moduleFile args = + case compileOpts args of + Left err -> Left err + Right (opts,notOpts) -> + Right (opts{ optModuleFile = Just moduleFile},notOpts) + printErrorAndExit errors = errorMessage errors >> exitFailure + errorMessage errs = do + usage <- getUsage + IO.hPutStr IO.stderr $ L.intercalate "\n" (errs ++ ['\n':usage]) + go (opts,notOpts) = do + config <- if optRecompile opts + then recompileConfig + else recompileConfigIfNeeded + + when (optVersion opts) $ do + let versionString = L.intercalate "." + $ P.map P.show + $ versionBranch version + IO.putStrLn versionString + exitSuccess + + when (optHelp opts) $ do + getUsage >>= IO.putStr + exitSuccess + + runHawk opts config notOpts diff --git a/src/System/Console/Hawk/Config.hs b/src/System/Console/Hawk/Config.hs new file mode 100644 --- /dev/null +++ b/src/System/Console/Hawk/Config.hs @@ -0,0 +1,160 @@ +-- 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 ( + defaultModules + , defaultPrelude + , recompileConfigIfNeeded + , getExtensionsFile + , getModulesFile + , parseModules + , recompileConfig + , recompileConfig' +) where + +import Control.Applicative ((<$>)) +import Control.Monad (when, unless) + +import Data.Time +import System.EasyFile + +import System.Console.Hawk.Config.Base +import System.Console.Hawk.Config.Cache +import System.Console.Hawk.Config.Compile +import System.Console.Hawk.Config.Extend +import System.Console.Hawk.Config.Parse +import System.Console.Hawk.Lock + + +defaultModules :: [QualifiedModule] +defaultModules = map fully_qualified [ + "Prelude" + , "System.Console.Hawk.IO" + , "System.Console.Hawk.Representable" + , "System.Console.Hawk.Runtime" + , "System.IO.Unsafe" + , "Data.ByteString.Lazy.Char8" + ] + where + fully_qualified x = (x, Just x) + +defaultPrelude :: String +defaultPrelude = unlines + [ "{-# LANGUAGE ExtendedDefaultRules, OverloadedStrings #-}" + , "import Prelude" + , "import qualified Data.ByteString.Lazy.Char8 as B" + , "import qualified Data.List as L" + ] + +-- -- +-- From now the code is heavy, it needs a refactoring (renaming) + +-- maybe (file name, module name) +-- TODO: error handling + +recompileConfigIfNeeded :: IO (String,String) -- ^ Maybe (FileName,ModuleName) +recompileConfigIfNeeded = withLock $ do + dir <- getConfigDir + dirExists <- doesDirectoryExist dir + unless dirExists $ + createDirectoryIfMissing True dir + configFile <- getConfigFile + configFileExists <- doesFileExist configFile + unless configFileExists $ + writeFile configFile defaultPrelude + configInfosFile <- getConfigInfosFile + configInfosExists <- doesFileExist configInfosFile + if configInfosExists + then do + configInfos <- lines <$> readFile configInfosFile + if length configInfos /= 3 -- error + then recompileConfig + else do + let [fileName,moduleName,rawLastModTime] = configInfos + let withoutExt = dropExtension fileName + let hiFile = withoutExt ++ ".hi" + hiFileDoesntExist <- not <$> doesFileExist hiFile + let objFile = withoutExt ++ ".o" + objFileDoesntExist <- not <$> doesFileExist objFile + let lastModTime = (read rawLastModTime :: UTCTime) + currModTime <- getModificationTime configFile + if hiFileDoesntExist || objFileDoesntExist + || currModTime > lastModTime + then recompileConfig + else return (fileName,moduleName) + else recompileConfig + + +-- TODO: error handling +recompileConfig :: IO (String,String) +recompileConfig = do + configFile <- getConfigFile + cacheDir <- getCacheDir + sourceFile <- getSourceFile + extensionFile <- getExtensionsFile + modulesFile <- getModulesFile + compiledFile <- getCompiledFile + configInfosFile <- getConfigInfosFile + recompileConfig' configFile + cacheDir + sourceFile + extensionFile + modulesFile + compiledFile + configInfosFile + +recompileConfig' :: FilePath -- ^ config file + -> FilePath -- ^ cache dir + -> FilePath -- ^ source file + -> FilePath -- ^ output extensions cache file + -> FilePath -- ^ output modules cache file + -> FilePath -- ^ output compiled file + -> FilePath -- ^ output config info path + -> IO (String,String) +recompileConfig' configFile + cacheDir + sourceFile + extensionsFile + modulesFile + compiledFile + configInfosFile = do + clean + createDirectoryIfMissing True cacheDir + + extensions <- parseExtensions configFile + orig_modules <- parseModules configFile extensions + orig_source <- parseSource configFile + + let modules = extendModules extensions orig_modules + let source = extendSource configFile extensions orig_modules orig_source + + cacheExtensions extensionsFile extensions + cacheModules modulesFile modules + cacheSource sourceFile source + + compile sourceFile compiledFile cacheDir + + let moduleName = getModuleName source + lastModTime <- getModificationTime configFile + writeFile configInfosFile $ unlines [sourceFile + ,moduleName + ,show lastModTime] + + return (sourceFile, moduleName) + where + clean :: IO () + clean = do + dirExists <- doesDirectoryExist cacheDir + when (dirExists) (removeDirectoryRecursive cacheDir) diff --git a/src/System/Console/Hawk/IO.hs b/src/System/Console/Hawk/IO.hs new file mode 100644 --- /dev/null +++ b/src/System/Console/Hawk/IO.hs @@ -0,0 +1,45 @@ +-- 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 NoImplicitPrelude #-} +-- | Used by Hawk's runtime to write to stdout. +-- The API may change at any time. +module System.Console.Hawk.IO + (getInput + ,printOutput) +where + +import Control.Exception + (handle) +import Data.ByteString.Lazy.Char8 +import GHC.IO.Exception + (IOErrorType(ResourceVanished) + ,IOException(ioe_type)) +import System.IO + (hFlush + ,hPrint + ,stderr + ,stdout) +import Prelude hiding (getContents,putStrLn,readFile) + +getInput :: Maybe FilePath + -> IO ByteString +getInput = maybe getContents readFile + +printOutput :: ByteString + -> IO () +printOutput s = handle ioHandler (putStrLn s >> hFlush stdout) + where ioHandler e = case ioe_type e of + ResourceVanished -> return () + _ -> hPrint stderr e diff --git a/src/System/Console/Hawk/Lock.hs b/src/System/Console/Hawk/Lock.hs new file mode 100644 --- /dev/null +++ b/src/System/Console/Hawk/Lock.hs @@ -0,0 +1,122 @@ +-- 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.Lock + ( withLock + , withTestLock + ) where + +import Control.Concurrent ( threadDelay ) +import Control.Exception +import Control.Monad ( when, guard ) +import Data.List ( elemIndex ) +import GHC.IO.Exception +import GHC.IO.Handle ( Handle, hGetContents, hClose ) +import Network.BSD ( getProtocolNumber ) -- still cross-platform, don't let the name fool you +import Network ( PortID (..), connectTo ) +import Network.Socket +import Text.Printf + + +-- use a socket number as a lock indicator. +withSocketLock :: Bool -> IO a -> IO a +withSocketLock testing = withSocketsDo . bracket (lock testing) unlock . const + +-- make sure GHC inlines withSocketLock in the following two functions +-- and optimizes the testing and non-testing versions separately. +{-# INLINE withSocketLock #-} + +withLock :: IO a -> IO a +withLock = withSocketLock False + +withTestLock :: IO a -> IO a +withTestLock = withSocketLock True + + +type Lock = Socket + +lock :: Bool -> IO Lock +lock testing = catchJust isADDRINUSE openSocket $ \() -> do + -- open failed, the lock must be in use. + + when testing $ putStrLn "** LOCKED **" + + -- used to test an interleaving in which the socket is closed here, + -- between openSocket and waitForException. + when testing $ threadDelay 20000 + + -- wait for the other instance to signal that it is done with the lock. + catchJust isDisconnected waitForException $ \reason -> do + -- we were disconnected, the server must have released the lock! + + when testing $ printf "** UNLOCKED (%s) **\n" reason + + -- try again. + lock testing + +unlock :: Lock -> IO () +unlock = closeSocket + + +waitForException :: IO a +waitForException = bracket openHandle closeHandle $ \h -> do + s <- hGetContents h + length s `seq` return () -- blocks until EOF, which never comes + -- because the server never accepted the connection + error $ printf "port %s in use by a program other than hawk" $ show portNumber + + +isADDRINUSE :: IOError -> Maybe () +isADDRINUSE = guard . (== "bind") . ioe_location + +isDisconnected :: IOError -> Maybe String +isDisconnected = fmap (xs !!) . indexOf . ioe_location + where + xs = ["connect", "hGetContents"] + indexOf x = elemIndex x xs + + +openHandle :: IO Handle +openHandle = connectTo "localhost" $ PortNumber portNumber + +closeHandle :: Handle -> IO () +closeHandle = hClose + + +openSocket :: IO Socket +openSocket = listenOn portNumber + +closeSocket :: Socket -> IO () +closeSocket = sClose + + +-- the first few [0-9] characters of the sha1 of "hawk" +portNumber :: PortNumber +portNumber = 62243 + +-- from the source of Network.listenTo +listenOn :: PortNumber -> IO Socket +listenOn port = do + proto <- getProtocolNumber "tcp" + bracketOnError + (socket AF_INET Stream proto) + (sClose) + (\sock -> do + -- unlike the original listenOn, we do NOT set ReuseAddr. + -- this way the call will fail if another instance holds the lock. + --setSocketOption sock ReuseAddr 1 + bindSocket sock (SockAddrInet port iNADDR_ANY) + listen sock maxListenQueue + return sock + ) diff --git a/src/System/Console/Hawk/Options.hs b/src/System/Console/Hawk/Options.hs new file mode 100644 --- /dev/null +++ b/src/System/Console/Hawk/Options.hs @@ -0,0 +1,113 @@ +-- 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.Options where + +import Data.ByteString (ByteString) + +import qualified Data.ByteString.Char8 as C8 +import qualified Data.List as L +import qualified System.FilePath as FP + +import System.Console.GetOpt + + +data Modes = EvalMode | ApplyMode | MapMode + deriving (Eq,Enum,Read,Show) + +data Options = Options { optMode :: Modes + , optLinesDelim :: ByteString + , optWordsDelim :: ByteString + , optOutLinesDelim :: Maybe ByteString + , optOutWordsDelim :: Maybe ByteString + , optRecompile :: Bool + , optVersion :: Bool + , optHelp :: Bool + , optIgnoreErrors :: Bool + , optModuleFile :: Maybe FP.FilePath} + deriving Show + +defaultOptions :: Options +defaultOptions = Options { optMode = EvalMode + , optLinesDelim = C8.singleton '\n' + , optWordsDelim = C8.singleton ' ' + , optOutLinesDelim = Nothing + , optOutWordsDelim = Nothing + , optRecompile = False + , optVersion = False + , optHelp = False + , optIgnoreErrors = False + , optModuleFile = Nothing } + +delimiter :: ByteString -> ByteString +delimiter = C8.concat . (\ls -> L.head ls:L.map subFirst (L.tail ls)) + . C8.splitWith (== '\\') + where subFirst s = case C8.head s of + 'n' -> C8.cons '\n' $ C8.tail s + 't' -> C8.cons '\t' $ C8.tail s + _ -> s + +options :: [OptDescr (Options -> Options)] +options = + -- delimiters + [ Option ['D'] ["lines-delimiter"] (OptArg delimiterAction "") delimiterHelp + , Option ['d'] ["words-delimiter"] (OptArg wordsDelimAction "") wordsDelimHelp + , Option ['O'] ["output-lines-delim"] (OptArg outDelimAction "") outDelimHelp + , Option ['o'] ["output-words-delim"] (OptArg outWordsDelimAction "") outWordsDelimHelp + + -- modes + , Option ['a'] ["apply"] (NoArg $ setMode ApplyMode) applyHelp + , Option ['m'] ["map"] (NoArg $ setMode MapMode) mapHelp + + -- other options + , Option ['r'] ["recompile"] (NoArg setRecompile) recompileHelp + , Option ['v'] ["version"] (NoArg $ \o -> o{ optVersion = True }) versionHelp + , Option ['h'] ["help"] (NoArg $ \o -> o{ optHelp = True }) helpHelp +-- , Option ['k'] ["keep-going"] (NoArg keepGoingAction) keepGoingHelp + ] + where outDelimAction d o = o{ optOutLinesDelim = fmap (delimiter . C8.pack) d } + outDelimHelp = "output lines delimiter, default " ++ + "is equal to the input lines delimiter (-D)" + outWordsDelimAction d o = o{ optOutWordsDelim = fmap (delimiter . C8.pack) d } + outWordsDelimHelp = "output words delimiter, default " ++ + "is equal to the input words delimiter (-d)" + delimiterAction ms o = let d = case ms of + Nothing -> C8.pack "" + Just "" -> C8.pack "" + Just s -> delimiter $ C8.pack s + in o{ optLinesDelim = d } + delimiterHelp = "lines delimiter, default '\\n'" + wordsDelimAction ms o = let d = case ms of + Nothing -> C8.pack "" + Just "" -> C8.pack "" + Just s -> delimiter $ C8.pack s + in o{ optWordsDelim = d} + wordsDelimHelp = "words delimiter, default ' '" + setRecompile o = o{ optRecompile = True} + recompileHelp = "recompile ~/.hawk/prelude.hs\neven if it did not change" + + applyHelp = "apply to the stream" + mapHelp = "map to the stream" + + versionHelp = "print the version number and exit" + helpHelp = "print this help message and exit" + --keepGoingAction o = o{ optIgnoreErrors = True} + --keepGoingHelp = "keep going when one line fails" + setMode m o = o{ optMode = m } + +compileOpts :: [String] -> Either [String] (Options,[String]) +compileOpts argv = + case getOpt Permute options argv of + (os,nos,[]) -> Right (L.foldl (.) id (L.reverse os) defaultOptions, nos) + (_,_,errs) -> Left errs diff --git a/src/System/Console/Hawk/Representable.hs b/src/System/Console/Hawk/Representable.hs new file mode 100644 --- /dev/null +++ b/src/System/Console/Hawk/Representable.hs @@ -0,0 +1,365 @@ +-- 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. + +-- | Used by Hawk's runtime to format the output of a Hawk expression. +-- You can use this from your user prelude if you want Hawk to print +-- your custom datatypes in a console-friendly format. +module System.Console.Hawk.Representable ( + + ListAsRow (listRepr') + , ListAsRows (listRepr) + , Row (repr') + , Rows (repr) + +) where + +import Prelude +import Data.ByteString.Lazy.Char8 (ByteString) +import qualified Data.ByteString.Lazy.Char8 as C8 hiding (hPutStrLn) +import qualified Data.List as L +import Data.Set (Set) +import qualified Data.Set as S +import Data.Map (Map) +import qualified Data.Map as M + + +-- | A type that instantiate ListAsRow is a type that has a representation +-- when is embedded inside a list +-- +-- For example: +-- +-- >>> mapM_ Data.ByteString.Lazy.Char8.putStrLn $ repr Data.ByteString.Lazy.Char8.empty "test" +-- test +class (Show a) => ListAsRow a where + listRepr' :: ByteString -> [a] -> ByteString + listRepr' d = C8.intercalate d . L.map (C8.pack . show) + +instance ListAsRow Bool +instance ListAsRow Float +instance ListAsRow Double +instance ListAsRow Int +instance ListAsRow Integer +instance ListAsRow () + +instance (ListAsRow a) => ListAsRow [a] where + -- todo check the first delimiter if it should be d + listRepr' d = C8.intercalate d . L.map (listRepr' d) + +instance (Row a) => ListAsRow (Maybe a) where + listRepr' d = C8.intercalate d . L.map (repr' d) + +instance (ListAsRow a) => ListAsRow (Set a) where + listRepr' d = listRepr' d . L.map (listRepr' d . S.toList) + +instance ListAsRow Char where + listRepr' _ = C8.pack + +instance ListAsRow ByteString where + listRepr' d = C8.intercalate d + +instance (Row a, Row b) => ListAsRow (Map a b) where + listRepr' d = listRepr' d . L.map (listRepr' d . M.toList) + +instance (Row a,Row b) => ListAsRow (a,b) where + listRepr' d = C8.intercalate d . L.map (\(x,y) -> C8.unwords + [repr' d x,repr' d y]) + +instance (Row a,Row b,Row c) => ListAsRow (a,b,c) where + listRepr' d = C8.intercalate d . L.map (\(x,y,z) -> C8.unwords + [repr' d x,repr' d y,repr' d z]) + +instance (Row a,Row b,Row c,Row d) => ListAsRow (a,b,c,d) where + listRepr' d = C8.intercalate d . L.map (\(a,b,c,e) -> C8.unwords + [repr' d a,repr' d b,repr' d c,repr' d e]) + +instance (Row a,Row b,Row c,Row d,Row e) => ListAsRow (a,b,c,d,e) where + listRepr' d = C8.intercalate d . L.map (\(a,b,c,e,f) -> C8.unwords + [repr' d a,repr' d b,repr' d c,repr' d e,repr' d f]) + +instance (Row a,Row b,Row c,Row d,Row e,Row f) => ListAsRow (a,b,c,d,e,f) where + listRepr' d = C8.intercalate d . L.map (\(a,b,c,e,f,g) -> C8.unwords + [repr' d a,repr' d b,repr' d c,repr' d e,repr' d f + ,repr' d g]) + +instance (Row a,Row b,Row c,Row d,Row e,Row f,Row g) + => ListAsRow (a,b,c,d,e,f,g) where + listRepr' d = C8.intercalate d . L.map (\(a,b,c,e,f,g,h) -> C8.unwords + [repr' d a,repr' d b,repr' d c,repr' d e,repr' d f + ,repr' d g,repr' d h]) + +instance (Row a,Row b,Row c,Row d,Row e,Row f,Row g,Row h) + => ListAsRow (a,b,c,d,e,f,g,h) where + listRepr' d = C8.intercalate d . L.map (\(a,b,c,e,f,g,h,i) -> C8.unwords + [repr' d a,repr' d b,repr' d c,repr' d e,repr' d f + ,repr' d g,repr' d h,repr' d i]) + +instance (Row a,Row b,Row c,Row d,Row e,Row f,Row g,Row h,Row i) + => ListAsRow (a,b,c,d,e,f,g,h,i) where + listRepr' d = C8.intercalate d . L.map (\(a,b,c,e,f,g,h,i,l) -> C8.unwords + [repr' d a,repr' d b,repr' d c,repr' d e,repr' d f + ,repr' d g,repr' d h,repr' d i,repr' d l]) + +instance (Row a,Row b,Row c,Row d,Row e,Row f,Row g,Row h,Row i,Row l) + => ListAsRow (a,b,c,d,e,f,g,h,i,l) where + listRepr' d = C8.intercalate d . L.map (\(a,b,c,e,f,g,h,i,l,m) -> C8.unwords + [repr' d a,repr' d b,repr' d c,repr' d e,repr' d f + ,repr' d g,repr' d h,repr' d i,repr' d l,repr' d m]) + + + +-- | A Row is something that can be expressed as a line. +-- The output of repr' should be formatted such that +-- it can be read and processed from the command line. +-- +-- For example: +-- +-- >>> IO.putStrLn $ show [1,2,3,4] +-- [1,2,3,4] +-- +-- >>> Data.ByteString.Lazy.Char8.putStrLn $ repr' (Data.ByteString.Lazy.Char8.pack " ") [1,2,3,4] +-- 1 2 3 4 +class (Show a) => Row a where + repr' :: ByteString -- ^ columns delimiter + -> a -- ^ value to represent + -> ByteString + repr' _ = C8.pack . show + +instance Row Bool +instance Row Float +instance Row Double +instance Row Int +instance Row Integer +instance Row () + +instance Row Char where + repr' _ = C8.singleton + +instance (ListAsRow a) => Row [a] where + repr' = listRepr' + +instance (ListAsRow a) => Row (Set a) where + repr' d = listRepr' d . S.toList + +instance (Row a,Row b) => Row (Map a b) where + repr' d = listRepr' d . M.toList + +instance Row ByteString where + repr' _ = id + +instance (Row a) => Row (Maybe a) where + repr' _ Nothing = C8.empty + repr' d (Just x) = repr' d x -- check if d is correct here + +instance (Row a,Row b) => Row (a,b) where + repr' d (a,b) = repr' d a `C8.append` (d `C8.append` repr' d b) + --repr' d (a,b) = repr' d [repr' d a,repr' d b] + +instance (Row a,Row b,Row c) => Row (a,b,c) where + repr' d (a,b,c) = repr' d a `C8.append` (d `C8.append` + (repr' d b `C8.append` (d `C8.append` repr' d c))) + +instance (Row a,Row b,Row c,Row d) => Row (a,b,c,d) where + repr' d (a,b,c,e) = repr' d a `C8.append` (d `C8.append` + (repr' d b `C8.append` (d `C8.append` + (repr' d c `C8.append` (d `C8.append` repr' d e))))) + +instance (Row a,Row b,Row c,Row d,Row e) => Row (a,b,c,d,e) where + repr' d (a,b,c,e,f) = repr' d a `C8.append` (d `C8.append` + (repr' d b `C8.append` (d `C8.append` + (repr' d c `C8.append` (d `C8.append` + (repr' d e `C8.append` (d `C8.append` repr' d f))))))) + +instance (Row a,Row b,Row c,Row d,Row e,Row f) => Row (a,b,c,d,e,f) where + repr' d (a,b,c,e,f,g) = repr' d a `C8.append` (d `C8.append` + (repr' d b `C8.append` (d `C8.append` + (repr' d c `C8.append` (d `C8.append` + (repr' d e `C8.append` (d `C8.append` + (repr' d f `C8.append` (d `C8.append` repr' d g))))))))) + +instance (Row a,Row b,Row c,Row d,Row e,Row f,Row g) => Row (a,b,c,d,e,f,g) where + repr' d (a,b,c,e,f,g,h) = repr' d a `C8.append` (d `C8.append` + (repr' d b `C8.append` (d `C8.append` + (repr' d c `C8.append` (d `C8.append` + (repr' d e `C8.append` (d `C8.append` + (repr' d f `C8.append` (d `C8.append` + (repr' d g `C8.append` (d `C8.append` repr' d h))))))))))) + +instance (Row a,Row b,Row c,Row d,Row e,Row f,Row g,Row h) + => Row (a,b,c,d,e,f,g,h) where + repr' d (a,b,c,e,f,g,h,i) = + repr' d a `C8.append` (d `C8.append` + (repr' d b `C8.append` (d `C8.append` + (repr' d c `C8.append` (d `C8.append` + (repr' d e `C8.append` (d `C8.append` + (repr' d f `C8.append` (d `C8.append` + (repr' d g `C8.append` (d `C8.append` + (repr' d h `C8.append` (d `C8.append` repr' d i))))))))))))) + +instance (Row a,Row b,Row c,Row d,Row e,Row f,Row g,Row h,Row i) + => Row (a,b,c,d,e,f,g,h,i) where + repr' d (a,b,c,e,f,g,h,i,l) = + repr' d a `C8.append` (d `C8.append` + (repr' d b `C8.append` (d `C8.append` + (repr' d c `C8.append` (d `C8.append` + (repr' d e `C8.append` (d `C8.append` + (repr' d f `C8.append` (d `C8.append` + (repr' d g `C8.append` (d `C8.append` + (repr' d h `C8.append` (d `C8.append` + (repr' d i `C8.append` (d `C8.append` repr' d l))))))))))))))) + +instance (Row a,Row b,Row c,Row d,Row e,Row f,Row g,Row h,Row i,Row l) + => Row (a,b,c,d,e,f,g,h,i,l) where + repr' d (a,b,c,e,f,g,h,i,l,m) = + repr' d a `C8.append` (d `C8.append` + (repr' d b `C8.append` (d `C8.append` + (repr' d c `C8.append` (d `C8.append` + (repr' d e `C8.append` (d `C8.append` + (repr' d f `C8.append` (d `C8.append` + (repr' d g `C8.append` (d `C8.append` + (repr' d h `C8.append` (d `C8.append` + (repr' d i `C8.append` (d `C8.append` + (repr' d l `C8.append` (d `C8.append` repr' d m))))))))))))))))) + + +-- | A type that instantiate ListAsRows is a type that has a representation +-- when is embedded inside a list +-- +-- Note: we use this class for representing a list of chars as String +-- instead of the standard list representation. Without this repr "test" would +-- yield ['t','e','s','r'] instead of "test". +-- +-- For example: +-- +-- >>> mapM_ Data.ByteString.Lazy.Char8.putStrLn $ repr Data.ByteString.Lazy.Char8.empty "test" +-- test +class (Row a) => ListAsRows a where + listRepr :: ByteString -- ^ column delimiter + -> [a] -- ^ list of values to represent + -> [ByteString] + listRepr d = L.map (repr' d) + +instance ListAsRows ByteString +instance ListAsRows Bool +instance ListAsRows Double +instance ListAsRows Float +instance ListAsRows Int +instance ListAsRows Integer +instance (Row a) => ListAsRows (Maybe a) +instance ListAsRows () +instance (ListAsRow a,ListAsRows a) => ListAsRows [a] +instance (Row a,Row b) => ListAsRows (a,b) +instance (Row a,Row b,Row c) => ListAsRows (a,b,c) +instance (Row a,Row b,Row c,Row d) => ListAsRows (a,b,c,d) +instance (Row a,Row b,Row c,Row d,Row e) => ListAsRows (a,b,c,d,e) +instance (Row a,Row b,Row c,Row d,Row e,Row f) => ListAsRows (a,b,c,d,e,f) +instance (Row a,Row b,Row c,Row d,Row e,Row f,Row g) => ListAsRows (a,b,c,d,e,f,g) +instance (Row a,Row b,Row c,Row d,Row e,Row f,Row g,Row h) + => ListAsRows (a,b,c,d,e,f,g,h) +instance (Row a,Row b,Row c,Row d,Row e,Row f,Row g,Row h,Row i) + => ListAsRows (a,b,c,d,e,f,g,h,i) +instance (Row a,Row b,Row c,Row d,Row e,Row f,Row g,Row h,Row i,Row l) + => ListAsRows (a,b,c,d,e,f,g,h,i,l) + +instance ListAsRows Char where + listRepr _ = (:[]) . C8.pack + +instance (ListAsRow a,ListAsRows a) => ListAsRows (Set a) where + listRepr d = listRepr d . L.map S.toList + +instance (Row a,Row b) => ListAsRows (Map a b) where + listRepr d = listRepr d . L.map M.toList + +instance (ListAsRows a) => Rows [a] where + repr = listRepr + + +-- | A type that instantiate Rows is a type that can be represented as +-- a list of rows, where typically a row is a line. +-- +-- For example: +-- +-- >>> mapM_ Data.ByteString.Lazy.Char8.putStrLn $ repr (Data.ByteString.Lazy.Char8.singleton '\n') [1,2,3,4] +-- 1 +-- 2 +-- 3 +-- 4 +class (Show a) => Rows a where + -- | Return a representation of the given value as list of strings. + repr :: ByteString -- ^ rows delimiter + -> a -- ^ value to represent + -> [C8.ByteString] + repr _ = (:[]) . C8.pack . show + + +instance Rows Bool +instance Rows Double +instance Rows Float +instance Rows Int +instance Rows Integer + +instance Rows () where + repr _ = const [C8.empty] + +instance Rows Char where + repr _ = (:[]) . C8.singleton + +instance Rows ByteString where + repr _ = (:[]) + +instance (Rows a) => Rows (Maybe a) where + repr d = maybe [C8.empty] (repr d) + +instance (Row a, Row b) => Rows (Map a b) where + repr d = listRepr d . M.toList + +instance (ListAsRows a) => Rows (Set a) where + repr d = listRepr d . S.toList + +instance (Row a, Row b) => Rows (a,b) where + repr d (x,y) = [repr' d x,repr' d y] + +instance (Row a, Row b, Row c) => Rows (a,b,c) where + repr d (a,b,c) = [repr' d a, repr' d b, repr' d c] + +instance (Row a, Row b, Row c, Row d) => Rows (a,b,c,d) where + repr d (a,b,c,e) = [repr' d a, repr' d b, repr' d c, repr' d e] + +instance (Row a, Row b, Row c, Row d, Row e) => Rows (a,b,c,d,e) where + repr d (a,b,c,e,f) = [repr' d a, repr' d b, repr' d c, repr' d e, repr' d f] + +instance (Row a, Row b, Row c, Row d, Row e, Row f) => Rows (a,b,c,d,e,f) where + repr d (a,b,c,e,f,g) = [repr' d a, repr' d b, repr' d c,repr' d e + ,repr' d f, repr' d g] + +instance (Row a, Row b, Row c, Row d, Row e, Row f, Row g) + => Rows (a,b,c,d,e,f,g) where + repr d (a,b,c,e,f,g,h) = [repr' d a, repr' d b, repr' d c,repr' d e + ,repr' d f, repr' d g, repr' d h] + +instance (Row a, Row b, Row c, Row d, Row e, Row f, Row g, Row h) + => Rows (a,b,c,d,e,f,g,h) where + repr d (a,b,c,e,f,g,h,i) = [repr' d a, repr' d b, repr' d c, repr' d e + ,repr' d f, repr' d g, repr' d h, repr' d i] + +instance (Row a, Row b, Row c, Row d, Row e, Row f, Row g, Row h, Row i) + => Rows (a,b,c,d,e,f,g,h,i) where + repr d (a,b,c,e,f,g,h,i,l) = [repr' d a, repr' d b, repr' d c, repr' d e + ,repr' d f, repr' d g, repr' d h, repr' d i + , repr' d l] + +instance (Row a, Row b, Row c, Row d, Row e, Row f, Row g, Row h, Row i, Row l) + => Rows (a,b,c,d,e,f,g,h,i,l) where + repr d (a,b,c,e,f,g,h,i,l,m) = [repr' d a, repr' d b, repr' d c, repr' d e + ,repr' d f, repr' d g, repr' d h, repr' d i + ,repr' d l, repr' d m] diff --git a/src/System/Console/Hawk/Runtime.hs b/src/System/Console/Hawk/Runtime.hs new file mode 100644 --- /dev/null +++ b/src/System/Console/Hawk/Runtime.hs @@ -0,0 +1,165 @@ +-- 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 ExistentialQuantification + , ExtendedDefaultRules + , OverloadedStrings + , ScopedTypeVariables #-} + +-- | This is Hawk's runtime, it needs to be installed in order to evaluate Hawk +-- expressions. The API may change at any time. +module System.Console.Hawk.Runtime ( + c8pack + , sc8pack + , listMap + , listMapWords + , printRows + , printRow + , parseRows + , parseWords + , showRows + , runExpr +-- , runExprs +) where + +import Prelude +import Control.Exception (SomeException,handle) +import qualified Data.ByteString.Char8 as SC8 +import Data.ByteString.Lazy.Char8 (ByteString) +import qualified Data.ByteString.Lazy.Char8 as C8 hiding (hPutStrLn) +import qualified Data.List as L +import qualified Data.ByteString.Lazy.Search as BS +import qualified System.IO as IO + +import System.Console.Hawk.Representable +import qualified System.Console.Hawk.IO as HawkIO + +handleErrors :: IO () -> IO () +handleErrors = handle (\(e :: SomeException) -> IO.hPrint IO.stderr e) + +dropLastIfEmpty :: [C8.ByteString] -> [C8.ByteString] +dropLastIfEmpty [] = [] +dropLastIfEmpty (x:[]) = if C8.null x then [] else [x] +dropLastIfEmpty (x:xs) = x:dropLastIfEmpty xs + +listMap :: (a -> b) -> [a] -> [b] +listMap = L.map + +listMapWords :: ([a] -> b) -> [[a]] -> [b] +listMapWords = L.map + +c8pack :: String + -> C8.ByteString +c8pack = C8.pack + +sc8pack :: String + -> SC8.ByteString +sc8pack = SC8.pack + +dropTrailingNewline :: C8.ByteString -> C8.ByteString +dropTrailingNewline "" = "" +dropTrailingNewline s = if last_char == '\r' then s' else s + where last_char = C8.last s + n = C8.length s + s' = C8.take (n - 1) s + +-- if delim is "\n", Windows-style "\r\n" delimiters are also accepted. +parseRows :: SC8.ByteString -> C8.ByteString -> [C8.ByteString] +parseRows delim str = dropLastIfEmpty + $ maybeDropTrailingNewline + $ BS.split delim str + where maybeDropTrailingNewline = if delim == "\n" + then map dropTrailingNewline + else id + +---- special case for space +parseWords :: SC8.ByteString -> SC8.ByteString -> C8.ByteString -> [[C8.ByteString]] +parseWords rowsDelim columnsDelim str = let rows = parseRows rowsDelim str + in L.map f rows + where f = if columnsDelim == SC8.singleton ' ' + then L.filter (not . C8.null) . BS.split columnsDelim + else BS.split columnsDelim + +--parseWords :: SC8.ByteString -> [C8.ByteString] -> [[C8.ByteString]] +--parseWords delim strs = L.map f strs +-- where f = if delim == SC8.singleton ' ' +-- then L.filter (not . C8.null) . BS.split delim +-- else BS.split delim + +--runOnInput :: Maybe FilePath -- ^ the input file or stdout when Nothing +-- -> (C8.ByteString -> IO ()) -- ^ the action to run on the input +-- -> IO () +--runOnInput fp f = do +-- input <- maybe C8.getContents C8.readFile fp +-- f input +-- IO.hFlush IO.stdout + -- TODO: we need also hFlush stderr? + +runExpr :: Maybe FilePath -- ^ if the input is a file + -> (Maybe FilePath -> IO C8.ByteString) -- ^ input reader + -> (C8.ByteString -> C8.ByteString) + -> (C8.ByteString -> IO ()) + -> IO () +runExpr m i f o = i m >>= o . f +--runExpr = runOnInput +-- +--runExprs :: Maybe FilePath -> (C8.ByteString -> [IO ()]) -> IO () +--runExprs fp f = runOnInput fp (sequence_ . f) +-- +showRows :: forall a . (Rows a) + => C8.ByteString -- ^ rows delimiter + -> C8.ByteString -- ^ columns delimiter + -> a -- ^ value to print + -> C8.ByteString +showRows rd cd = C8.intercalate rd . repr cd + +printRows :: forall a . (Rows a) + => Bool -- ^ if printRows will continue after errors + -> C8.ByteString -- ^ rows delimiter + -> C8.ByteString -- ^ columns delimiter + -> a -- ^ the value to print as rows + -> IO () +printRows _ rd cd = HawkIO.printOutput . showRows rd cd +--printRows _ rd cd v = handle handler printRows_ +-- where handler e = case ioe_type e of +-- ResourceVanished -> return () +-- _ -> IO.hPrint IO.stderr e +-- printRows_ = C8.putStrLn (showRows rd cd v) >> IO.hFlush IO.stdout +--printRows b rowDelimiter columnDelimiter = printFirstRow_ . repr columnDelimiter +-- where printRows_ [] = return () +-- printRows_ (x:xs) = do +-- putStrAndDelim x +-- handle ioExceptionsHandler (continue xs) +-- printFirstRow_ [] = return () +-- printFirstRow_ (x:xs) = do +-- putStrOnly x +-- handle ioExceptionsHandler (continue xs) +-- putStrAndDelim = if b then handleErrors . putDelimAndStr_ +-- else putDelimAndStr_ +-- putStrOnly = if b then handleErrors . C8.putStr else C8.putStr +-- putDelimAndStr_ :: C8.ByteString -> IO () +-- putDelimAndStr_ c = C8.putStr rowDelimiter >> C8.putStr c +-- continue xs = IO.hFlush IO.stdout >> printRows_ xs +-- ioExceptionsHandler e = case ioe_type e of +-- ResourceVanished -> return () +-- _ -> IO.hPrint IO.stderr e + +printRow :: forall a . (Row a) + => Bool -- ^ if printRow should continue after errors + -> ByteString -- ^ the column delimiter + -> a -- ^ the value to print + -> IO () +printRow b d = if b then handleErrors . f else f + where f = C8.putStrLn . repr' d + diff --git a/src/System/Console/Hawk/Sandbox.hs b/src/System/Console/Hawk/Sandbox.hs new file mode 100644 --- /dev/null +++ b/src/System/Console/Hawk/Sandbox.hs @@ -0,0 +1,147 @@ +-- 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. + +-- Extra steps to be performed if hawk was installed from a sandbox. +-- +-- Extra steps are needed because the hawk binary needs runtime access +-- to the hawk library, but the hint library only knows about the globally- +-- installed libraries. If hawk has been installed with a sandbox, its +-- binary and its library will be installed in a local folder instead of +-- in the global location. +module System.Console.Hawk.Sandbox + ( extraGhcArgs + , runHawkInterpreter + ) where + +import Control.Applicative +import Control.Monad +import Data.List +import Language.Haskell.Interpreter (InterpreterT, InterpreterError) +import Language.Haskell.Interpreter.Unsafe (unsafeRunInterpreterWithArgs) +import System.Directory (getDirectoryContents, getHomeDirectory, doesFileExist) +import System.Environment (getExecutablePath) +import System.FilePath (pathSeparator, splitFileName) +import Text.Printf (printf) + + +data Sandbox = Sandbox + { folder :: FilePath + , packageFilePrefix :: String + , packageFileSuffix :: String + } + +cabalDev, cabalSandbox :: Sandbox +cabalDev = Sandbox "cabal-dev" "packages-" ".conf" +cabalSandbox = Sandbox ".cabal-sandbox" "" "-packages.conf.d" + +-- all the sandbox systems we support. +sandboxes :: [Sandbox] +sandboxes = [cabalDev, cabalSandbox] + + +-- a version of isSuffixOf which returns the string stripped of its suffix. +isSuffixOf' :: String -> String -> Maybe String +isSuffixOf' suffix s = if suffix `isSuffixOf` s + then Just (take (n - m) s) + else Nothing + where + n = length s + m = length suffix + +-- a version of doesFileExist which returns the file path if it exists. +doesFileExist' :: FilePath -> IO (Maybe FilePath) +doesFileExist' f = do + r <- doesFileExist f + if r + then return (Just f) + else return Nothing + +firstWhichExists :: [FilePath] -> IO (Maybe FilePath) +firstWhichExists fs = do + fs' <- mapM doesFileExist' fs + return $ msum fs' + + +-- convert slashes to backslashes if needed +path :: String -> String +path = map replaceSeparator where + replaceSeparator '/' = pathSeparator + replaceSeparator x = x + +-- a version of getExecutablePath which returns the path to the installed hawk +-- executable even the current executable is actually hawk's test suite. +getHawkPath :: IO FilePath +getHawkPath = do + executablePath <- getExecutablePath + case path "/dist/build/reference/reference" `isSuffixOf'` executablePath of + Nothing -> return executablePath + Just basePath -> do + -- We are running the test suite. Is hawk installed? + + home <- getHomeDirectory + let userPath = home ++ "/.cabal/bin/hawk" + + let folders = map folder sandboxes + let sandboxPaths = map (printf "%s/%s/bin/hawk" basePath) folders + + firstMatch <- firstWhichExists (userPath:sandboxPaths) + case firstMatch of + Nothing -> fail "please run 'cabal install' before 'cabal test'." + Just hawkPath -> return hawkPath + + +-- if hawk has been compiled by a sandboxing tool, +-- its binary has been placed in a special folder. +-- +-- return something like (Just "/.../cabal-dev") +getSandboxDir :: Sandbox -> IO (Maybe String) +getSandboxDir sandbox = do + (dir, _) <- splitFileName <$> getHawkPath + let sandboxFolder = folder sandbox + let suffix = path (sandboxFolder ++ "/bin/") + let basePath = suffix `isSuffixOf'` dir + let sandboxPath = fmap (++ sandboxFolder) basePath + return sandboxPath + +-- something like "packages-7.6.3.conf" +isPackageFile :: Sandbox -> FilePath -> Bool +isPackageFile sandbox f = packageFilePrefix sandbox `isPrefixOf` f + && packageFileSuffix sandbox `isSuffixOf` f + +-- something like "/.../cabal-dev/package-7.6.3.conf" +getPackageFile :: Sandbox -> String -> IO String +getPackageFile sandbox dir = do + files <- getDirectoryContents dir + let [file] = filter (isPackageFile sandbox) files + return $ printf (path "%s/%s") dir file + +sandboxSpecificGhcArgs :: Sandbox -> IO [String] +sandboxSpecificGhcArgs sandbox = do + sandboxDir <- getSandboxDir sandbox + case sandboxDir of + Nothing -> return [] + Just dir -> do packageFile <- getPackageFile sandbox dir + let arg = printf "-package-db %s" packageFile + return [arg] + + +extraGhcArgs :: IO [String] +extraGhcArgs = concat <$> mapM sandboxSpecificGhcArgs sandboxes + +-- a version of runInterpreter which can load libraries +-- installed along hawk's sandbox folder, if applicable. +runHawkInterpreter :: InterpreterT IO a -> IO (Either InterpreterError a) +runHawkInterpreter mx = do + args <- extraGhcArgs + unsafeRunInterpreterWithArgs args mx diff --git a/tests/RunTests.hs b/tests/RunTests.hs new file mode 100644 --- /dev/null +++ b/tests/RunTests.hs @@ -0,0 +1,29 @@ +-- 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. + +import qualified System.Console.Hawk.Representable.Test as ReprTest +import qualified System.Console.Hawk.Config.Test as ConfigTest +import qualified System.Console.Hawk.Test as HawkTest + +import Test.DocTest (doctest) +import Test.Hspec (hspec) + +main :: IO () +main = do + doctest ["-isrc", "tests/System/Console/Hawk/Lock/Test.hs"] + hspec $ do + ReprTest.reprSpec' + ReprTest.reprSpec + ConfigTest.spec + HawkTest.run diff --git a/tests/System/Console/Hawk/Representable/Test.hs b/tests/System/Console/Hawk/Representable/Test.hs new file mode 100644 --- /dev/null +++ b/tests/System/Console/Hawk/Representable/Test.hs @@ -0,0 +1,113 @@ +-- 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 ExtendedDefaultRules,OverloadedStrings #-} +module System.Console.Hawk.Representable.Test where + +import Data.Map (Map) +import qualified Data.Map as M +import Data.Set (Set) +import qualified Data.Set as S + +import System.Console.Hawk.Representable + +import Test.Hspec + + +-- explicitly type all values to avoid warnings. + +_1,_2,_3,_4,_5,_6,_7,_8,_9,_10 :: Int +(_1,_2,_3,_4,_5,_6,_7,_8,_9,_10) = (1,2,3,4,5,6,7,8,9,10) + +emptyString,word,word_word,w_w :: String +(emptyString,word,word_word,w_w) = ("","word","word word","w w") + + +reprSpec' :: Spec +reprSpec' = describe "repr'" $ do + it "can convert tuple values" $ do + example $ repr' " " (_1,True) `shouldBe` "1 True" + example $ repr' " " (_1,True,_2) `shouldBe` "1 True 2" + example $ repr' " " (_1,_2,_3,_4) `shouldBe` "1 2 3 4" + example $ repr' " " (_1,_2,_3,_4,_5) `shouldBe` "1 2 3 4 5" + example $ repr' " " (_1,_2,_3,_4,_5,_6) `shouldBe` "1 2 3 4 5 6" + example $ repr' " " (_1,_2,_3,_4,_5,_6,_7) `shouldBe` "1 2 3 4 5 6 7" + example $ repr' " " (_1,_2,_3,_4,_5,_6,_7,_8) `shouldBe` "1 2 3 4 5 6 7 8" + example $ repr' " " (_1,_2,_3,_4,_5,_6,_7,_8,_9) `shouldBe` "1 2 3 4 5 6 7 8 9" + example $ repr' " " (_1,_2,_3,_4,_5,_6,_7,_8,_9,_10) `shouldBe` "1 2 3 4 5 6 7 8 9 10" + +reprSpec :: Spec +reprSpec = describe "repr" $ do + it "can convert boolean values" $ do + repr "\t" True `shouldBe` ["True"] + repr "\t" False `shouldBe` ["False"] + + it "can convert char values" $ example $ + repr "\t" 'c' `shouldBe` ["c"] + + it "can convert double values" $ example $ + repr "\t" (1.1::Double) `shouldBe` ["1.1"] + + it "can convert float values" $ example $ + repr "\t" (1.1::Float) `shouldBe` ["1.1"] + + it "can convert int values" $ example $ + repr "\t" (1::Int) `shouldBe` ["1"] + + it "can convert integer values" $ example $ + repr "\t" (1::Integer) `shouldBe` ["1"] + + it "can convert maybe values" $ do + example $ repr "\t" (Nothing::Maybe ()) `shouldBe` [""] + example $ repr "\t" (Just 1::Maybe Int) `shouldBe` ["1"] + example $ repr "\t" (Just (Just True)) `shouldBe` ["True"] + + it "can convert unit value" $ + repr "\t" () `shouldBe` [""] + + it "can convert string values" $ do + example $ repr "\t" emptyString `shouldBe` [""] + example $ repr "\t" word `shouldBe` ["word"] + example $ repr "\t" word_word `shouldBe` ["word word"] + + it "can convert tuple values" $ do + example $ repr "\t" (_1,True) `shouldBe` ["1","True"] + example $ repr "\t" ((_1,_2),False) `shouldBe` ["1\t2","False"] + example $ repr "\t" (_1,_2,_3) `shouldBe` ["1","2","3"] + example $ repr "\t" (_1,_2,_3,_4) `shouldBe` ["1","2","3","4"] + example $ repr "\t" (_1,_2,_3,_4,_5) `shouldBe` ["1","2","3","4","5"] + example $ repr "\t" (_1,_2,_3,_4,_5,_6) `shouldBe` ["1","2","3","4","5","6"] + example $ repr "\t" (_1,_2,_3,_4,_5,_6,_7) `shouldBe` ["1","2","3","4","5","6","7"] + example $ repr "\t" (_1,_2,_3,_4,_5,_6,_7,_8) `shouldBe` ["1","2","3","4","5","6","7","8"] + example $ repr "\t" (_1,_2,_3,_4,_5,_6,_7,_8,_9) `shouldBe` ["1","2","3","4","5","6","7","8","9"] + example $ repr "\t" (_1,_2,_3,_4,_5,_6,_7,_8,_9,_10) `shouldBe` ["1","2","3","4","5","6","7","8","9","10"] + + it "can convert list values" $ do + repr "\t" ([]::[()]) `shouldBe` [] + example $ repr "\t" [True] `shouldBe` ["True"] + example $ repr "\t" [True,False] `shouldBe` ["True","False"] + example $ repr "\t" [Just _1,Nothing] `shouldBe` ["1",""] + example $ repr "\t" [[_1,_2,_3],[_4,_5,_6]] `shouldBe` ["1\t2\t3","4\t5\t6"] + example $ repr "\t" [w_w,w_w] `shouldBe` ["w w","w w"] + example $ repr "\t" [[w_w],[w_w]] `shouldBe` ["w w","w w"] + + it "can convert map values" $ do + repr "\t" (M.empty::Map Bool Bool) `shouldBe` [] + example $ repr "\t" (M.fromList [(_1,_2),(_3,_4)]) `shouldBe` ["1\t2","3\t4"] + example $ repr "\t" ([M.fromList [(_1,_2),(_3,_4)]]) `shouldBe` ["1 2\t3 4"] + + it "can convert set values" $ do + repr "\t" (S.empty::Set Bool) `shouldBe` [] + example $ repr "\t" (S.fromList [_1,_2,_3,_4]) `shouldBe` ["1","2","3","4"] + example $ repr "\t" ([S.fromList [_1,_2]]) `shouldBe` ["1\t2"]