exon 0.1.1.0 → 0.2.0.0

raw patch · 13 files changed

+115/−32 lines, 13 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• exon.cabal +2/−1
• lib/Exon.hs +8/−5
• lib/Exon/Class/Exon.hs +22/−8
• lib/Exon/Data/RawSegment.hs +3/−0
• lib/Exon/Data/Segment.hs +1/−1
• lib/Exon/Debug.hs +2/−0
• lib/Exon/Parse.hs +2/−1
• lib/Exon/Prelude.hs +3/−1
• lib/Exon/Quote.hs +40/−10
• lib/Prelude.hs +4/−0
• test/Exon/Test/BasicTest.hs +2/−2
• test/Exon/Test/KeepWsTest.hs +21/−0
• test/Main.hs +5/−3

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           exon-version:        0.1.1.0+version:        0.2.0.0 synopsis:       Monoidal Quasiquote Interpolation description:    See <https://hackage.haskell.org/package/exon/docs/Exon.html> category:       String@@ -120,6 +120,7 @@   main-is: Main.hs   other-modules:       Exon.Test.BasicTest+      Exon.Test.KeepWsTest       Exon.Test.Quote       Exon.Test.ShowsPrecTest       Paths_exon

@@ -1,6 +1,9 @@+-- |Monoidal Quasiquote Interpolation module Exon (   -- $intro-  module Exon.Quote,+  exon,+  exonws,+  exonWith,   -- * Customizing Concatenation   module Exon.Class.Exon,   -- * Combinators@@ -10,11 +13,11 @@   module Exon.Data.Result, ) where -import Exon.Class.Exon (Exon (..), ExonDefault)+import Exon.Class.Exon (Exon (..), ExonDefault, KeepWhitespace)+import Exon.Combinators (intercalate) import Exon.Data.Result (Result (..)) import Exon.Data.Segment (Segment (..))-import Exon.Quote (exon)-import Exon.Combinators (intercalate)+import Exon.Quote (exon, exonWith, exonws)  -- $intro -- This Haskell library provides quasiquote string interpolation with customizable concatenation for arbitrary types.@@ -45,4 +48,4 @@ -- -- Individual segments are tokenized at whitespace boundaries, expressions between `#{` and `}` are inserted verbatim. ----- The default implementation ignores whitespace when concatenating, while it is preserved for `String`, `Text` etc.+-- The default implementation ignores whitespace when concatenating, while it is preserved for `GHC.String`, `Text` etc.

@@ -7,8 +7,10 @@ import qualified Exon.Data.Segment as Segment import Exon.Data.Segment (Segment) +-- |The tag for the default quoter 'Exon.exon'. data ExonDefault +-- |The tag for the quoter 'Exon.exonws', keeping whitespace verbatim. data KeepWhitespace  {- |@@ -109,6 +111,7 @@     IsString a   ) => Exon ExonDefault a where +-- |Variant of 'convertSegment' that preserves whitespace verbatim. convertKeepWs ::   IsString a =>   Segment a ->@@ -121,6 +124,7 @@   Segment.Whitespace a ->     Result (fromString a) +-- |Variant of 'concatSegments' that preserves whitespace verbatim. concatKeepWs ::   ∀ tag a .   Monoid a =>@@ -130,6 +134,16 @@ concatKeepWs =   fold . foldl' (appendSegment @tag) Empty +instance (+    Monoid a,+    IsString a+  ) => Exon KeepWhitespace a where+  convertSegment =+    convertKeepWs++  concatSegments =+    concatKeepWs @KeepWhitespace+ instance Exon ExonDefault String where   convertSegment =     convertKeepWs@@ -139,31 +153,31 @@  instance Exon ExonDefault Text where   convertSegment =-    convertKeepWs+    convertSegment @KeepWhitespace    concatSegments =-    concatKeepWs @ExonDefault+    concatSegments @KeepWhitespace  instance Exon ExonDefault LText where   convertSegment =-    convertKeepWs+    convertSegment @KeepWhitespace    concatSegments =-    concatKeepWs @ExonDefault+    concatSegments @KeepWhitespace  instance Exon ExonDefault ByteString where   convertSegment =-    convertKeepWs+    convertSegment @KeepWhitespace    concatSegments =-    concatKeepWs @ExonDefault+    concatSegments @KeepWhitespace  instance Exon ExonDefault LByteString where   convertSegment =-    convertKeepWs+    convertSegment @KeepWhitespace    concatSegments =-    concatKeepWs @ExonDefault+    concatSegments @KeepWhitespace  instance Exon ExonDefault (String -> String) where   convertSegment = \case

@@ -1,5 +1,8 @@+-- |Description: Data Type 'RawSegment', Internal+ module Exon.Data.RawSegment where +-- |An intermediate representation for internal use. data RawSegment =   WsSegment String   |

@@ -1,4 +1,4 @@--- |Description: Internal+-- |Description: Data Type 'Segment' module Exon.Data.Segment where  -- |The parts of an interpolation quasiquote.

@@ -1,3 +1,5 @@+{-# options_haddock hide #-}+-- |Description: Debug Printing Combinators {-# language NoImplicitPrelude #-}  module Exon.Debug where

@@ -1,4 +1,5 @@--- |Description: Internal+{-# options_haddock prune #-}+-- |Description: The Quasiquote Body Parser module Exon.Parse where  import Data.Char (isSpace)

@@ -1,4 +1,6 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# options_haddock hide #-}+-- |Description: Prelude+{-# language NoImplicitPrelude #-}  module Exon.Prelude (   module Data.Kind,

@@ -1,3 +1,4 @@+{-# options_haddock prune #-} -- |Description: Internal module Exon.Quote where @@ -11,11 +12,12 @@   parseExtension,   ) import Language.Haskell.Meta (toExp)+import qualified Language.Haskell.TH as TH import Language.Haskell.TH (Exp (AppE, InfixE, ListE), Q, extsEnabled, runQ) import Language.Haskell.TH.Quote (QuasiQuoter (QuasiQuoter)) import Language.Haskell.TH.Syntax (Quasi) -import Exon.Class.Exon (ExonDefault, concatSegments)+import Exon.Class.Exon (ExonDefault, KeepWhitespace, concatSegments) import Exon.Data.RawSegment (RawSegment (ExpSegment, StringSegment, WsSegment)) import qualified Exon.Data.Segment as Segment import Exon.Parse (parse)@@ -74,17 +76,44 @@     WsSegment s ->      runQ [e|Segment.Whitespace s|] -quoteExp ::+quoteExpWith ::   QOrIO m =>+  Q TH.Type ->   String ->   m Exp-quoteExp code = do+quoteExpWith tag code = do   raw <- segmentsQ code   hseg :| segs <- reifySegments raw-  conc <- runQ [e|concatSegments @ExonDefault|]+  conc <- runQ [e|concatSegments @($tag)|]   consE <- runQ [e|(:|)|]   pure (AppE conc (InfixE (Just hseg) consE (Just (ListE segs)))) +quoteExp ::+  QOrIO m =>+  String ->+  m Exp+quoteExp =+  quoteExpWith [t|ExonDefault|]++-- |Constructor for a quasiquoter for an arbitrary tag.+--+-- This can be used to define quoters with custom logic, requiring an instance of 'Exon.Class.Exon' for the given type:+--+-- >>> import Exon.Class.Exon (Exon(..))+-- >>> import Exon.Data.Segment (Segment(String))+-- >>> data Nl+-- >>> instance (Monoid a, IsString a) => Exon Nl a where insertWhitespace s1 _ s2 = appendSegment @Nl (appendSegment @Nl s1 (String "\n")) s2+-- >>> exonnl = exonWith [t|Nl|]+-- >>> [exonnl|one   two     three|]+-- "one\ntwo\nthree"+exonWith :: Q TH.Type -> QuasiQuoter+exonWith tag =+  QuasiQuoter (quoteExpWith tag) (err "pattern") (err "type") (err "decl")+  where+    err :: String -> String -> Q a+    err tpe _ =+      exonError ("Cannot quote " <> tpe)+ -- |A quasiquoter that allows interpolation, concatenating the resulting segments monoidally. -- -- >>> [exon|write #{show @Text (5 :: Int)} lines of code|] :: Text@@ -96,13 +125,14 @@ -- >>> newtype Part = Part Text deriving newtype (Show, Semigroup, Monoid, IsString) -- -- >>> [exon|x #{Part "y"}z|] :: Part--- Part "xyz"+-- "xyz" -- -- This behavior can be customized by writing an instance of 'Exon.Exon'. exon :: QuasiQuoter exon =-  QuasiQuoter quoteExp (err "pattern") (err "type") (err "decl")-  where-    err :: String -> String -> Q a-    err tpe _ =-      exonError ("Cannot quote " <> tpe)+  exonWith [t|ExonDefault|]++-- |A variant of 'exon' that always keeps whitespace verbatim.+exonws :: QuasiQuoter+exonws =+  exonWith [t|KeepWhitespace|]

@@ -1,3 +1,7 @@+{-# options_haddock hide #-}+-- |Description: Prelude+{-# language NoImplicitPrelude #-}+ module Prelude (   module Exon.Prelude, ) where

@@ -58,6 +58,6 @@   insertWhitespace s1 ws s2 =     appendSegment @ExonDefault (appendSegment @ExonDefault s1 (Segment.Whitespace ws)) s2 -test_keepWhitespace :: TestT IO ()-test_keepWhitespace =+test_customWhitespace :: TestT IO ()+test_customWhitespace =   Thing "1 >>> 2 >>> 3" === [exon|1 #{Thing "2"}    3|]

@@ -0,0 +1,21 @@+module Exon.Test.KeepWsTest where++import Hedgehog (TestT, (===))++import Exon.Quote (exon, exonws)++newtype Mon =+  Mon String+  deriving (Eq, Show)+  deriving newtype (IsString, Semigroup, Monoid)++test_keepWs :: TestT IO ()+test_keepWs = do+  Mon "foo\n    and bar" === [exonws|foo+    #{var} bar|]+  "foo and bar" === [exon|foo #{var @Text} bar|]+  "foo and bar" === [exon|foo #{var @ByteString} bar|]+  where+    var :: IsString a => a+    var =+      "and"

@@ -1,6 +1,7 @@ module Main where -import Exon.Test.BasicTest (test_basic, test_keepWhitespace)+import Exon.Test.BasicTest (test_basic, test_customWhitespace)+import Exon.Test.KeepWsTest (test_keepWs) import Exon.Test.ShowsPrecTest (test_showsPrec) import Hedgehog (TestT, property, test, withTests) import Test.Tasty (TestName, TestTree, defaultMain, testGroup)@@ -17,8 +18,9 @@ tests =   testGroup "all" [     unitTest "basic" test_basic,-    unitTest "keep whitespace" test_keepWhitespace,-    unitTest "concat showsPrec fragments" test_showsPrec+    unitTest "custom whitespace handling" test_customWhitespace,+    unitTest "concat showsPrec fragments" test_showsPrec,+    unitTest "keep whitespace quoter" test_keepWs   ]  main :: IO ()