yasi 0.1.2.1 → 0.2.0.0

raw patch · 7 files changed

+115/−187 lines, 7 filesdep +ghc-hs-metadep +text-displaydep −bytestringdep ~basedep ~tastydep ~template-haskellPVP ok

version bump matches the API change (PVP)

Dependencies added: ghc-hs-meta, text-display

Dependencies removed: bytestring

Dependency ranges changed: base, tasty, template-haskell

API changes (from Hackage documentation)

Files

• CHANGELOG.md +5/−0
• src/Yasi.hs +21/−38
• src/Yasi/Internal.hs +54/−96
• test/Interpolations.hs +17/−22
• test/Segments.hs +4/−8
• test/Util.hs +1/−7
• yasi.cabal +13/−16

@@ -1,5 +1,10 @@ # Revision history for yasi +## 0.2.0.0 -- 2022-03-13++ * Support interpolating arbitrary expressions.+ * Use `Display` from the `text-display` package.+ ## 0.1.2.1 -- 2021-03-15   * Allow to interpolate lazy into strict `ByteString`s and vice versa.

@@ -1,11 +1,11 @@ -- | Yet another string interpolator -----  * Dead simple---  * No dependency on [haskell-src-meta](https://hackage.haskell.org/package/haskell-src-meta).---    It is not actively developed, has long compile times and several bugs, some of which are---    by design (e.g. operator fixities).---  * Supports interpolating 'String', 'Data.Text.Text', lazy 'Data.Text.Lazy.Text',---    'Data.ByteString.ByteString' and lazy 'Data.ByteString.Lazy.ByteString' (UTF8).+--  * Very simple, few dependencies.+--  * Based on 'Data.Text.Display.Display' instead of 'Show'.+--  * Depends on [ghc-hs-meta](https://hackage.haskell.org/package/ghc-hs-meta)+--    instead of [haskell-src-meta](https://hackage.haskell.org/package/haskell-src-meta)+--    for interpolating arbitrary expressions.+--    This result in faster compile times and fewer bugs. module Yasi   ( i, @@ -14,13 +14,9 @@     iS,     iT,     iTL,-    iB,-    iBL,   ) where -import qualified Data.ByteString as B-import qualified Data.ByteString.Lazy as BL import Data.String (IsString (..)) import qualified Data.Text as T import qualified Data.Text.Lazy as TL@@ -31,11 +27,14 @@ -- $setup -- >>> import Yasi -- >>> import Data.Text (Text)--- >>> import Data.ByteString (ByteString)+-- >>> import qualified Data.Text.Lazy  int :: (TH.Exp -> TH.Exp) -> TH.QuasiQuoter int = interpolator '$' +intT :: TH.Name -> TH.QuasiQuoter+intT = int . flip TH.SigE . TH.ConT+ -- | The main interpolator, intended to be used with -- [@QuasiQuotes@](https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/exts/template_haskell.html#extension-QuasiQuotes). --@@ -45,18 +44,13 @@ -- >>> [i|${foo}string $bar|] :: String -- "yet another string interpolator" --+-- The result type can be 'String', strict 'T.Text' or lazy 'TL.Text'.+-- -- You can also use @${}@ to create a function interpolator (this "abstraction" feature is inspired by -- [interpolate](https://hackage.haskell.org/package/interpolate)): ----- >>> [i|more ${}${} code|] "point" "free" :: Text--- "more pointfree code"------ To use 'show' to interpolate a value:------ >>> let x = 1 + 1 in [i|1 + 1 = ${show x}|] :: ByteString--- "1 + 1 = 2"--- >>> [i|2 + 2 = $show|] (2 + 2) :: Text--- "2 + 2 = 4"+-- >>> [i|more ${}${} code${replicate 3 '!'}|] "point" "free" :: Text+-- "more pointfree code!!!" i :: TH.QuasiQuoter i = int id @@ -69,9 +63,6 @@ iFS :: TH.QuasiQuoter iFS = int $ TH.AppE (TH.VarE 'fromString) -intT :: TH.Name -> TH.QuasiQuoter-intT = int . flip TH.SigE . TH.ConT- -- | Like 'i', but with the result type fixed to 'String'. -- -- @['iS'|...|] = ['i'|...|] :: 'String'@@@ -81,7 +72,7 @@ iS :: TH.QuasiQuoter iS = intT ''String --- | Like 'i', but with the result type fixed to 'T.Text'.+-- | Like 'i', but with the result type fixed to strict 'T.Text'. -- -- @['iT'|...|] = ['i'|...|] :: 'T.Text'@ --@@ -90,19 +81,11 @@ iT :: TH.QuasiQuoter iT = intT ''T.Text --- | Like 'iT', but lazy.-iTL :: TH.QuasiQuoter-iTL = intT ''TL.Text---- | Like 'i', but with the result type fixed to 'B.ByteString'.+-- | Like 'i', but with the result type fixed to lazy 'TL.Text'. ----- @['iB'|...|] = ['i'|...|] :: 'B.ByteString'@+-- @['iTL'|...|] = ['i'|...|] :: 'TL.Text'@ ----- >>> :t [iB|hi|]--- [iB|hi|] :: ByteString-iB :: TH.QuasiQuoter-iB = intT ''B.ByteString---- | Like 'iB', but lazy.-iBL :: TH.QuasiQuoter-iBL = intT ''BL.ByteString+-- >>> :t [iTL|hi|]+-- [iTL|hi|] :: Data.Text.Lazy.Text+iTL :: TH.QuasiQuoter+iTL = intT ''TL.Text

@@ -1,4 +1,4 @@-{-# LANGUAGE CPP #-}+{-# LANGUAGE UndecidableInstances #-}  -- | Internal module, no stability guarantees module Yasi.Internal@@ -6,92 +6,88 @@     parseSegments,     ipExpr,     interpolator,-    Stringy (..),+    Displayish (..),+    Stringish (..),   ) where  import Control.Monad ((>=>))-import qualified Data.ByteString as B-import qualified Data.ByteString.Lazy as BL import qualified Data.Char as C import qualified Data.Text as T-import qualified Data.Text.Encoding as T+import qualified Data.Text.Display as TD import qualified Data.Text.Lazy as TL-import qualified Data.Text.Lazy.Encoding as TL+import qualified Data.Text.Lazy.Builder as TLB import GHC.Generics (Generic)+import qualified Language.Haskell.Meta.Parse as GhcHsMeta+import qualified Language.Haskell.TH.Lib as TH import qualified Language.Haskell.TH.Quote as TH import qualified Language.Haskell.TH.Syntax as TH -#if !(MIN_VERSION_base(4,13,0))-import Control.Monad.Fail (MonadFail)-#endif-#if !(MIN_VERSION_base(4,11,0))-import Data.Semigroup ((<>))-#endif- data Segment   = Lit String-  | Var String-  | ShowVar String+  | Exp String   | Abs -- idea due to interpolate-  | ShowAbs   deriving (Show, Eq, Generic)  parseSegments :: MonadFail m => Char -> String -> m [Segment] parseSegments c = fmap (group []) . go   where-    -- rewrite this+    -- ugly, but simple enough™     go s       | let (lit, rest) = span (/= c) s, not (null lit) = (Lit lit :) <$> go rest       | s == "" = pure []       | s == [c] = fail $ "should not end with single " <> [c]       | _ : c' : rest <- s, c == c' = (Lit [c] :) <$> go rest-      | _ : '{' : rest <- s = case span (/= '}') rest of-        (var, '}' : rest) ->-          let seg = case var of-                "" -> Abs-                "show" -> ShowAbs-                's' : 'h' : 'o' : 'w' : ' ' : var -> ShowVar var-                var -> Var var-           in (seg :) <$> go rest-        _ -> fail "missing closing bracket"+      | _ : '{' : rest <- s = case span (/= '}') rest of -- TODO smarter?+          (exp, '}' : rest) ->+            let seg = if exp == "" then Abs else Exp exp+             in (seg :) <$> go rest+          _ -> fail "missing closing bracket"       | _ : v : rest' <- s,         isVarStartChar v =-        let (vs, rest) = span isVarChar rest'-            var = v : vs-            s = if var == "show" then ShowAbs else Var var-         in (s :) <$> go rest+          let (vs, rest) = span isVarChar rest'+           in (Exp (v : vs) :) <$> go rest       | otherwise = fail $ "invalid char after " <> [c]     isVarStartChar v = C.isAscii v && C.isAlpha v     isVarChar v = C.isAscii v && (C.isAlphaNum v || v == '_' || v == '\'')      group ls [] = lit ls     group ls (Lit l : ss) = group (l : ls) ss-    group ls (s : ss) = lit ls ++ (s : group [] ss)+    group ls (s : ss) = lit ls <> (s : group [] ss)     lit [] = []     lit ls = [Lit $ mconcat $ reverse ls] -ipExpr :: TH.Exp -> (TH.Exp -> TH.Exp) -> [Segment] -> TH.Q TH.Exp-ipExpr cast combine segs = do+ipExpr :: (TH.Exp -> TH.Exp) -> [Segment] -> TH.Q TH.Exp+ipExpr transform segs = do   (ls, lams) <- go segs-  pure $ lams $ combine $ TH.ListE ls+  pure+    . lams+    . transform+    . TH.AppE (TH.VarE 'stringish)+    . foldr (flip TH.UInfixE (TH.VarE '(<>))) (TH.VarE 'mempty)+    $ ls   where     go = \case       [] -> pure ([], id)-      (s : ss) -> prep (go ss) $ case s of-        Lit l -> pure (TH.SigE (TH.LitE (TH.StringL l)) (TH.ConT ''String), id)-        Var v -> pure (TH.VarE (TH.mkName v), id)-        ShowVar v -> pure (TH.AppE (TH.VarE 'show) $ TH.VarE (TH.mkName v), id)+      s : ss -> prep (go ss) case s of+        Lit l -> (,id) <$> [|$(TH.stringE l) :: String|]+        Exp e -> do+          exts <- TH.extsEnabled+          exp <- case GhcHsMeta.parseExpWithExts exts e of+            Right e -> pure e+            Left (line, col, msg) ->+              fail . unlines $+                [ "Parse error at splice `" <> e <> "`:",+                  show line <> ":" <> show col <> ": " <> msg+                ]+          pure (exp, id)         Abs -> do           n <- TH.newName "int"           pure (TH.VarE n, TH.LamE [TH.VarP n])-        ShowAbs -> do-          n <- TH.newName "showint"-          pure (TH.AppE (TH.VarE 'show) $ TH.VarE n, TH.LamE [TH.VarP n])     prep asg af = do       (as, g) <- asg       (a, f) <- af-      pure (TH.AppE cast a : as, f . g)+      pure (TH.AppE (TH.VarE 'displayish) a : as, f . g)  interpolator ::   Char ->@@ -100,67 +96,29 @@   TH.QuasiQuoter interpolator c pp = TH.QuasiQuoter {..}   where-    quoteExp = parseSegments c >=> ipExpr (TH.VarE 'stringy) (pp . TH.AppE (TH.VarE 'mconcat))+    quoteExp = parseSegments c >=> ipExpr pp     quotePat = const $ fail "pattern context not supported"     quoteType = const $ fail "type context not supported"     quoteDec = const $ fail "declaration context not supported" -class Stringy a b where-  stringy :: a -> b--instance Stringy String String where-  stringy = id--instance Stringy String T.Text where-  stringy = T.pack--instance Stringy String TL.Text where-  stringy = TL.pack--instance Stringy String B.ByteString where-  stringy = T.encodeUtf8 . T.pack--instance Stringy String BL.ByteString where-  stringy = TL.encodeUtf8 . TL.pack--instance Stringy T.Text T.Text where-  stringy = id--instance Stringy T.Text String where-  stringy = T.unpack--instance Stringy T.Text TL.Text where-  stringy = TL.fromStrict--instance Stringy T.Text B.ByteString where-  stringy = T.encodeUtf8--instance Stringy T.Text BL.ByteString where-  stringy = BL.fromStrict . T.encodeUtf8--instance Stringy TL.Text TL.Text where-  stringy = id--instance Stringy TL.Text String where-  stringy = TL.unpack--instance Stringy TL.Text T.Text where-  stringy = TL.toStrict+class Displayish a where+  displayish :: a -> TLB.Builder -instance Stringy TL.Text B.ByteString where-  stringy = BL.toStrict . TL.encodeUtf8+instance {-# OVERLAPPABLE #-} TD.Display a => Displayish a where+  displayish = TD.displayBuilder -instance Stringy TL.Text BL.ByteString where-  stringy = TL.encodeUtf8+-- String is still used too pervasively...+instance Displayish String where+  displayish = TLB.fromString -instance Stringy B.ByteString B.ByteString where-  stringy = id+class Stringish a where+  stringish :: TLB.Builder -> a -instance Stringy B.ByteString BL.ByteString where-  stringy = BL.fromStrict+instance Stringish String where+  stringish = TL.unpack . TLB.toLazyText -instance Stringy BL.ByteString BL.ByteString where-  stringy = id+instance Stringish T.Text where+  stringish = TL.toStrict . TLB.toLazyText -instance Stringy BL.ByteString B.ByteString where-  stringy = BL.toStrict+instance Stringish TL.Text where+  stringish = TLB.toLazyText

@@ -1,44 +1,39 @@-{-# LANGUAGE CPP #-}- module Interpolations where +import Control.Applicative (Const (..)) import qualified Data.Text as T-import qualified Data.Text.Encoding as T+import Data.Text.Display (display)+import qualified Data.Text.Lazy as TL import Hedgehog import qualified Hedgehog.Gen as Gen import qualified Hedgehog.Range as Range import Test.Tasty+import Test.Tasty.HUnit import Test.Tasty.Hedgehog import Yasi -#if !(MIN_VERSION_base(4,11,0))-import Data.Semigroup ((<>))-#endif- test_interpolation :: TestTree test_interpolation =   testGroup     "interpolation"-    [ testProperty "to String" . property $ do+    [ testPropertyNamed "to String" "interpolation_to_String" . property $ do         (a, b, c) <- (,,) <$> forAll genString <*> forAll genText <*> forAll genString         [i|${a}++$b🙀🙀🙀🙀$c🙀|] === a <> "++" <> T.unpack b <> "🙀🙀🙀🙀" <> c <> "🙀",-      testProperty "to Text" . property $ do+      testPropertyNamed "to Text" "interpolation_to_Text" . property $ do         (a, b, c) <- (,,) <$> forAll genText <*> forAll genText <*> forAll genString         [i|😶😶$a😶😶$b😶😶$c😶😶|] === "😶😶" <> a <> "😶😶" <> b <> "😶😶" <> T.pack c <> "😶😶",-      testProperty "to ByteString" . property $ do-        (a, b, c) <- (,,) <$> forAll genBS <*> forAll genText <*> forAll genString-        let p = T.encodeUtf8 "℘"-        [i|℘$a℘$b℘$c℘|] === p <> a <> p <> T.encodeUtf8 b <> p <> T.encodeUtf8 (T.pack c) <> p,-      testProperty "abstractions" . property $ do-        (a, b) <- (,) <$> forAll genText <*> forAll genInt-        [i|xxx-${}$show-yyy|] a (b :: Int) === "xxx-" <> a <> T.pack (show b) <> "-yyy",-      testProperty "variants" . property $ do-        (a, b) <- (,) <$> forAll genText <*> forAll genInt-        [iT|xxx-${}$show-yyy|] a (b :: Int) === "xxx-" <> a <> T.pack (show b) <> "-yyy"+      testPropertyNamed "abstractions" "interpolation_abstractions" . property $ do+        (a, b :: Int) <- (,) <$> forAll genText <*> forAll genInt+        [i|xxx-${}${}-yyy|] a b === "xxx-" <> a <> display b <> "-yyy",+      testCase "interpolationg expressions" do+        let foo :: Int -> Int -> Int+            foo a b = a + b - 3+        [iT|${1+1 :: Int}-${foo 2 4}|] @?= T.pack "2-3"+        [iTL|${1+1 :: Int}-${foo 2 4}|] @?= TL.pack "2-3"+        [iFS|${1+1 :: Int}-${foo 2 4}|] @?= (Const "2-3" :: Const String (Int -> Bool))     ]   where-    genString = Gen.string range Gen.unicodeAll-    genText = Gen.text range Gen.unicodeAll-    genBS = Gen.bytes range+    genString = Gen.string range Gen.unicode+    genText = Gen.text range Gen.unicode     range = Range.constant 0 20     genInt = Gen.integral $ Range.constant 0 1000

@@ -6,22 +6,18 @@ unit_segment_parsing :: IO () unit_segment_parsing = do   ps "foo\\\"" @?= Just [Lit "foo\\\""]-  ps "$a-$b" @?= Just [Var "a", Lit "-", Var "b"]+  ps "$a-$b" @?= Just [Exp "a", Lit "-", Exp "b"]   ps "asef$" @?= Nothing   ps "lol$${}" @?= Just [Lit "lol${}"]   ps "lol$$${}" @?= Just [Lit "lol$", Abs]-  ps "${89+}${}" @?= Just [Var "89+", Abs]+  ps "${89+}${}" @?= Just [Exp "89+", Abs]   ps "${}}" @?= Just [Abs, Lit "}"]-  ps "asdf${show bar}$$" @?= Just [Lit "asdf", ShowVar "bar", Lit "$"]   ps "a$$b" @?= Just [Lit "a$b"]-  ps "$a$b$c" @?= Just [Var "a", Var "b", Var "c"]+  ps "$a$b$c" @?= Just [Exp "a", Exp "b", Exp "c"]   ps "" @?= Just []   ps " " @?= Just [Lit " "]-  ps "$foobar:\n - $b" @?= Just [Var "foobar", Lit ":\n - ", Var "b"]+  ps "$foobar:\n - $b" @?= Just [Exp "foobar", Lit ":\n - ", Exp "b"]   ps "${foobar]" @?= Nothing   ps "test-$0foo" @?= Nothing-  ps "${show }" @?= Just [ShowVar ""]-  ps "${show}" @?= Just [ShowAbs]-  ps "$show" @?= Just [ShowAbs]   where     ps = parseSegments '$'

@@ -1,5 +1,3 @@-{-# LANGUAGE CPP #-}- module Util where  import qualified Data.Text as T@@ -11,17 +9,13 @@ import Test.Tasty.Hedgehog import Yasi.Util -#if !(MIN_VERSION_base(4,11,0))-import Data.Semigroup ((<>))-#endif- test_unindent :: TestTree test_unindent =   testGroup     "unindentation"     [ testCase "empty string" $ do         unindent "" @?= "",-      testProperty "single line" . property $ do+      testPropertyNamed "single line" "unindentation_single_line" . property $ do         t <- forAll genTextWONL         unindent t === (T.dropWhile (== ' ') t <> "\n"),       testCase "multi line" $ do

@@ -1,6 +1,6 @@ cabal-version: 2.4 name: yasi-version: 0.1.2.1+version: 0.2.0.0  synopsis: Yet another string interpolator description:@@ -23,27 +23,23 @@  common commons   default-language: Haskell2010-  ghc-options: -Wall -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints -fno-warn-name-shadowing-  if impl(ghc >= 8.2)-    ghc-options: -fhide-source-paths-  if impl(ghc >= 8.10)-    ghc-options: -Wunused-packages-  default-extensions: DeriveGeneric FlexibleContexts FlexibleInstances LambdaCase MultiParamTypeClasses OverloadedStrings QuasiQuotes RecordWildCards TemplateHaskell+  ghc-options: -Wall -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints -fno-warn-name-shadowing -Wunused-packages+  default-extensions: BlockArguments DeriveGeneric FlexibleContexts FlexibleInstances LambdaCase MultiParamTypeClasses OverloadedStrings QuasiQuotes RecordWildCards ScopedTypeVariables TemplateHaskell TupleSections  library   import: commons-  if impl(ghc >= 8.4)-    ghc-options: -Wmissing-export-lists+  ghc-options: -Wmissing-export-lists   hs-source-dirs: src   exposed-modules:     Yasi     Yasi.Internal     Yasi.Util   build-depends:-      base >= 4.9 && < 5-    , template-haskell >= 2.11 && < 2.18-    , text ^>= 1.2-    , bytestring >= 0.10.8 && < 0.12+      base >= 4.14 && < 5+    , template-haskell >= 2.16 && < 2.19+    , text >= 1.2 && < 2.1+    , text-display ^>= 0.0+    , ghc-hs-meta ^>= 0.1  test-suite tasty   import: commons@@ -57,10 +53,11 @@       base     , yasi     , text-    , tasty >= 1.3 && <= 1.5+    , text-display+    , tasty >= 1.3 && < 1.5     , tasty-hunit ^>= 0.10-    , tasty-hedgehog ^>= 1.0-    , hedgehog ^>= 1.0+    , tasty-hedgehog >= 1.0 && < 1.3+    , hedgehog >= 1.0 && < 1.2   other-modules:       Segments       Interpolations