th-format (empty) → 0.1.0.0

raw patch · 7 files changed

+382/−0 lines, 7 filesdep +Earleydep +basedep +haskell-src-metasetup-changed

Dependencies added: Earley, base, haskell-src-meta, tasty, tasty-hunit, template-haskell, text, th-format

Files

• LICENSE +30/−0
• README.md +30/−0
• Setup.hs +2/−0
• src/Data/Format.hs +214/−0
• test/Data/Format/Test.hs +35/−0
• test/Tests.hs +11/−0
• th-format.cabal +60/−0

@@ -0,0 +1,30 @@+Copyright Moritz Clasmeier (c) 2018++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Author name here nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,30 @@+# th-format [![Hackage version](https://img.shields.io/hackage/v/th-format.svg?label=Hackage)](https://hackage.haskell.org/package/th-format) [![Stackage version](https://www.stackage.org/package/th-format/badge/lts?label=Stackage)](https://www.stackage.org/package/th-format) [![Build Status](https://travis-ci.org/mtesseract/th-format.svg?branch=master)](https://travis-ci.org/mtesseract/th-format)++### About++This is `th-format`, a Haskell package implementing support for format+strings using Template Haskell quasi quoters. It requires the GHC+extension `QuasiQuotes` to be enabled. Parsing is implemented using+Earley.++This package is BSD3 licensed.++### Examples++Using `th-format`, you can use naive variable interpolation instead of+verbosely concatenating strings manually. Thus, instead of++```haskell+putStrLn $ "Client \"" ++ show client ++ "\" has requested resource \"" ++ show resource ++ "\" at date " ++ show date ++ "."+```++one can directly write:++```haskell+putStrLn $ [fmt|Client "$client" has requested resource "$resource" at date $date|]+```++There are currently two supported ways of interpolation:++1. Simple interpolation, as in `[fmt|Variable foo contains $foo|]`.+1. Expression interpolation, as in `[fmt|The toggle is ${if toggle then ("on" :: Text) else "off"}|]`

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

@@ -0,0 +1,214 @@+{-|+Module      : Data.Format+Description : QuasiQuoters for simple string interpolation.+Copyright   : (c) Moritz Clasmeier, 2017-2018+License     : BSD3+Maintainer  : mtesseract@silverratio.net+Stability   : experimental+Portability : POSIX+-}++{-# LANGUAGE FlexibleContexts     #-}+{-# LANGUAGE FlexibleInstances    #-}+{-# LANGUAGE LambdaCase           #-}+{-# LANGUAGE RecursiveDo          #-}+{-# LANGUAGE TemplateHaskell      #-}+{-# LANGUAGE TypeSynonymInstances #-}++module Data.Format+  ( fmt+  , fmtConcat+  ) where++import           Control.Applicative+import           Data.Char+import           Data.Text                   (Text)+import qualified Data.Text                   as Text+import qualified Data.Text.Lazy              as Text.Lazy+import           Language.Haskell.Meta.Parse+import           Language.Haskell.TH+import           Language.Haskell.TH.Quote+import           Language.Haskell.TH.Syntax+import           Text.Earley++-- | This is just 'mconcat', reexported under a specialized name in+-- order to avoid namespace clashes.+fmtConcat :: Monoid a => [a] -> a+fmtConcat = mconcat++-- | Type class which needs to be implemented by types that should be+-- usable for format string interpolation. For most types the this+-- class is simply implemented in terms of 'show'. But for+-- human-readable strings (e.g. 'String', 'Text'), the format+-- representation is simply the string itself, not its 'show'-image+-- (which adds quotation characters).+class Format a where+  formatText :: a -> Text++instance Format Int where+  formatText = tshow++instance Format String where+  formatText = Text.pack++instance Format Double where+  formatText = tshow++instance Format Float where+  formatText = tshow++instance Format Integer where+  formatText = tshow++instance Format Text where+  formatText = id++instance Format Text.Lazy.Text where+  formatText = Text.Lazy.toStrict++instance Format Bool where+  formatText = tshow++tshow :: Show a => a -> Text+tshow = Text.pack . show++data Fmt = Literal String+         | Identifier String+         | Expression String+  deriving (Show, Eq)++-- | Quasi Quoter for format strings. Examples:+--+-- Examples:+--+-- >>> let answer = 42 in [fmt|What is the answer to universe, life and everything? It's $answer!|]+-- "What is the answer to universe, life and everything? It's 42!"+--+-- >>> let toggle = True in [fmt|The toggle is switched ${if toggle then ("on" :: Text) else "off"}|]+-- "The toggle is switched on"+--+-- >>> let timeDelta = 60 in [fmt|Request latency: ${timeDelta}ms|]+-- "Request latency: 60ms"+fmt :: QuasiQuoter+fmt = QuasiQuoter { quoteExp = parseFormatStringQ+                  , quotePat = undefined+                  , quoteType = undefined+                  , quoteDec = undefined+                  }++instance Lift Fmt where+  lift (Literal s)    = stringE s+  lift (Identifier s) =+    lookupValueName s >>= \case+      Just v  -> (return . formatTextEmbed . VarE) v+      Nothing -> fail $ "Not in scope: '" ++ s ++ "'"+  lift (Expression s) = either fail (return . formatTextEmbed) (parseExp s)++formatTextEmbed :: Exp -> Exp+formatTextEmbed expr = AppE (VarE 'formatText) expr++newtype FmtString = FmtString [Fmt]++instance Lift FmtString where+  lift (FmtString fmts) = do+    fmtExprs <- Prelude.mapM lift fmts+    return $ AppE (VarE 'fmtConcat) (ListE fmtExprs)++-- | Parse the provided format string as a Template Haskell+-- expression.+parseFormatStringQ :: String -> Q Exp+parseFormatStringQ s =+  let parseResult = FmtString (parseFormatString s)+  in  [| parseResult |]++-- | Parse the provided format string as a list of 'Fmt' values.+parseFormatString :: String -> [Fmt]+parseFormatString s =+  case fullParses (parser fmtParser) s of+    ([], Report { unconsumed = "" }) ->+      []+    ([uniqueResult], Report { unconsumed = "" }) ->+      uniqueResult+    _ ->+      fail "Parse failure"++-- | Earley parser for the grammar of format strings.+fmtParser :: Grammar r (Prod r String Char [Fmt])+fmtParser = mdo+  -- Initial rule.+  start <- rule $ interpolationOrLiteral++  -- Either parse an interpolation or a non-empty string literal next.+  interpolationOrLiteral <- rule $+    interpolationThenRest+    <|> literalThenRest++  -- Parse an interpolation next (either `$foo$` or `${foo}`).+  interpolationThenRest <- rule $+    interpolationSimpleThenRest+    <|> interpolationDelimitedThenRest++  -- Parse a simple interpolation next (i.e. `$foo`).+  interpolationSimpleThenRest <- rule $+    (Identifier <$> interpolationSimple) `apCons` delimLiteralThenRest+    <|> (Identifier <$> interpolationSimple) `apCons` interpolationThenRest+    <|> (Identifier <$> interpolationSimple) `apCons` pure []++  -- Parse a delimited interpolation next (i.e. `${foo}`).+  interpolationDelimitedThenRest <- rule $+    (Expression <$> interpolationDelimited) `apCons` interpolationOrLiteral+    <|> (Expression <$> interpolationDelimited) `apCons` pure []++  -- Parse a single character literal which marks the beginning of a+  -- string literal and can be used to end a previous simple+  -- interpolation (e.g. whitspace, comma).+  delimLiteral <- rule $ Literal <$>+    (satisfy (\c -> not (identifierChar c) && c /= '$')) `apCons` strChars++  -- Parse a string literal next which starts with a delimiting character.+  delimLiteralThenRest <- rule $+    delimLiteral `apCons` interpolationThenRest+    <|> delimLiteral `apCons` (pure [])++  -- Parse a string literal next.+  literalThenRest <- rule $+    (Literal <$> literal) `apCons` pure []+    <|> (Literal <$> literal) `apCons` interpolationThenRest++  -- Parse a single Haskell variable name next.+  identifier <- rule $+    satisfy initialIdentifierChar `apCons` many (satisfy identifierChar)++  -- Parse a simple interpolation next.+  interpolationSimple <- rule $ token '$' *> identifier++  -- Parse a delimited interpolation next.+  interpolationDelimited <- rule $ token '$' *> token '{' *> expression <* token '}'++  -- Parses a single string literal character. Supports escaping.+  strChar <- rule $+    satisfy (`Prelude.notElem` ['$', '\\'])+    <|> token '\\' *> satisfy (const True)++  -- Possibly potentially empty string literal.+  strChars <- rule $ many strChar++  -- Nonempty string literal+  literal <- rule $ strChar `apCons` strChars++  -- Parse a expression, i.e. something contained between "${" and "}".+  expression <- rule $ some (satisfy (/= '}'))++  return start++  where apCons = liftA2 (:)++-- | Return True if the given character can be part of a Haskell+-- variable name, False otherwise.+identifierChar :: Char -> Bool+identifierChar c = isLower c || isUpper c || c `Prelude.elem` ['\'', '_']++-- | Return True if the given character can be the initial character+-- of a Haskell variable name.+initialIdentifierChar :: Char -> Bool+initialIdentifierChar c = isLower c || c == '_'

@@ -0,0 +1,35 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes       #-}+{-# LANGUAGE TemplateHaskell   #-}++module Data.Format.Test (tests) where++import           Data.Format+import           Data.Text        (Text)+import           Test.Tasty+import           Test.Tasty.HUnit++tests :: TestTree+tests =+  let foo = "FOO" :: String+      toggle = True+  in testGroup "Tests"+     [ testCase "Empty string" ([fmt||] @=? "")+     , testCase "Single identifier interpolation" ([fmt|$foo|] @=? "FOO")+     , testCase "Multiple identifier interpolation" ([fmt|$foo$foo|] @=? "FOOFOO")+     , testCase "Constant string" ([fmt|Hello, world!|] @=? "Hello, world!")+     , testCase "Constant string w/ escaping" ([fmt|How much \$\$ do you need?|] @=? "How much $$ do you need?")+     , testCase "Constant string w/ escaping" ([fmt|Got \$\$\? :-\\|] @=? "Got $$? :-\\")+     , testCase "Delimited interpolation" ([fmt|${foo}|] @=? "FOO")+     , testCase "Multiple delimited interpolations" ([fmt|${foo}${foo}|] @=? "FOOFOO")+     , testCase "Mixed interpolations" ([fmt|${foo}$foo${foo}|] @=? "FOOFOOFOO")+     , testCase "Single interpolation between text" ([fmt|Hey $foo, how ya doing?|] @=? "Hey FOO, how ya doing?")+     , testCase "Single interpolation between text w/o ws" ([fmt|BAR$foo|] @=? "BARFOO")+     , testCase "Delimited interpolation between text" ([fmt|BAR${foo}BAR|] @=? "BARFOOBAR")+     , testCase "Delimited interpolation between text" ([fmt|BAR${foo}BAR|] @=? "BARFOOBAR")+     , testCase "Escaped simple interpolation" ([fmt|Escaped simple interpolation: \$foo|] @=? "Escaped simple interpolation: $foo")+     , testCase "Escaped delimited interpolation" ([fmt|Escaped delimited interpolation: \${foo}|] @=? "Escaped delimited interpolation: ${foo}")+     , testCase "Simple interpolations delimited by ws" ([fmt|$foo $foo|] @=? "FOO FOO")+     , testCase "Boolean toggle interpolation" (([fmt|${if toggle then ("on" :: Text) else "off"}|] :: Text) @=? "on")+     , testCase "Boolean toggle interpolation negated" (([fmt|${if (not toggle) then ("on" :: Text) else "off"}|] :: Text) @=? "off")+     ]

@@ -0,0 +1,11 @@+import           System.Environment+import           Test.Tasty++import qualified Data.Format.Test++main :: IO ()+main = do+  defaultMain $+    testGroup "Test Suite"+    [ Data.Format.Test.tests+    ]

@@ -0,0 +1,60 @@+-- This file has been generated from package.yaml by hpack version 0.20.0.+--+-- see: https://github.com/sol/hpack+--+-- hash: 4eb13b04d84d5d19948270617adaffdadfb358b7dfefe592f205f7eeeb2ff715++name:           th-format+version:        0.1.0.0+synopsis:       Template Haskell based support for format strings+description:    This package implements a Template Haskell quasi quoter for format strings.+category:       Data+homepage:       https://github.com/mtesseract/th-format#readme+bug-reports:    https://github.com/mtesseract/th-format/issues+author:         Moritz Clasmeier+maintainer:     mtesseract@silverratio.net+copyright:      2017-2018 Moritz Clasmeier+license:        BSD3+license-file:   LICENSE+build-type:     Simple+cabal-version:  >= 1.10++extra-source-files:+    README.md++source-repository head+  type: git+  location: https://github.com/mtesseract/th-format++library+  hs-source-dirs:+      src+  ghc-options: -Wall+  build-depends:+      Earley >=0.12.1.0 && <0.13+    , base >=4.7 && <5+    , haskell-src-meta >=0.8.0.2 && <0.9+    , template-haskell >=2.12.0.0 && <2.13+    , text >=1.2.3.0 && <1.3+  exposed-modules:+      Data.Format+  other-modules:+      Paths_th_format+  default-language: Haskell2010++test-suite th-format-test+  type: exitcode-stdio-1.0+  main-is: Tests.hs+  hs-source-dirs:+      test+  ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      base+    , tasty+    , tasty-hunit+    , text+    , th-format+  other-modules:+      Data.Format.Test+      Paths_th_format+  default-language: Haskell2010