ruby-qq (empty) → 0.1.0.0

raw patch · 4 files changed

+272/−0 lines, 4 filesdep +basedep +bytestringdep +haskell-src-extssetup-changed

Dependencies added: base, bytestring, haskell-src-exts, haskell-src-meta, pcre-light, process, template-haskell, trifecta

Files

LICENSE +21/−0
Setup.hs +2/−0
ruby-qq.cabal +30/−0
src/RubyQQ.hs +219/−0

+ LICENSE view

@@ -0,0 +1,21 @@+The MIT License (MIT)++Copyright (c) 2013 Joel Taylor++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in+all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN+THE SOFTWARE.

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ ruby-qq.cabal view

@@ -0,0 +1,30 @@+name:                ruby-qq+version:             0.1.0.0+synopsis:            rubyish quasiquoters+homepage:            https://github.com/joelteon/ruby-qq+license:             MIT+license-file:        LICENSE+author:              Joel Taylor+maintainer:          me@joelt.io+category:            System+build-type:          Simple+cabal-version:       >=1.10+description:+  Quasiquoters for @%w&#123;&#125;@, @%x&#123;&#125;@, @%r&#123;&#125;@, and @%q&#123;&#125;@.++library+  exposed-modules:     RubyQQ+  build-depends:       base >=4.6 && <4.7+                     , bytestring+                     , haskell-src-exts+                     , haskell-src-meta+                     , pcre-light+                     , process+                     , template-haskell+                     , trifecta+  hs-source-dirs:      src+  default-language:    Haskell2010++source-repository head+  type: git+  location: git://github.com/joelteon/ruby-qq.git

+ src/RubyQQ.hs view

@@ -0,0 +1,219 @@+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE ImplicitParams #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE OverlappingInstances #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE UndecidableInstances #-}++-- | Provides some quasiquoters that mimic Ruby's percent-letter syntax.+module RubyQQ (+    -- * Shell exec+    x, xx+    -- * Splitting on whitespace+  , w, ww+    -- * Strings+  , q, qq+    -- * Regular expressions+  , r, ri, rx, rix, (=~)+) where++import Control.Applicative+import Control.Monad+import Data.ByteString.Char8        (ByteString, pack)+import Data.Char+import Data.Function+import Data.Monoid+import Language.Haskell.Exts        (parseExp, ParseResult(..))+import Language.Haskell.Meta hiding (parseExp)+import Language.Haskell.TH+import Language.Haskell.TH.Quote+import System.Process+import System.IO+import Prelude hiding               (lex)+import Text.ParserCombinators.ReadP (readP_to_S)+import Text.Read.Lex+import Text.Regex.PCRE.Light+import Text.Trifecta++class Stringable a where asString :: a -> String++class Stringable' flag a where asString' :: flag -> a -> String++instance (StringPred flag a, Stringable' flag a) => Stringable a where+    asString = asString' (undefined :: flag)++class StringPred flag a | a -> flag where {}++instance StringPred HString String+instance (flag ~ HShowable) => StringPred flag a++instance Stringable' HString String where asString' _ = id+instance Show a => Stringable' HShowable a where asString' _ = show++data HString+data HShowable++expQuoter :: (String -> Q Exp) -> QuasiQuoter+expQuoter lam = QuasiQuoter+              lam+              (error "this quoter cannot be used in pattern context")+              (error "this quoter cannot be used in type context")+              (error "this quoter cannot be used in declaration context")++-- | @[x|script|]@ executes @script@ and returns @(stdout,stderr)@. It has type @'IO' ('String','String')@.+--+-- >>> [x|ls -a | wc -l|]+-- ("       8\n","")+--+-- >>> [x|echo >&2 "Hello, world!"|]+-- ("","Hello, world!\n")+x :: QuasiQuoter+x = expQuoter $+        \str -> [|do+                 (_, Just h, Just he, _) <- createProcess (shell $(stringE str))+                    { std_out = CreatePipe, std_err = CreatePipe }+                 (liftM2 (,) `on` hGetContents) h he|]++-- | @[xx|script|]@ spawns a shell process running @script@ and returns+-- @(hndl_stdin, hndl_stdout, hndl_stderr)@. It has type @'IO'+-- ('Handle','Handle','Handle')@.+--+-- >>> [xx|ls|]+-- ({handle: fd:8},{handle: fd:9},{handle: fd:11})+xx :: QuasiQuoter+xx = expQuoter $+        \str -> [|do+                 (Just hi, Just h, Just he, _) <- createProcess (shell $(stringE str))+                    { std_in = CreatePipe, std_out = CreatePipe, std_err = CreatePipe }+                 return (hi, h, he)|]++-- | @[w|input|]@ is a list containing @input@ split on all whitespace+-- characters.+--+-- Note that no escape expansion occurs:+--+-- >>> [w|hello\n world!|]+-- ["hello\\n","world!"]+w :: QuasiQuoter+w = expQuoter $+        \str -> case parseString safeWords mempty (' ':str) of+            Success strs -> listE $ map stringE strs+            n -> error $ show n++-- | @[ww|input|]@ is a list containing @input@ split on all whitespace+-- characters, with some extra features:+--+-- * Ruby-style interpolation is supported.+--+-- >>> [ww|foo bar #{ reverse "zab" }|]+-- ["foo","bar","baz"]+--+-- /This feature uses some typeclass magic to convert input into the/+-- /friendliest possible String format. If you encounter errors like "No/+-- /instance for (Stringable' flag [a0])", add a type signature to your/+-- /input./+--+-- * All escape sequences are interpreted.+--+-- >>> [ww|Here\n are\SOH some\x123 special\1132 characters\\!|]+-- ["Here\n","are\SOH","some\291","special\1132","characters\\!"]+ww :: QuasiQuoter+ww = expQuoter $+        \str -> case parseString interpWords mempty (' ':str) of+             Success strs -> listE strs+             Failure n -> error $ show n++-- | @[q|input|]@ is @input@. This quoter is essentially the identity+-- function. It is however a handy shortcut for multiline strings.+q :: QuasiQuoter+q = expQuoter stringE++-- | @[qq|input|]@ is @input@, with interpolation and escape sequences+-- expanded.+--+-- >>> let name = "Brian" in [qq|Hello, #{name}!|]+-- "Hello, Brian!"+qq :: QuasiQuoter+qq = expQuoter interpStr'++-- | @[r|pat|]@ is a regular expression defined by @pat@.+r :: QuasiQuoter+r = expQuoter $ \s -> [|compile (pack $(stringE s)) []|]++-- | @[ri|pat|]@ is @[r|pat|]@, but is case-insensitive.+ri :: QuasiQuoter+ri = expQuoter $ \s -> [|compile (pack $(stringE s)) [caseless]|]++-- | @[rx|pat|]@ is @[r|pat|]@, but ignores whitespace and comments in the+-- regex body.+rx :: QuasiQuoter+rx = expQuoter $ \s -> [|compile (pack $(stringE s)) [extended]|]++-- | @[rix|pat|]@ is a combination of @ri@ and @rx@.+rix :: QuasiQuoter+rix = expQuoter $ \s -> [|compile (pack $(stringE s)) [extended, caseless]|]++-- | @(=~)@ is an infix synonym for 'Text.Regex.PCRE.Light.match', with no+-- exec options provided.+--+-- >>> (pack "foobar") =~ [r|((.)\2)b|]+-- Just ["oob", "oo", "o"]+(=~) :: ByteString -> Regex -> Maybe [ByteString]+s =~ re = Text.Regex.PCRE.Light.match re s []++safeWords :: Parser [String]+safeWords = filter (not . null) <$> many1 (many1 (satisfy isSpace) *> word) where+    word = many $ try ('\\' <$ string "\\\\")+              <|> try (char '\\' *> satisfy isSpace)+              <|> satisfy (not . isSpace)++interpWords :: Parser [Q Exp]+interpWords = many1 (many1 (satisfy isSpace) *> (try (fst <$> expq) <|> word)) where+    word = fmap (stringE . unString . concat) $+            many $ try (string "\\\\")+               <|> try (char '\\' *> string "#")+               <|> try (fmap return $ char '\\' *> satisfy isSpace)+               <|> fmap return (satisfy (not . isSpace))++interpStr' :: String -> Q Exp+interpStr' m = [|concat $(listE (go [] m)) :: String|] where+    go n [] = [stringE n]+    go acc y@('#':'{':_) = case parseString expq mempty y of+        Success (qqq,s) -> stringE acc:qqq:go [] s+        Failure _ -> error "failure"+    go acc ('\\':'#':xs) = go (acc ++ "#") xs+    go acc s = case readLitChar s of+        [(y,xs)] -> go (acc ++ [y]) xs+        _ -> error $ "could not read character literal in " ++ s++interpStr :: Parser [Q Exp]+interpStr = many1 (try (fst <$> expq) <|> word) where+    word = stringE <$> many1 (notChar '\\')++expq :: Parser (Q Exp, String)+expq = do+    _ <- string "#{"+    ex <- expBody ""+    _ <- char '}'+    m <- many anyChar+    return (ex, m)+    where+        expBody s = do+            till <- many (notChar '}')+            let conc = s ++ till+            case parseExp conc of+                ParseOk e -> let m = return $ toExp e in return [e|asString $(m)|]+                _ -> char '}' *> expBody (conc ++ "}")++unString :: String -> String+unString s' = case readP_to_S lex $ '"' : concatMap escape s' ++ "\"" of+    [(String str,"")] -> str+    _ -> error $ "Invalid string literal \"" ++ s' ++ "\" (possibly a bad escape sequence)"+    where escape '"' = "\\\""+          escape m' = [m']++many1 :: Alternative f => f a -> f [a]+many1 f = liftA2 (:) f (many f)