packages feed

interpolate (empty) → 0.0.0

raw patch · 8 files changed

+284/−0 lines, 8 filesdep +QuickCheckdep +basedep +bytestringsetup-changed

Dependencies added: QuickCheck, base, bytestring, haskell-src-meta, hspec, quickcheck-instances, template-haskell, text

Files

+ LICENSE view
@@ -0,0 +1,19 @@+Copyright (c) 2013 Simon Hengel <sol@typeful.net>++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.lhs view
@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMain
+ interpolate.cabal view
@@ -0,0 +1,53 @@+name:             interpolate+version:          0.0.0+license:          MIT+license-file:     LICENSE+copyright:        (c) 2013 Simon Hengel+author:           Simon Hengel <sol@typeful.net>+maintainer:       Simon Hengel <sol@typeful.net>+build-type:       Simple+cabal-version:    >= 1.8+category:         Data, Text+stability:        experimental+synopsis:         String interpolation done right+description:      String interpolation done right++source-repository head+  type: git+  location: https://github.com/sol/interpolate++library+  ghc-options:+      -Wall+  hs-source-dirs:+      src+  exposed-modules:+      Data.String.Interpolate+  other-modules:+      Data.String.Interpolate.Util+      Data.String.Interpolate.Parse+      Data.String.Interpolate.Compat+  build-depends:+      base    == 4.*+    , template-haskell+    , haskell-src-meta++test-suite spec+  type:+      exitcode-stdio-1.0+  ghc-options:+      -Wall -Werror+  hs-source-dirs:+      src, test+  main-is:+      Spec.hs+  build-depends:+      base    == 4.*+    , template-haskell+    , haskell-src-meta++    , text+    , bytestring+    , hspec >= 1.5+    , QuickCheck+    , quickcheck-instances
+ src/Data/String/Interpolate.hs view
@@ -0,0 +1,34 @@+{-# LANGUAGE TemplateHaskell #-}+module Data.String.Interpolate (i) where++import           Language.Haskell.TH.Quote (QuasiQuoter(..))+import           Language.Haskell.Meta.Parse.Careful (parseExp)++import           Data.String.Interpolate.Util+import           Data.String.Interpolate.Parse+import           Data.String.Interpolate.Compat (Q, Exp, appE, reportError)++i :: QuasiQuoter+i = QuasiQuoter {+    quoteExp = toExp . parseNodes+  , quotePat = err "pattern"+  , quoteType = err "type"+  , quoteDec = err "declaration"+  }+  where+    err name = error ("Data.String.Interpolate.i: This QuasiQuoter can not be used as a " ++ name ++ "!")++    toExp:: [Node] -> Q Exp+    toExp nodes = case nodes of+      [] -> [|""|]+      (x:xs) -> f x `appE` toExp xs+      where+        f (Literal s) = [|showString s|]+        f (Expression e) = [|(showString . toString) $(reifyExpression e)|]++        reifyExpression :: String -> Q Exp+        reifyExpression s = case parseExp s of+          Left _ -> do+            reportError "Parse error in expression!"+            [|""|]+          Right e -> return e
+ src/Data/String/Interpolate/Compat.hs view
@@ -0,0 +1,44 @@+{-# LANGUAGE CPP #-}+module Data.String.Interpolate.Compat (+  readMaybe+, module Language.Haskell.TH+#if !MIN_VERSION_template_haskell(2,8,0)+, reportError+#endif+) where++import           Language.Haskell.TH+import           Text.Read++#if !MIN_VERSION_base(4,6,0)+import qualified Text.ParserCombinators.ReadP as P+#endif++#if !MIN_VERSION_base(4,6,0)+-- | Parse a string using the 'Read' instance.+-- Succeeds if there is exactly one valid result.+-- A 'Left' value indicates a parse error.+readEither :: Read a => String -> Either String a+readEither s =+  case [ x | (x,"") <- readPrec_to_S read' minPrec s ] of+    [x] -> Right x+    []  -> Left "Prelude.read: no parse"+    _   -> Left "Prelude.read: ambiguous parse"+ where+  read' =+    do x <- readPrec+       lift P.skipSpaces+       return x++-- | Parse a string using the 'Read' instance.+-- Succeeds if there is exactly one valid result.+readMaybe :: Read a => String -> Maybe a+readMaybe s = case readEither s of+                Left _  -> Nothing+                Right a -> Just a+#endif++#if !MIN_VERSION_template_haskell(2,8,0)+reportError :: String -> Q ()+reportError = report True+#endif
+ src/Data/String/Interpolate/Parse.hs view
@@ -0,0 +1,18 @@+module Data.String.Interpolate.Parse where++import           Data.String.Interpolate.Util++data Node = Literal String | Expression String++parseNodes :: String -> [Node]+parseNodes = go ""+  where+    go acc input = case input of+      ""  -> [(lit . reverse) acc]+      '#':'{':xs -> case span (/= '}') xs of+        (ys, _:zs) -> (lit . reverse) acc : Expression ys : go "" zs+        (_, "") -> [(Literal . unescape) (reverse acc ++ input)]+      x:xs -> go (x:acc) xs++    lit :: String -> Node+    lit acc = (Literal . unescape) acc
+ src/Data/String/Interpolate/Util.hs view
@@ -0,0 +1,112 @@+module Data.String.Interpolate.Util where++import           Data.Char+import           Data.Maybe+import qualified Numeric as N++import           Data.String.Interpolate.Compat++toString :: Show a => a -> String+toString a = let s = show a in fromMaybe s (readMaybe s)+++-- Haskell 2010 character unescaping, see:+-- http://www.haskell.org/onlinereport/haskell2010/haskellch2.html#x7-200002.6+unescape :: String -> String+unescape = go+  where+    go input = case input of+      "" -> ""+      '\\' : 'x' : x : xs | isHexDigit x -> case span isHexDigit xs of+        (ys, zs) -> (chr . readHex $ x:ys) : go zs+      '\\' : 'o' : x : xs | isOctDigit x -> case span isOctDigit xs of+        (ys, zs) -> (chr . readOct $ x:ys) : go zs+      '\\' : x : xs | isDigit x -> case span isDigit xs of+        (ys, zs) -> (chr . read $ x:ys) : go zs+      '\\' : input_ -> case input_ of+        'a' : xs -> '\a' : go xs+        'b' : xs -> '\b' : go xs+        'f' : xs -> '\f' : go xs+        'n' : xs -> '\n' : go xs+        'r' : xs -> '\r' : go xs+        't' : xs -> '\t' : go xs+        'v' : xs -> '\v' : go xs+        '&' : xs -> go xs+        'N':'U':'L' : xs -> '\NUL' : go xs+        'S':'O':'H' : xs -> '\SOH' : go xs+        'S':'T':'X' : xs -> '\STX' : go xs+        'E':'T':'X' : xs -> '\ETX' : go xs+        'E':'O':'T' : xs -> '\EOT' : go xs+        'E':'N':'Q' : xs -> '\ENQ' : go xs+        'A':'C':'K' : xs -> '\ACK' : go xs+        'B':'E':'L' : xs -> '\BEL' : go xs+        'B':'S' : xs -> '\BS' : go xs+        'H':'T' : xs -> '\HT' : go xs+        'L':'F' : xs -> '\LF' : go xs+        'V':'T' : xs -> '\VT' : go xs+        'F':'F' : xs -> '\FF' : go xs+        'C':'R' : xs -> '\CR' : go xs+        'S':'O' : xs -> '\SO' : go xs+        'S':'I' : xs -> '\SI' : go xs+        'D':'L':'E' : xs -> '\DLE' : go xs+        'D':'C':'1' : xs -> '\DC1' : go xs+        'D':'C':'2' : xs -> '\DC2' : go xs+        'D':'C':'3' : xs -> '\DC3' : go xs+        'D':'C':'4' : xs -> '\DC4' : go xs+        'N':'A':'K' : xs -> '\NAK' : go xs+        'S':'Y':'N' : xs -> '\SYN' : go xs+        'E':'T':'B' : xs -> '\ETB' : go xs+        'C':'A':'N' : xs -> '\CAN' : go xs+        'E':'M' : xs -> '\EM' : go xs+        'S':'U':'B' : xs -> '\SUB' : go xs+        'E':'S':'C' : xs -> '\ESC' : go xs+        'F':'S' : xs -> '\FS' : go xs+        'G':'S' : xs -> '\GS' : go xs+        'R':'S' : xs -> '\RS' : go xs+        'U':'S' : xs -> '\US' : go xs+        'S':'P' : xs -> '\SP' : go xs+        'D':'E':'L' : xs -> '\DEL' : go xs+        '^':'@' : xs -> '\^@' : go xs+        '^':'A' : xs -> '\^A' : go xs+        '^':'B' : xs -> '\^B' : go xs+        '^':'C' : xs -> '\^C' : go xs+        '^':'D' : xs -> '\^D' : go xs+        '^':'E' : xs -> '\^E' : go xs+        '^':'F' : xs -> '\^F' : go xs+        '^':'G' : xs -> '\^G' : go xs+        '^':'H' : xs -> '\^H' : go xs+        '^':'I' : xs -> '\^I' : go xs+        '^':'J' : xs -> '\^J' : go xs+        '^':'K' : xs -> '\^K' : go xs+        '^':'L' : xs -> '\^L' : go xs+        '^':'M' : xs -> '\^M' : go xs+        '^':'N' : xs -> '\^N' : go xs+        '^':'O' : xs -> '\^O' : go xs+        '^':'P' : xs -> '\^P' : go xs+        '^':'Q' : xs -> '\^Q' : go xs+        '^':'R' : xs -> '\^R' : go xs+        '^':'S' : xs -> '\^S' : go xs+        '^':'T' : xs -> '\^T' : go xs+        '^':'U' : xs -> '\^U' : go xs+        '^':'V' : xs -> '\^V' : go xs+        '^':'W' : xs -> '\^W' : go xs+        '^':'X' : xs -> '\^X' : go xs+        '^':'Y' : xs -> '\^Y' : go xs+        '^':'Z' : xs -> '\^Z' : go xs+        '^':'[' : xs -> '\^[' : go xs+        '^':'\\' : xs -> '\^\' : go xs+        '^':']' : xs -> '\^]' : go xs+        '^':'^' : xs -> '\^^' : go xs+        '^':'_' : xs -> '\^_' : go xs+        xs -> go xs+      x:xs -> x : go xs++    readHex :: String -> Int+    readHex xs = case N.readHex xs of+      [(n, "")] -> n+      _ -> error "Data.String.Interpolate.Util.readHex: no parse"++    readOct :: String -> Int+    readOct xs = case N.readOct xs of+      [(n, "")] -> n+      _ -> error "Data.String.Interpolate.Util.readHex: no parse"
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}