exon 0.5.0.0 → 1.0.0.0

raw patch · 17 files changed

+1026/−288 lines, 17 filesdep +criteriondep +generics-sopdep +type-errors-prettydep −textPVP ok

version bump matches the API change (PVP)

Dependencies added: criterion, generics-sop, type-errors-pretty

Dependencies removed: text

API changes (from Hackage documentation)

Files

• benchmark/Main.hs +43/−0
• exon.cabal +89/−5
• lib/Exon.hs +219/−34
• lib/Exon/Class/Exon.hs +227/−165
• lib/Exon/Class/Newtype.hs +38/−0
• lib/Exon/Class/ToSegment.hs +95/−0
• lib/Exon/Data/RawSegment.hs +2/−0
• lib/Exon/Data/Segment.hs +5/−1
• lib/Exon/Generic.hs +46/−0
• lib/Exon/Parse.hs +39/−9
• lib/Exon/Quote.hs +92/−37
• test/Exon/Test/BasicTest.hs +14/−14
• test/Exon/Test/BuildTest.hs +33/−0
• test/Exon/Test/KeepWsTest.hs +0/−21
• test/Exon/Test/NewtypeTest.hs +57/−0
• test/Exon/Test/SkipWsTest.hs +21/−0
• test/Main.hs +6/−2

@@ -0,0 +1,43 @@+module Main where++import Criterion.Main (bench, bgroup, defaultMain, whnf)+import qualified Data.Text.Lazy.Builder as Text+import Data.Text.Lazy.Builder (toLazyText)+import Exon.Class.Exon (exonProcess)+import Exon.Data.Segment (Segment)+import qualified Exon.Data.Segment as Segment (Segment (Expression))++newtype Str =+  Str Text+  deriving stock (Eq, Show, Generic)+  deriving newtype (IsString)++newtype Nam =+  Nam Str+  deriving stock (Eq, Show, Generic)+  deriving newtype (IsString)++s2 :: IsString a => a+s2 =+  "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"++segments :: NonEmpty (Segment Nam)+segments =+  (const (Segment.Expression s2)) <$> [1 :: Int .. 1000]++strings :: [Text]+strings =+  replicate 1000 s2++bench_manual :: [Text] -> Text+bench_manual s =+  toStrict (toLazyText (foldMap Text.fromText s))++main :: IO ()+main =+  defaultMain [+    bgroup "exon" [+      bench "build" (whnf exonProcess segments),+      bench "manual" (whnf bench_manual strings)+    ]+  ]

@@ -5,8 +5,8 @@ -- see: https://github.com/sol/hpack  name:           exon-version:        0.5.0.0-synopsis:       Monoidal Quasiquote Interpolation+version:        1.0.0.0+synopsis:       Customizable Quasiquote Interpolation description:    See https://hackage.haskell.org/package/exon/docs/Exon.html category:       String homepage:       https://github.com/tek/exon#readme@@ -26,10 +26,13 @@   exposed-modules:       Exon       Exon.Class.Exon+      Exon.Class.Newtype+      Exon.Class.ToSegment       Exon.Combinators       Exon.Data.RawSegment       Exon.Data.Result       Exon.Data.Segment+      Exon.Generic       Exon.Parse       Exon.Quote   hs-source-dirs:@@ -100,11 +103,12 @@   build-depends:       base >=4.12 && <5     , flatparse >=0.3.5.1+    , generics-sop     , haskell-src-exts <1.24     , haskell-src-meta <0.9     , incipit-base >=0.2     , template-haskell-    , text+    , type-errors-pretty   mixins:       base hiding (Prelude)     , incipit-base (IncipitBase as Prelude)@@ -116,9 +120,11 @@   main-is: Main.hs   other-modules:       Exon.Test.BasicTest-      Exon.Test.KeepWsTest+      Exon.Test.BuildTest+      Exon.Test.NewtypeTest       Exon.Test.Quote       Exon.Test.ShowsPrecTest+      Exon.Test.SkipWsTest   hs-source-dirs:       test   default-extensions:@@ -192,7 +198,85 @@     , tasty     , tasty-hedgehog     , template-haskell-    , text+  mixins:+      base hiding (Prelude)+    , incipit-base (IncipitBase as Prelude)+    , incipit-base hiding (IncipitBase)+  default-language: Haskell2010++benchmark exon-bench+  type: exitcode-stdio-1.0+  main-is: Main.hs+  hs-source-dirs:+      benchmark+  default-extensions:+      AllowAmbiguousTypes+      ApplicativeDo+      BangPatterns+      BinaryLiterals+      BlockArguments+      ConstraintKinds+      DataKinds+      DefaultSignatures+      DeriveAnyClass+      DeriveDataTypeable+      DeriveFoldable+      DeriveFunctor+      DeriveGeneric+      DeriveLift+      DeriveTraversable+      DerivingStrategies+      DerivingVia+      DisambiguateRecordFields+      DoAndIfThenElse+      DuplicateRecordFields+      EmptyCase+      EmptyDataDecls+      ExistentialQuantification+      FlexibleContexts+      FlexibleInstances+      FunctionalDependencies+      GADTs+      GeneralizedNewtypeDeriving+      InstanceSigs+      KindSignatures+      LambdaCase+      LiberalTypeSynonyms+      MultiParamTypeClasses+      MultiWayIf+      NamedFieldPuns+      OverloadedLabels+      OverloadedLists+      OverloadedStrings+      PackageImports+      PartialTypeSignatures+      PatternGuards+      PatternSynonyms+      PolyKinds+      QuantifiedConstraints+      QuasiQuotes+      RankNTypes+      RecordWildCards+      RecursiveDo+      RoleAnnotations+      ScopedTypeVariables+      StandaloneDeriving+      TemplateHaskell+      TupleSections+      TypeApplications+      TypeFamilies+      TypeFamilyDependencies+      TypeOperators+      TypeSynonymInstances+      UndecidableInstances+      UnicodeSyntax+      ViewPatterns+  ghc-options: -Wall -Wredundant-constraints -Wincomplete-uni-patterns -Wmissing-deriving-strategies -Widentities -Wunused-packages+  build-depends:+      base >=4.12 && <5+    , criterion+    , exon+    , incipit-base >=0.2   mixins:       base hiding (Prelude)     , incipit-base (IncipitBase as Prelude)

@@ -1,51 +1,236 @@--- |Monoidal Quasiquote Interpolation+-- |Customizable Quasiquote Interpolation module Exon (+  -- * Introduction   -- $intro++  -- * Implicit conversion #conversion#+  -- $conversion+   exon,   exonws,+  intron,+  exun,   exonWith,++  -- * Performance+  -- $performance+   -- * Customizing Concatenation-  module Exon.Class.Exon,+  -- $custom++  Exon (..),+  ExonBuild (..),+  ExonAppend (..),+  ExonSegment (..),+  ExonBuilder (..),+  ExonString (..),+  ToSegment (..),+  SkipWs (..),+  skipWs,+  ExonUse (..),++  -- * Type inference+  -- $inference+   -- * Combinators   module Exon.Combinators,+   -- * Data Types   module Exon.Data.Segment,   module Exon.Data.Result, ) where -import Exon.Class.Exon (Exon (..), ExonDefault, KeepWhitespace)+import Exon.Class.Exon (+  Exon (..),+  ExonAppend (..),+  ExonBuild (..),+  ExonBuilder (..),+  ExonSegment (..),+  ExonString (..),+  ExonUse (..),+  SkipWs (..),+  skipWs,+  )+import Exon.Class.ToSegment (ToSegment (..)) import Exon.Combinators (intercalate) import Exon.Data.Result (Result (..)) import Exon.Data.Segment (Segment (..))-import Exon.Quote (exon, exonWith, exonws)+import Exon.Quote (exon, exonWith, exun, intron, exonws) --- $intro--- This Haskell library provides quasiquote string interpolation with customizable concatenation for arbitrary types.------ The default case uses `Monoid` and `IsString`:------ @--- import Exon (exon)--- import Data.Text (toUpper)------ newtype Name =---   Name Text---   deriving newtype (Show, Monoid, IsString)------ instance Semigroup Name where---   Name l <> Name r = Name (l <> " | " <> r)------ lastName :: Name--- lastName = "Fry"------ up :: Name -> Name--- up (Name name) = Name (toUpper name)------ >>> [exon|Philip J. #{up lastName}|]--- Name "Philip | J. | FRY"------ @------ 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 `GHC.String`, `Text` etc.+{- $intro+This Haskell library provides quasiquote string interpolation with customizable concatenation for arbitrary types.++A quasiquote with the quoter 'exon' is transformed into a chain of concatenations, allowing expressions to be+interpolated between the characters @#{@ and @}@.+A common use case is plain text interpolation:++>>> :set -XOverloadedStrings+>>> animal = "snake"+>>> location = "a tree"+>>> [exon|#{animal} in #{location}|]+"snake in a tree"++The quote is effectively converted to a sequence of 'Semigroup' concatenations:++>>> animal <> " " <> "in" <> " " <> location+"snake in a tree"++It is precisely converted to an intermediate data structure, 'Segment', and concatenated using customizable classes:++>>> exonProcess [Expression animal, String " in ", Expression location]+"snake in a tree"++The default implementation uses `Monoid` and `IsString`, resulting in something like:++>>> foldl' (<>) mempty [animal, fromString " ", fromString "in", fromString " ", location] :: String+"snake in a tree"++This allows any type that implements those two classes to be used as the result:++>>> newtype Str = Str Text deriving stock (Show) deriving newtype (IsString, Semigroup, Monoid)+>>> [exon|#{animal} in #{location}|] :: Str+Str "snake in a tree"++The astute reader might notice that it is unclear what type @animal@ is expected to be – it hasn't been annotated, yet+it works for both the quote without type annotation as well as the one of type @Str@.++The reason for this phenomenon is that GHC types @animal = "snake"@ as @animal :: IsString a => a@ thanks to+@OverloadedStrings@.+When the quote is written without annotation, the evaluator defaults to @String@ in order to print it (for example,+@hls-eval-plugin@ or GHCi).++When the two names are used in the quote with @Str@, they will be instantiated as @Str@ as well.++One neat application of Exon is for writing 'Text.Show.showsPrec' methods, whose type is @t'String' -> t'String'@ and+which are used to stringify a type with automatic parentheses when contained in a larger type:++> data Numbers =+>   Numbers Int (Maybe Int) Value+>+> instance Show Numbers where+>   showsPrec d Numbers number maybeNumber value =+>     showParen (d > 10)+>       [exon|Numbers #{showsPrec 11 number} #{showsPrec 11 maybeNumber} #{showsPrec 11 value}|]++-}++{- $conversion+Values of different types can be interpolated if they meet one of two conditions:++- They are instances of 'Generic' and representationally equal to the result type (i.e. newtypes)+- They are one of the common stringly types: t'String', 'Text', 'LText', 'ByteString' and 'LByteString'++Exon requires auto-converted values to be interpolated with a different bracket, @##{@, to avoid accidents:++>>> newtype Str = Str Text deriving stock (Show) deriving newtype (IsString, Semigroup, Monoid)+>>> newtype Animal = Animal ByteString deriving stock (Generic)+>>> animal = Animal "lemur"+>>> location = "a tree"+>>> [exon|##{animal} in #{location}|] :: Str+Str "lemur in a tree"++In this case, the two conditions are even combined – the @Animal@ is unwrapped, UTF-8-decoded to @Text@, and rewrapped+into @Str@.++If you absolutely want to splice newtypes with the same brackets, you can use the quoter 'exun' (the @un@ stands for+@unsafe@).+-}++{- $performance+Generic string concatenation can be quite expensive.+If a quote's result type is 'Text', as in:++>>> [exon|#{"x"} #{"y"}|] :: Text++then the resulting concatenation will use the 'Semigroup' operation for 'Text', which has @O(n)@ complexity for each+pair of appended strings.++In order to improve performance, Exon allows the type used for concatenation (the /builder/) to differ from the result+type, which is implemented by the class 'ExonBuilder'.+For example, the instance for 'Text' selects 'Text.Builder' as the builder type and converts the segments and the result+accordingly.+In a quote of 1000 segments, this improves performance by a factor of 100!++However, if the result type is a newtype, the 'Text' builder will not be used:++>>> newtype Str = Str Text deriving stock (Show) deriving newtype (IsString, Semigroup, Monoid)+>>> [exon|#{"x"} #{"y"}|] :: Str++This restriction can be circumvented by making @Str@ an instance of 'Generic' – in that case, Exon will unwrap the type+(even multiply nested newtypes) and use the builder associated with the inner type.+@Str@ doesn't even need to derive 'IsString', 'Semigroup' and 'Monoid' in this case, as all the operations are performed+on 'Text.Builder'.++In principle, this conversion could be done with 'Coercible' as well, but type inference is really bad with that method.++/Note/ that when using [generic segment conversion]("Exon#g:conversion") in conjunction with this, the result type must+also derive 'IsString'.+-}++{- $custom+Quote types don't have to be transparent wrappers for strings.+Concatenation can be changed in a type's 'Semigroup':++>>> import Data.Text (toUpper)+>>> newtype Name = Name Text deriving newtype (Show, IsString)+>>> instance Semigroup Name where Name l <> Name r = Name (l <> " | " <> r)+>>> deriving instance Monoid Name+>>> lastName = Name "Fry"+>>> [intron|Philip J. #{lastName}|]+"Philip | J. | Fry"++This example uses the quoter 'intron', which ignores whitespace.+The 'Semigroup' then inserts custom separators.++The same result can be achieved by using the whitespace-aware quoter 'exonws' and providing a specialized instance of+some of Exon's classes, like 'ExonString':++> newtype Name = Name Text deriving stock (Generic)+> instance ExonString Name Text.Builder where+>   exonWhitespace _ = Result " | "++This example additionally uses the 'Generic' newtype unwrapping feature, allowing the customization to be performed+directly in the efficient builder type.+-}++{- $inference+The type of an expression segment is usually known, for example when the interpolated value is an argument of the+enclosing function:++>>> f :: Text -> Text; f t = [exon|value: #{t}|]+>>> f "snake"+"value: snake"++Here both the interpolated expression and the quote's result type are known.++However, expressions may be polymorphic:++>>> t :: IsString a => a; t = "snake"+>>> f :: Text; f = [exon|value: #{t}|]+>>> f+"value: snake"++The quasiquote parser turns this into the expression:++> [Segment.String "value: ", Segment.Expression t] :: Text++The list of segments has the known type 'Text', obtained from the type signature of @f@.+In this case, the type of @t@ is instantiated as 'Text' as well, causing no type inference problems.++However, if the quote is used polymorphically as well, as in:++> printThing :: Show a => a -> IO ()+> printThing [exon|value: #{t}|]++the type of the segment list would be @∀ a . IsString => [a]@, which would not be possible to concatenate, so @t@ must+be annotated.++Since the segment list is typechecked like any other expression, an expression segment with known type will determine+the result type of an otherwise polymorphic quote:++>>> newtype Str = Str Text deriving stock (Show) deriving newtype (IsString, Semigroup, Monoid)+>>> [exon|pre #{"x" :: Str} post|]+Str "pre x post"++The result type is unambiguously fixed to @Str@.+-}

@@ -1,203 +1,265 @@ -- |Description: Internal module Exon.Class.Exon where +import qualified Data.ByteString.Builder as ByteString+import Data.ByteString.Builder (toLazyByteString)+import qualified Data.Text.Lazy.Builder as Text+import Data.Text.Lazy.Builder (toLazyText) import Text.Show (showString) +import Exon.Class.Newtype (OverNewtypes, overNewtypes) import Exon.Data.Result (Result (Empty, Result)) 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--{- |-This class is responsible for combining segments of an interpolated string, allowing users to define their own rules-for how the result is constructed.-The default implementation converts each literal part with 'IsString' and uses the result type's 'Monoid' to-concatenate them.--The raw parts are encoded as 'Segment', getting combined into a 'Result'.+-- |Wrapping a quote type with this causes whitespace to be ignored.+--+-- @since 1.0.0.0+newtype SkipWs a =+  SkipWs a+  deriving stock (Eq, Show, Generic)+  deriving newtype (IsString) -The default for 'convertSegment' skips whitespace by encoding it into the 'Result' constructor 'Empty', which is a-unit object.-To change this behavior, it can be easily overridden:+-- |Defined separately because TH chokes on the selector.+--+-- @since 1.0.0.0+skipWs :: SkipWs a -> a+skipWs (SkipWs a) =+  a -@-newtype Thing = Thing String deriving newtype (IsString, Semigroup, Monoid, Show)+-- |Wrapping a quote type with this causes @a@ to be used irrespective of whether it is an unwrappable newtype.+--+-- @since 1.0.0.0+newtype ExonUse a =+  ExonUse { exonUse :: a }+  deriving stock (Eq, Show)+  deriving newtype (IsString) -instance Exon ExonDefault Thing where-  convertSegment = \case-    Segment.String s -> Result (Thing s)-    Segment.Expression thing -> Result thing-    Segment.Whitespace _ -> Result (Thing " >>> ")+-- |This class converts a segment into a builder.+--+-- A builder is an auxiliary data type that may improve performance when concatenating segments, like 'Text.Builder'.+-- The default instance uses no builder and is implemented as 'id'.+--+-- @since 1.0.0.0+class ExonBuilder (inner :: Type) (builder :: Type) | inner -> builder where+  -- |Construct a builder from the newtype-unwrapped result type.+  exonBuilder :: inner -> builder -  insertWhitespace s1 ws s2 =-    appendSegment @ExonDefault (appendSegment @ExonDefault s1 (Segment.Whitespace ws)) s2-@--}-class Exon (tag :: Type) (a :: Type) where+  -- |Convert the result of the builder concatenation back to the newtype-unwrapped result type.+  exonBuilderExtract :: Result builder -> inner -  -- |This check is used to allow empty expression segments to be skipped when they are empty.-  -- The default is to never skip expressions.-  isEmpty :: a -> Bool-  isEmpty =-    const False+instance {-# overlappable #-} (+    Monoid builder,+    result ~ builder+  ) => ExonBuilder result builder where+  exonBuilder =+    id+  {-# inline exonBuilder #-}+  exonBuilderExtract =+    fold+  {-# inline exonBuilderExtract #-} -  -- |Convert a 'Segment' to a 'Result'.-  -- The default implementation uses 'IsString' and ignores whitespace, returning 'Empty'.-  convertSegment :: Segment a -> Result a+instance (+    ExonBuilder a builder+  ) => ExonBuilder (ExonUse a) builder where+  exonBuilder =+    exonBuilder @a . exonUse+  exonBuilderExtract =+    ExonUse . exonBuilderExtract -  default convertSegment :: IsString a => Segment a -> Result a-  convertSegment = \case-    Segment.String a ->-      Result (fromString a)-    Segment.Expression a | isEmpty @tag a ->-      Empty-    Segment.Expression a ->-      Result a-    Segment.Whitespace _ ->-      Empty+instance ExonBuilder Text Text.Builder where+  exonBuilder =+    Text.fromText+  {-# inline exonBuilder #-}+  exonBuilderExtract =+    foldMap (toStrict . toLazyText)+  {-# inline exonBuilderExtract #-} -  -- |Append a 'Segment' to a 'Result'.-  -- The default implementation uses '(<>)'.-  appendSegment :: Result a -> Segment a -> Result a+instance ExonBuilder LText Text.Builder where+  exonBuilder =+    Text.fromLazyText+  exonBuilderExtract =+    foldMap toLazyText -  default appendSegment :: Semigroup a => Result a -> Segment a -> Result a-  appendSegment z a =-    z <> convertSegment @tag a+instance ExonBuilder ByteString ByteString.Builder where+  exonBuilder =+    ByteString.byteString+  exonBuilderExtract =+    foldMap (toStrict . toLazyByteString) -  -- |Append whitespace and a 'Segment' to a 'Result', i.e. joining two parts of the interpolation by whitespace.-  -- The default implementation ignores the whitespace, calling 'appendSegment' with the second argument.-  insertWhitespace :: Result a -> String -> Segment a -> Result a+instance ExonBuilder LByteString ByteString.Builder where+  exonBuilder =+    ByteString.lazyByteString+  exonBuilderExtract =+    foldMap toLazyByteString -  default insertWhitespace :: Result a -> String -> Segment a -> Result a-  insertWhitespace s1 _ =-    appendSegment @tag s1+-- |This class generalizes 'IsString' for use in 'ExonSegment'.+--+-- When a plain text segment (not interpolated) is processed, it is converted to the result type, which usually happens+-- via 'fromString'.+--+-- For the type of 'Text.Show.showsPrec' (@'String' -> 'String'@), there is no instance of 'IsString', so this class+-- provides an instance that works around that by calling 'showString'.+--+-- @since 1.0.0.0+class ExonString (result :: Type) (builder :: Type) where+  -- |Convert a 'String' to the builder type.+  exonString :: String -> Result builder -  -- |The entry point for concatenation, taking a list of segments parsed from the interpolation.-  -- The default implementation skips leading whitespace and calls 'appendSegment' and 'insertWhitespace' to-  -- concatenate.-  concatSegments :: NonEmpty (Segment a) -> a+  default exonString :: IsString builder => String -> Result builder+  exonString =+    Result . fromString+  {-# inline exonString #-} -  default concatSegments :: Monoid a => NonEmpty (Segment a) -> a-  concatSegments (h :| t) =-    fold (spin (convertSegment @tag h) t)-    where-      spin :: Result a -> [Segment a] -> Result a-      spin Empty = \case-        [] ->-          Empty-        Segment.Whitespace _ : ss ->-          spin Empty ss-        s1 : ss ->-          spin (convertSegment @tag s1) ss-      spin (Result s1) = \case-        [] ->-          Result s1-        Segment.Whitespace _ : (Segment.Expression a) : ss | isEmpty @tag a ->-          spin (Result s1) ss-        Segment.Whitespace ws : s2 : ss ->-          spin (insertWhitespace @tag (Result s1) ws s2) ss-        [Segment.Whitespace _] ->-          (Result s1)-        s2 : ss ->-          spin (appendSegment @tag (Result s1) s2) ss+  -- |Convert a 'String' containing whitespace to the builder type.+  -- This is only used by whitespace-aware quoters, like 'Exon.exonws' or 'Exon.intron'.+  exonWhitespace :: String -> Result builder -instance {-# overlappable #-} (-    Monoid a,-    IsString a-  ) => Exon ExonDefault a where+  default exonWhitespace :: String -> Result builder+  exonWhitespace =+    exonString @result @builder+  {-# inline exonWhitespace #-} --- |Variant of 'convertSegment' that preserves whitespace verbatim.-convertKeepWs ::-  IsString a =>-  Segment a ->-  Result a-convertKeepWs = \case-  Segment.String a ->-    Result (fromString a)-  Segment.Expression a ->-    Result a-  Segment.Whitespace a ->-    Result (fromString a)+instance {-# overlappable #-} IsString a => ExonString result a where --- |Variant of 'concatSegments' that preserves whitespace verbatim.-concatKeepWs ::-  ∀ tag a .-  Monoid a =>-  Exon tag a =>-  NonEmpty (Segment a) ->-  a-concatKeepWs =-  fold . foldl' (appendSegment @tag) Empty+-- |The instance for the type used by 'Text.Show.showsPrec'.+instance ExonString result (String -> String) where+  exonString =+    Result . showString+  {-# inline exonString #-} +-- |The instance used when the result type is wrapped in 'SkipWs', which is done by 'Exon.intron'.+--+-- It returns 'Empty' for any whitespace. instance (-    Monoid a,-    IsString a-  ) => Exon KeepWhitespace a where-  convertSegment =-    convertKeepWs--  concatSegments =-    concatKeepWs @KeepWhitespace--instance Exon ExonDefault String where-  convertSegment =-    convertKeepWs--  concatSegments =-    concatKeepWs @ExonDefault+    IsString builder+  ) => ExonString (SkipWs result) builder where+  exonWhitespace _ =+    Empty+  {-# inline exonWhitespace #-} -instance Exon ExonDefault Text where-  convertSegment =-    convertSegment @KeepWhitespace+-- |This class converts a 'Segment' to a builder.+--+-- The default implementation performs the following conversions for the differnet segment variants:+--+-- - [Segment.String]('Segment.String') and [Segment.Whitespace]('Segment.Whitespace') are plain 'String's parsed+-- literally from the quasiquote.+-- They are converted to the builder type by 'fromString' (handled by 'ExonString').+--+-- - [Segment.Whitespace]('Segment.Whitespace') is ignored when the quoter 'Exon.intron' was used.+--+-- - [Segment.Expression]('Segment.Expression') contains a value of the builder type, which is returned as-is.+--+-- @since 1.0.0.0+class ExonSegment (result :: Type) (builder :: Type) where+  -- |Convert literal string segments to the result type.+  exonSegment :: Segment builder -> Result builder -  concatSegments =-    concatSegments @KeepWhitespace+instance {-# overlappable #-} (+    ExonString result builder+  ) => ExonSegment result builder where+    exonSegment = \case+      Segment.String a ->+        exonString @result a+      Segment.Expression a ->+        Result a+      Segment.Whitespace a ->+        exonWhitespace @result a+    {-# inline exonSegment #-} -instance Exon ExonDefault LText where-  convertSegment =-    convertSegment @KeepWhitespace+-- |This class handles concatenation of segments, which might be a builder or the result type.+--+-- The default instance simply uses '(<>)', and there is only one special instance for @'String' -> 'String'@, the type+-- used by 'Text.Show.showsPrec'.+--+-- @since 1.0.0.0+class ExonAppend (result :: Type) (builder :: Type) where+  -- |Concatenate two segments of the builder type.+  exonAppend :: builder -> builder -> Result builder -  concatSegments =-    concatSegments @KeepWhitespace+instance {-# overlappable #-} (+    Semigroup builder+  ) => ExonAppend result builder where+  exonAppend z a =+    Result (z <> a)+  {-# inline exonAppend #-} -instance Exon ExonDefault ByteString where-  convertSegment =-    convertSegment @KeepWhitespace+instance ExonAppend result (String -> String) where+  exonAppend z a =+    Result (z . a)+  {-# inline exonAppend #-} -  concatSegments =-    concatSegments @KeepWhitespace+-- |Wrapper for 'exonAppend' that handles the 'Empty' case.+--+-- @since 1.0.0.0+exonAppendResult ::+  ∀ result builder .+  ExonAppend result builder =>+  Result builder ->+  Result builder ->+  Result builder+exonAppendResult (Result z) (Result a) =+  exonAppend @result z a+exonAppendResult z Empty =+  z+exonAppendResult Empty a =+  a+{-# inline exonAppendResult #-} -instance Exon ExonDefault LByteString where-  convertSegment =-    convertSegment @KeepWhitespace+-- |This class implements the 'Segment' concatenation logic.+--+-- 1. Each 'Segment.Expression' is converted to the builder type by 'ExonBuilder'.+-- 2. Each 'Segment.String' and 'Segment.Whitespace' is converted to the builder type by 'ExonSegment' and 'ExonString'.+-- 3. The segments are folded over 'ExonAppend'.+-- 4. The result is converted from the builder type to the original type by 'ExonBuilder'.+--+-- Each step may be overridden individually+--+-- @since 1.0.0.0+class ExonBuild (result :: Type) (inner :: Type) where+  -- |Concatenate a list of 'Segment's.+  exonBuild :: NonEmpty (Segment inner) -> inner -  concatSegments =-    concatSegments @KeepWhitespace+instance {-# overlappable #-} (+    ExonAppend result builder,+    ExonSegment result builder,+    ExonBuilder inner builder+  ) => ExonBuild result inner where+  exonBuild =+    exonBuilderExtract .+    foldl1 (exonAppendResult @result) .+    fmap (exonSegment @result . fmap exonBuilder)+  {-# inline exonBuild #-} -instance Exon ExonDefault (String -> String) where-  convertSegment = \case-    Segment.String a ->-      Result (showString a)-    Segment.Expression a | isEmpty @ExonDefault a ->-      Empty-    Segment.Expression a ->-      Result a-    Segment.Whitespace ws ->-      Result (showString ws)+-- |This class is the main entry point for Exon.+--+-- The default instance unwraps all newtypes that are 'Generic' and passes the innermost type to 'ExonBuild'.+--+-- The original type is also used as a parameter to 'ExonBuild', so customizations can be based on it.+class Exon (result :: Type) where+  -- |Concatenate a list of 'Segment's.+  --+  -- @since 1.0.0.0+  exonProcess :: NonEmpty (Segment result) -> result -  appendSegment z a =-    case (z, convertSegment @ExonDefault a) of-      (Result z', Result a') ->-        Result (z' . a')-      (z', Empty) ->-        z'-      (Empty, a') ->-        a'+instance {-# overlappable #-} (+    OverNewtypes result inner,+    ExonBuild result inner+  ) => Exon result where+    exonProcess =+      overNewtypes @result (exonBuild @result)+    {-# inline exonProcess #-} -  concatSegments =-    concatKeepWs @ExonDefault+-- |Call 'exonProcess', but unwrap the arguments and rewrap the result using the supplied functions.+--+-- @since 1.0.0.0+exonProcessWith ::+  ∀ wrapped result .+  Exon wrapped =>+  (result -> wrapped) ->+  (wrapped -> result) ->+  NonEmpty (Segment result) ->+  result+exonProcessWith unwrap wrap =+  wrap . exonProcess @wrapped . fmap (fmap unwrap)+{-# inline exonProcessWith #-}

@@ -0,0 +1,38 @@+-- |Description: Internal+module Exon.Class.Newtype where++import Exon.Data.Segment (Segment)+import Exon.Generic (IsNewtype, OverNt)+import Unsafe.Coerce (unsafeCoerce)++-- |Internal auxiliary class that applies a function to the value inside of a nested chain of 'Generic' newtypes.+class OverNewtype (current :: Type) (wrapped :: Maybe Type) (inner :: Type) | current -> inner where+  overNewtype :: (NonEmpty (Segment inner) -> inner) -> NonEmpty (Segment current) -> current++instance (+    OverNt current wrapped,+    IsNewtype wrapped next,+    OverNewtype wrapped next inner+  ) => OverNewtype current ('Just wrapped) inner where+    overNewtype f segments =+      unsafeCoerce (overNewtype @wrapped @next @inner f (fmap unsafeCoerce <$> segments))+    {-# inline overNewtype #-}++instance OverNewtype current 'Nothing current where+  overNewtype =+    id+  {-# inline overNewtype #-}++-- |Internal auxiliary class that applies a function to the value inside of a nested chain of 'Generic' newtypes.+--+-- The method only passes its arguments to 'overNewtypes', but the class hides the intermediate parameter.+class OverNewtypes (result :: Type) (inner :: Type) | result -> inner where+  overNewtypes :: (NonEmpty (Segment inner) -> inner) -> NonEmpty (Segment result) -> result++instance (+    IsNewtype result wrapped,+    OverNewtype result wrapped inner+  ) => OverNewtypes result inner where+    overNewtypes =+      overNewtype @result @wrapped+    {-# inline overNewtypes #-}

@@ -0,0 +1,95 @@+{-# options_haddock prune #-}++-- |Description: Internal+module Exon.Class.ToSegment where++import GHC.TypeLits (ErrorMessage)+import Generics.SOP (SOP (SOP), unZ, I (I), NP ((:*), Nil))+import Generics.SOP.GGP (GCode, GFrom, gfrom)+import Type.Errors.Pretty (type (%), type (<>))++import Exon.Generic (IsNewtype)++class NewtypeSegment (wrapped :: Maybe Type) a b where+  newtypeSegment :: a -> b++instance (+    Generic a,+    GFrom a,+    GCode a ~ '[ '[b]],+    ToSegment b c+  ) => NewtypeSegment ('Just b) a c where+    newtypeSegment (gfrom -> SOP (unZ -> I b :* Nil)) =+      toSegment b++type family Q (a :: k) :: ErrorMessage where+  Q a = "‘" <> a <> "’"++type family NoGenericMessage (a :: Type) (b :: Type) :: Constraint where+  NoGenericMessage a a = a ~ a+  NoGenericMessage a b =+    TypeError (+      "Found an expression of type " <> Q a <> " in a quote of type " <> Q b <> "." %+      "If " <> Q a <> " is a newtype of " <> Q b <> " that should be converted automatically," %+      "you need to add " <> Q "deriving (Generic)" <> " to its declaration." %+      "You can also implement " <> Q ("instance ToSegment " <> a <> " " <> b) <> " for custom interpolation."+    )++instance (+    NoGenericMessage a b,+    a ~ b+  ) => NewtypeSegment 'Nothing a b where+  newtypeSegment =+    id++-- |This class determines how an expression is converted to an interpolation quote's result type.+--+-- For a quote like @[exon|a #{exp :: T} c|] :: R@, the instance @ToSegment T R@ is used to turn @T@ into @R@.+-- Aside from specialized instances for stringly types, the default implementation uses 'Generic' to unwrap newtypes+-- that either match the result type exactly, or uses 'fromString' for result types that implement 'IsString'.+--+-- So given:+--+-- >>> newtype T = T Text deriving newtype (Generic)+-- >>> newtype R = R Text deriving newtype (IsString, Semigroup, Monoid)+--+-- the quote from earlier would generically unwrap @T@ and use 'fromString' to construct an @R@.+class ToSegment a b where+  toSegment :: a -> b++instance {-# incoherent #-} (+    IsNewtype a wrapped,+    NewtypeSegment wrapped a b+  ) => ToSegment a b where+  toSegment =+    newtypeSegment @wrapped++instance {-# overlappable #-} (+    IsString a+  ) => ToSegment String a where+  toSegment =+    fromString . toString++instance {-# overlappable #-} (+    IsString a+  ) => ToSegment Text a where+  toSegment =+    fromString . toString++instance {-# overlappable #-} (+    IsString a+  ) => ToSegment LText a where+  toSegment =+    fromString . toString++instance {-# overlappable #-} (+    IsString a+  ) => ToSegment ByteString a where+  toSegment =+    fromString . decodeUtf8++instance {-# overlappable #-} (+    IsString a+  ) => ToSegment LByteString a where+  toSegment =+    fromString . decodeUtf8

@@ -9,4 +9,6 @@   StringSegment String   |   ExpSegment String+  |+  AutoExpSegment String   deriving stock (Eq, Show)

@@ -9,4 +9,8 @@   Whitespace String   |   Expression a-  deriving stock (Eq, Show)+  deriving stock (Eq, Show, Functor)++instance IsString (Segment a) where+  fromString =+    String

@@ -0,0 +1,46 @@+{-# options_haddock prune #-}++-- |Description: Internal+module Exon.Generic where++import Generics.SOP (All2, I (I), NP (Nil, (:*)), NS (S, Z), SOP (SOP), Top)+import Generics.SOP.GGP (GCode, GDatatypeInfoOf, GFrom, GTo, gfrom, gto)+import Generics.SOP.Type.Metadata (DatatypeInfo (Newtype))++type ReifySOP (a :: Type) (ass :: [[Type]]) =+  (Generic a, GTo a, GCode a ~ ass, All2 Top ass)++type ConstructSOP (a :: Type) (ass :: [[Type]]) =+  (Generic a, GFrom a, GCode a ~ ass, All2 Top ass)++type ReifyNt (a :: Type) (b :: Type) =+  ReifySOP a '[ '[b] ]++type GenNt (a :: Type) (b :: Type) =+  ConstructSOP a '[ '[b] ]++type OverNt (a :: Type) (b :: Type) =+  (ReifyNt a b, GenNt a b)++unwrap ::+  GenNt a b =>+  a ->+  b+unwrap a =+  case gfrom a of+    SOP (Z (I b :* Nil)) -> b+    SOP (S n) -> case n of++wrap ::+  ReifyNt a b =>+  b ->+  a+wrap b =+  gto (SOP (Z (I b :* Nil)))++class GDatatypeInfoIsNewtype (dss :: [[Type]]) (info :: DatatypeInfo) (wrapped :: Maybe Type) | dss info -> wrapped+instance {-# incoherent #-} wrapped ~ 'Nothing => GDatatypeInfoIsNewtype dss info wrapped+instance wrapped ~ 'Just d => GDatatypeInfoIsNewtype '[ '[d]] ('Newtype m n c) wrapped++class IsNewtype d (wrapped :: Maybe Type) | d -> wrapped+instance GDatatypeInfoIsNewtype (GCode d) (GDatatypeInfoOf d) wrapped => IsNewtype d wrapped

@@ -20,14 +20,14 @@   runParserS,   satisfy,   some_,-  withSpan,   string,   takeRest,+  withSpan,   (<|>),   ) import Prelude hiding (empty, span, (<|>)) -import Exon.Data.RawSegment (RawSegment (ExpSegment, StringSegment, WsSegment))+import Exon.Data.RawSegment (RawSegment (AutoExpSegment, ExpSegment, StringSegment, WsSegment))  type Parser =   FlatParse.Parser Int Text@@ -69,32 +69,62 @@         0 -> unit         cur -> put (cur - 1) *> $(char '}') *> expr -interpolation :: Parser RawSegment-interpolation =+autoInterpolation :: Parser RawSegment+autoInterpolation =+  $(string "##{") *> (AutoExpSegment <$> span expr) <* $(char '}')++verbatimInterpolation :: Parser RawSegment+verbatimInterpolation =   $(string "#{") *> (ExpSegment <$> span expr) <* $(char '}')  untilTokenEnd :: Parser () untilTokenEnd =   branch $(char '\\') (anyChar *> untilTokenEnd) $-  finishBefore ($(string "#{") <|> void ws) $+  finishBefore ($(string "##{") <|> $(string "#{")) $   eof <|> (anyChar *> untilTokenEnd) +untilTokenEndWs :: Parser ()+untilTokenEndWs =+  branch $(char '\\') (anyChar *> untilTokenEndWs) $+  finishBefore ($(string "##{") <|> $(string "#{") <|> void ws) $+  eof <|> (anyChar *> untilTokenEndWs)+ text :: Parser RawSegment text =   StringSegment <$> span untilTokenEnd +textWs :: Parser RawSegment+textWs =+  StringSegment <$> span untilTokenEndWs+ segment :: Parser RawSegment segment =-  branch eof empty (whitespace <|> interpolation <|> text)+  branch eof empty (autoInterpolation <|> verbatimInterpolation <|> text) +segmentWs :: Parser RawSegment+segmentWs =+  branch eof empty (whitespace <|> autoInterpolation <|> verbatimInterpolation <|> textWs)+ parser :: Parser [RawSegment] parser =   FlatParse.many segment -parse :: String -> Either Text [RawSegment]-parse =-  runParserS parser 0 0 >>> \case+parserWs :: Parser [RawSegment]+parserWs =+  FlatParse.many segmentWs++parseWith :: Parser [RawSegment] -> String -> Either Text [RawSegment]+parseWith p =+  runParserS p 0 0 >>> \case     OK a _ "" -> Right a     OK _ _ u -> Left ("unconsumed: " <> decodeUtf8 u)     Fail -> Left "fail"     Err e -> Left e++parse :: String -> Either Text [RawSegment]+parse =+  parseWith parser++parseWs :: String -> Either Text [RawSegment]+parseWs =+  parseWith parserWs

@@ -17,10 +17,11 @@ import Language.Haskell.TH.Quote (QuasiQuoter (QuasiQuoter)) import Language.Haskell.TH.Syntax (Quasi) -import Exon.Class.Exon (ExonDefault, KeepWhitespace, concatSegments)-import Exon.Data.RawSegment (RawSegment (ExpSegment, StringSegment, WsSegment))+import Exon.Class.Exon (SkipWs (SkipWs), exonProcess, exonProcessWith, skipWs)+import Exon.Class.ToSegment (toSegment)+import Exon.Data.RawSegment (RawSegment (AutoExpSegment, ExpSegment, StringSegment, WsSegment)) import qualified Exon.Data.Segment as Segment-import Exon.Parse (parse)+import Exon.Parse (parse, parseWs)  exonError ::   ToString e =>@@ -32,12 +33,13 @@  segmentsQ ::   QOrIO m =>+  Bool ->   String ->   m (NonEmpty RawSegment)-segmentsQ "" =+segmentsQ _ "" =   exonError ("empty interpolation" :: String)-segmentsQ s =-  parse s & fmap nonEmpty & \case+segmentsQ whitespace s =+  (if whitespace then parseWs else parse) s & fmap nonEmpty & \case     Right (Just segs) -> pure segs     Right Nothing -> pure (pure (StringSegment ""))     Left err -> exonError err@@ -65,80 +67,133 @@  reifySegments ::   QOrIO m =>+  Bool ->   NonEmpty RawSegment ->   m (NonEmpty Exp)-reifySegments segs = do+reifySegments unsafe segs = do   expCon <- runQ [e|Segment.Expression|]+  expToSegment <- runQ [e|toSegment|]   for segs \case     StringSegment s ->       runQ [e|Segment.String s|]+    ExpSegment s | unsafe -> do+      e <- reifyExp s+      pure (AppE expCon (AppE expToSegment e))     ExpSegment s -> do       e <- reifyExp s       pure (AppE expCon e)+    AutoExpSegment s -> do+      e <- reifyExp s+      pure (AppE expCon (AppE expToSegment e))     WsSegment s ->      runQ [e|Segment.Whitespace s|]  quoteExpWith ::   QOrIO m =>-  Q TH.Type ->+  Maybe (Q TH.Exp, Q TH.Exp) ->+  Bool ->+  Bool ->   String ->   m Exp-quoteExpWith tag code = do-  raw <- segmentsQ code-  hseg :| segs <- reifySegments raw-  conc <- runQ [e|concatSegments @($tag)|]+quoteExpWith wrapper whitespace unsafe code = do+  raw <- segmentsQ whitespace code+  hseg :| segs <- reifySegments unsafe raw+  conc <- runQ $ maybe [e|exonProcess|] wrapped wrapper   consE <- runQ [e|(:|)|]   pure (AppE conc (InfixE (Just hseg) consE (Just (ListE segs))))+  where+    wrapped (wrap, unwrap) = do+      [e|exonProcessWith ($wrap) $(unwrap)|]  quoteExp ::   QOrIO m =>+  Bool ->+  Bool ->   String ->   m Exp quoteExp =-  quoteExpWith [t|ExonDefault|]+  quoteExpWith Nothing --- |Constructor for a quasiquoter for an arbitrary tag.+quoteSegments ::+  QOrIO m =>+  String ->+  m Exp+quoteSegments code = do+  raw <- segmentsQ True code+  hseg :| segs <- reifySegments False raw+  consE <- runQ [e|(:|)|]+  pure (InfixE (Just hseg) consE (Just (ListE segs)))++-- |Constructor for a quasiquoter that wraps all segments with the first expression and unwraps the result with the+-- second. ----- This can be used to define quoters with custom logic, requiring an instance of 'Exon.Class.Exon' for the given type:+-- This can be used to define quoters with custom logic by providing instances of any of the classes in+-- "Exon.Class.Exon" with the result type argument set to the wrapper type: ----- >>> import Exon.Class.Exon (Exon(..))+-- >>> import Exon.Class.Exon (ExonString (..)) -- >>> 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|]+-- >>> import qualified Data.Text.Lazy.Builder as Text+-- >>> newtype Nl = Nl Text deriving (Generic)+-- >>> getNl (Nl t) = t+-- >>> instance ExonString Nl Text.Builder where exonWhitespace _ = exonString @Nl "\n"+-- >>> exonnl = exonWith (Just ([e|Nl|], [e|getNl|])) True False -- >>> [exonnl|one   two     three|] -- "one\ntwo\nthree" -- -- @since 0.2.0.0-exonWith :: Q TH.Type -> QuasiQuoter-exonWith tag =-  QuasiQuoter (quoteExpWith tag) (err "pattern") (err "type") (err "decl")+exonWith ::+  Maybe (Q TH.Exp, Q TH.Exp) ->+  Bool ->+  Bool ->+  QuasiQuoter+exonWith wrapper whitespace unsafe =+  QuasiQuoter (quoteExpWith wrapper whitespace unsafe) (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.+-- |A quasiquoter that allows interpolation, concatenating the resulting segments with '(<>)' or a an arbitrary+-- user-defined implementation.+-- See the [introduction]("Exon") for details. ----- >>> [exon|write #{show @Text (5 :: Int)} lines of code|] :: Text+-- >>> [exon|write #{show (5 :: Int)} lines of ##{"code" :: ByteString}|] :: Text -- "write 5 lines of code"------ The default implementation for any non-stringly type uses 'IsString' to construct the literal segments and 'mappend'--- to combine them, ignoring whitespace segments.+exon :: QuasiQuoter+exon =+  exonWith Nothing False False++-- |Unsafe version of 'exon', allowing automatic conversion with the same splice brackets as matching types. ----- >>> newtype Part = Part Text deriving newtype (Show, Semigroup, Monoid, IsString)+-- @since 1.0.0.0+exun :: QuasiQuoter+exun =+  exonWith Nothing False True++-- |A variant of 'exon' that ignores all literal whitespace in the quote (not in interpolated expressions). ----- >>> [exon|x #{Part "y"}z|] :: Part--- "xyz"+-- > [intron|x|] === skipWs [exonws|x|] ----- This behavior can be customized by writing an instance of 'Exon.Exon'.-exon :: QuasiQuoter-exon =-  exonWith [t|ExonDefault|]+-- @since 1.0.0.0+intron :: QuasiQuoter+intron =+  exonWith (Just ([e|SkipWs|], [e|skipWs|])) True False --- |A variant of 'exon' that always keeps whitespace verbatim.+-- |A variant of 'exon' that creates segments for each sequence of whitespace characters that can be processed+-- differently by 'Exon.ExonAppend', 'Exon.ExonSegment' or 'Exon.ExonString'. ----- @since 0.2.0.0+-- @since 1.0.0.0 exonws :: QuasiQuoter exonws =-  exonWith [t|KeepWhitespace|]+  exonWith Nothing True False++-- |Internal debugging quoter that produces the raw segments.+--+-- @since 1.0.0.0+exonSegments :: QuasiQuoter+exonSegments =+  QuasiQuoter quoteSegments (err "pattern") (err "type") (err "decl")+  where+    err :: String -> String -> Q a+    err tpe _ =+      exonError ("Cannot quote " <> tpe)

@@ -3,10 +3,10 @@ import Data.Text (toUpper) import Hedgehog (TestT, (===)) -import Exon.Class.Exon (Exon(..), ExonDefault)+import Exon.Class.Exon (ExonSegment (exonSegment), SkipWs (SkipWs), skipWs)+import Exon.Data.Result (Result (Result)) import qualified Exon.Data.Segment as Segment-import Exon.Quote (exon)-import Exon.Data.Result (Result(Result))+import Exon.Quote (exon, exonws, intron)  newtype Mon =   Mon String@@ -38,26 +38,26 @@  test_basic :: TestT IO () test_basic = do-  Mon "fooandbar" === [exon|foo+  Mon "fooandbar" === [intron|foo     #{var} bar|]   "foo and \\#{bar}" === ([exon|foo #{var} \#{bar}|] :: Text)-  "Philip | J. | FRY" === [exon|Philip J. #{up lastName}|]+  "Philip | J. | FRY" === [intron|Philip J. #{up lastName}|]+  "Philip | J. | FRY" === skipWs [exonws|Philip J. #{SkipWs (up lastName)}|]+  "Philip J. | FRY" === [exon|Philip J.#{up lastName}|]+  ("abc" :: Text) === skipWs [exonws|a  ##{"b" :: Text} #{"c"}|]   where     var :: IsString a => a     var =       "and" -newtype Thing = Thing String deriving newtype (IsString, Semigroup, Monoid, Show, Eq)+newtype Thing = Thing String deriving stock (Generic) deriving newtype (IsString, Show, Eq) -instance Exon ExonDefault Thing where-  convertSegment = \case-    Segment.String s -> Result (Thing s)+instance ExonSegment Thing String where+  exonSegment = \case+    Segment.String s -> Result s     Segment.Expression thing -> Result thing-    Segment.Whitespace _ -> Result (Thing " >>> ")--  insertWhitespace s1 ws s2 =-    appendSegment @ExonDefault (appendSegment @ExonDefault s1 (Segment.Whitespace ws)) s2+    Segment.Whitespace _ -> Result " >>> "  test_customWhitespace :: TestT IO () test_customWhitespace =-  Thing "1 >>> 2 >>> 3" === [exon|1 #{Thing "2"}    3|]+  Thing "1 >>> 2 >>> 3" === [exonws|1 #{Thing "2"}    3|]

@@ -0,0 +1,33 @@+module Exon.Test.BuildTest where++import Hedgehog (TestT, (===))++import Exon.Class.Exon (SkipWs (SkipWs), exonProcess, exonProcessWith, skipWs)+import Exon.Class.ToSegment (toSegment)+import Exon.Data.Segment (Segment (Expression, Whitespace))++newtype Str =+  Str String+  deriving stock (Eq, Show)+  deriving newtype (IsString, Semigroup, Monoid)++segments ::+  IsString a =>+  NonEmpty (Segment a)+segments =+  [+    Whitespace " ",+    "pre",+    Whitespace " ",+    Expression (toSegment "exp"),+    Whitespace "  ",+    "post",+    Whitespace " "+  ]++test_build :: TestT IO ()+test_build = do+  " pre exp  post " === exonProcess @Text segments+  "preexppost" === exonProcessWith @(SkipWs Text) SkipWs skipWs segments+  " pre exp  post " === exonProcess @Str segments+  "preexppost" === exonProcessWith @(SkipWs Str) SkipWs skipWs segments

@@ -1,21 +0,0 @@-module Exon.Test.KeepWsTest where--import Hedgehog (TestT, (===))--import Exon.Quote (exon, exonws)--newtype Mon =-  Mon String-  deriving stock (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"

@@ -0,0 +1,57 @@+module Exon.Test.NewtypeTest where++import Hedgehog (TestT, (===))++import Exon.Class.Exon (exonUse, skipWs)+import Exon.Quote (exon, exonws, exun)++newtype Nt =+  Nt Text+  deriving stock (Eq, Show, Generic)++newtype Str =+  Str Text+  deriving stock (Eq, Show)+  deriving newtype (IsString, Semigroup, Monoid)++newtype StrGen =+  StrGen Text+  deriving stock (Eq, Show, Generic)+  deriving newtype (IsString)++newtype BS =+  BS ByteString+  deriving stock (Eq, Show, Generic)+  deriving newtype (IsString)++newtype StrUse =+  StrUse StrGen+  deriving stock (Eq, Show, Generic)+  deriving newtype (IsString)++instance Semigroup StrUse where+  StrUse (StrGen l) <> StrUse (StrGen r) =+    StrUse (StrGen (l <> "|" <> r))++instance Monoid StrUse where+  mempty =+    StrUse (StrGen "")++nt :: Nt+nt =+  Nt "nt"++test_newtype :: TestT IO ()+test_newtype = do+  ("pre nt Text" :: Text) === [exon|pre ##{nt} #{"Text" :: Text}|]+  ("pre nt Nt \"nt\"" :: Text) === [exon|pre ##{nt} #{show nt}|]+  ("pre nt Nt \"nt\" IsString" :: Text) === [exon|pre ##{nt} #{show nt} #{"IsString"}|]+  ("pre nt Nt \"nt\" IsString Text" :: Text) === [exon|pre ##{nt} #{show nt} #{"IsString"} #{"Text" :: Text}|]+  ("pre nt Nt \"nt\" Text Str" :: Str) === [exon|pre ##{nt} #{show nt} ##{"Text" :: Text} #{"Str" :: Str}|]+  ("pre nt Nt \"nt\" Text Str" :: StrGen) === [exon|pre ##{nt} #{show nt} ##{"Text" :: Text} #{"Str" :: StrGen}|]+  ("pre BS IsString ByteString" :: ByteString) === [exon|pre ##{"BS" :: BS} #{"IsString"} #{"ByteString" :: ByteString}|]+  ("pre BS IsString LByteString" :: Str) === [exon|pre ##{"BS" :: BS} #{"IsString"} ##{"LByteString" :: LByteString}|]+  ("pre BS IsString LByteString" :: Str) === [exun|pre #{"BS" :: BS} #{"IsString"} #{"LByteString" :: LByteString}|]+  ("pre|post" :: StrUse) === exonUse (skipWs [exonws|pre ##{"post" :: Text}|])+  ("prepost" :: StrUse) === skipWs [exonws|pre ##{"post" :: Text}|]+  ("pre post" :: Str) === [exon|pre ##{StrUse "post"}|]

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

@@ -1,8 +1,10 @@ module Main where  import Exon.Test.BasicTest (test_basic, test_customWhitespace)-import Exon.Test.KeepWsTest (test_keepWs)+import Exon.Test.BuildTest (test_build)+import Exon.Test.NewtypeTest (test_newtype) import Exon.Test.ShowsPrecTest (test_showsPrec)+import Exon.Test.SkipWsTest (test_skipWs) import Hedgehog (TestT, property, test, withTests) import Test.Tasty (TestName, TestTree, defaultMain, testGroup) import Test.Tasty.Hedgehog (testProperty)@@ -17,10 +19,12 @@ tests :: TestTree tests =   testGroup "all" [+    unitTest "build" test_build,     unitTest "basic" test_basic,     unitTest "custom whitespace handling" test_customWhitespace,     unitTest "concat showsPrec fragments" test_showsPrec,-    unitTest "keep whitespace quoter" test_keepWs+    unitTest "skip whitespace quoter" test_skipWs,+    unitTest "segment newtype conversion" test_newtype   ]  main :: IO ()