exon 1.1.0.0 → 1.2.0.0

raw patch · 12 files changed

+127/−74 lines, 12 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• changelog.md +7/−0
• exon.cabal +2/−1
• lib/Exon.hs +4/−3
• lib/Exon/Class/Exon.hs +56/−49
• lib/Exon/Class/Newtype.hs +1/−1
• lib/Exon/Data/Result.hs +2/−2
• lib/Exon/Quote.hs +1/−10
• lib/Exon/SkipWs.hs +42/−0
• test/Exon/Test/BasicTest.hs +6/−5
• test/Exon/Test/BuildTest.hs +2/−1
• test/Exon/Test/NewtypeTest.hs +2/−1
• test/Exon/Test/SkipWsTest.hs +2/−1

@@ -1,3 +1,10 @@+# 1.2.0.0++* Add class `ExonExpression`, allowing customization of how interpolated expressions are converted to builders.+  The method `exonExpression` is provided with the function `exonBuilder` as an argument to avoid having to depend on+  the class manually.+* Change multi-method classes to use the default-method implementation style for the overlappable instance.+ # 1.1.0.0  * Add `exonConcat` to `ExonAppend`. The function is pulled out of `exonBuild` to allow using a different way of folding

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           exon-version:        1.1.0.0+version:        1.2.0.0 synopsis:       Customizable Quasiquote Interpolation description:    See https://hackage.haskell.org/package/exon/docs/Exon.html category:       String@@ -38,6 +38,7 @@       Exon.Generic       Exon.Parse       Exon.Quote+      Exon.SkipWs   hs-source-dirs:       lib   default-extensions:

@@ -24,6 +24,7 @@   ExonSegment (..),   ExonBuilder (..),   ExonString (..),+  ExonExpression (..),   ToSegment (..),   SkipWs (..),   skipWs,@@ -45,17 +46,17 @@   ExonAppend (..),   ExonBuild (..),   ExonBuilder (..),+  ExonExpression (..),   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, exun, intron, exonws)+import Exon.Quote (exon, exonWith, exonws, exun)+import Exon.SkipWs (SkipWs (..), intron, skipWs)  {- $intro This Haskell library provides quasiquote string interpolation with customizable concatenation for arbitrary types.

@@ -12,21 +12,6 @@ import qualified Exon.Data.Segment as Segment import Exon.Data.Segment (Segment) --- |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)---- |Defined separately because TH chokes on the selector.------ @since 1.0.0.0-skipWs :: SkipWs a -> a-skipWs (SkipWs a) =-  a- -- |Wrapping a quote type with this causes @a@ to be used irrespective of whether it is an unwrappable newtype. -- -- @since 1.0.0.0@@ -45,20 +30,28 @@   -- |Construct a builder from the newtype-unwrapped result type.   exonBuilder :: inner -> builder -  -- |Convert the result of the builder concatenation back to the newtype-unwrapped result type.-  exonBuilderExtract :: Result builder -> inner--instance {-# overlappable #-} (-    Monoid builder,-    result ~ builder-  ) => ExonBuilder result builder where+  default exonBuilder :: inner ~ builder => inner -> builder   exonBuilder =     id   {-# inline exonBuilder #-}++  -- |Convert the result of the builder concatenation back to the newtype-unwrapped result type.+  exonBuilderExtract :: Result builder -> inner++  default exonBuilderExtract ::+    Monoid builder =>+    inner ~ builder =>+    Result builder ->+    inner   exonBuilderExtract =     fold   {-# inline exonBuilderExtract #-} +instance {-# overlappable #-} (+    Monoid builder,+    inner ~ builder+  ) => ExonBuilder inner builder where+ instance (     ExonBuilder a builder   ) => ExonBuilder (ExonUse a) builder where@@ -78,20 +71,26 @@ instance ExonBuilder LText Text.Builder where   exonBuilder =     Text.fromLazyText+  {-# inline exonBuilder #-}   exonBuilderExtract =     foldMap toLazyText+  {-# inline exonBuilderExtract #-}  instance ExonBuilder ByteString ByteString.Builder where   exonBuilder =     ByteString.byteString+  {-# inline exonBuilder #-}   exonBuilderExtract =     foldMap (toStrict . toLazyByteString)+  {-# inline exonBuilderExtract #-}  instance ExonBuilder LByteString ByteString.Builder where   exonBuilder =     ByteString.lazyByteString+  {-# inline exonBuilder #-}   exonBuilderExtract =     foldMap toLazyByteString+  {-# inline exonBuilderExtract #-}  -- |This class generalizes 'IsString' for use in 'ExonSegment'. --@@ -128,41 +127,47 @@     Result . showString   {-# inline exonString #-} --- |The instance used when the result type is wrapped in 'SkipWs', which is done by 'Exon.intron'.+-- |This class allows manipulation of interpolated expressions before they are processed, for example to replace empty+-- strings with 'Empty' for the purpose of collapsing multiple whitespaces. ----- It returns 'Empty' for any whitespace.-instance (-    IsString builder-  ) => ExonString (SkipWs result) builder where-  exonWhitespace _ =-    Empty-  {-# inline exonWhitespace #-}+-- The default instance does nothing.+class ExonExpression (result :: Type) (inner :: Type) (builder :: Type) where+  -- |Process a builder value constructed from an expression before concatenation.+  exonExpression :: (inner -> builder) -> inner -> Result builder+  exonExpression builder =+    Result . builder+  {-# inline exonExpression #-} +instance {-# overlappable #-} ExonExpression result inner builder where+ -- |This class converts a 'Segment' to a builder. ----- The default implementation performs the following conversions for the differnet segment variants:+-- The default implementation performs the following conversions for the different 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.Whitespace]('Segment.Whitespace') is ignored when the quoter 'Exon.intron' was used (default behaviour of+-- 'ExonString'). ----- - [Segment.Expression]('Segment.Expression') contains a value of the builder type, which is returned as-is.+-- - [Segment.Expression]('Segment.Expression') contains a value of the unwrapped type and is converted to a builder+-- using the function in the first argument, which is usually 'exonBuilder', supplied by 'exonBuild'. -- -- @since 1.0.0.0-class ExonSegment (result :: Type) (builder :: Type) where+class ExonSegment (result :: Type) (inner :: Type) (builder :: Type) where   -- |Convert literal string segments to the result type.-  exonSegment :: Segment builder -> Result builder+  exonSegment :: (inner -> builder) -> Segment inner -> Result builder  instance {-# overlappable #-} (-    ExonString result builder-  ) => ExonSegment result builder where-    exonSegment = \case+    ExonString result builder,+    ExonExpression result inner builder+  ) => ExonSegment result inner builder where+    exonSegment builder = \case       Segment.String a ->         exonString @result a       Segment.Expression a ->-        Result a+        exonExpression @result builder a       Segment.Whitespace a ->         exonWhitespace @result a     {-# inline exonSegment #-}@@ -177,6 +182,11 @@   -- |Concatenate two segments of the builder type.   exonAppend :: builder -> builder -> Result builder +  default exonAppend :: Semigroup builder => builder -> builder -> Result builder+  exonAppend z a =+    Result (z <> a)+  {-# inline exonAppend #-}+   -- |Concatenate a list of segments of the result type.   --   -- Folds the list over 'exonAppend', skipping over 'Empty' segments.@@ -196,9 +206,6 @@ instance {-# overlappable #-} (     Semigroup builder   ) => ExonAppend result builder where-  exonAppend z a =-    Result (z <> a)-  {-# inline exonAppend #-}  instance ExonAppend result (String -> String) where   exonAppend z a =@@ -207,12 +214,12 @@  -- |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'.+-- 1. Each 'Segment' is converted to the builder type by 'ExonSegment' using 'exonBuilder' to construct the builder from+--    expressions.+-- 2. The segments are folded over 'ExonAppend'.+-- 3. The result is converted from the builder type to the original type by 'ExonBuilder'. ----- Each step may be overridden individually+-- Each step may be overridden individually by writing overlapping instances for the involved classes. -- -- @since 1.0.0.0 class ExonBuild (result :: Type) (inner :: Type) where@@ -221,13 +228,13 @@  instance {-# overlappable #-} (     ExonAppend result builder,-    ExonSegment result builder,+    ExonSegment result inner builder,     ExonBuilder inner builder   ) => ExonBuild result inner where   exonBuild =     exonBuilderExtract .     exonConcat @result .-    fmap (exonSegment @result . fmap exonBuilder)+    fmap (exonSegment @result exonBuilder)   {-# inline exonBuild #-}  -- |This class is the main entry point for Exon.

@@ -15,7 +15,7 @@     OverNewtype wrapped next inner   ) => OverNewtype current ('Just wrapped) inner where     overNewtype f segments =-      unsafeCoerce (overNewtype @wrapped @next @inner f (fmap unsafeCoerce <$> segments))+      unsafeCoerce (overNewtype @wrapped @next @inner f (unsafeCoerce segments))     {-# inline overNewtype #-}  instance OverNewtype current 'Nothing current where

@@ -13,6 +13,6 @@   (<>) a Empty = a   (<>) (Result l) (Result r) = Result (l <> r) -instance Monoid a => Monoid (Result a) where+instance Semigroup (Result a) => Monoid (Result a) where   mempty =-    Result mempty+    Empty

@@ -9,7 +9,7 @@ import Language.Haskell.TH.Quote (QuasiQuoter (QuasiQuoter)) import Language.Haskell.TH.Syntax (Quasi) -import Exon.Class.Exon (SkipWs (SkipWs), exonProcess, exonProcessWith, skipWs)+import Exon.Class.Exon (exonProcess, exonProcessWith) import Exon.Class.ToSegment (toSegment) import Exon.Data.RawSegment (RawSegment (AutoExpSegment, ExpSegment, StringSegment, WsSegment)) import qualified Exon.Data.Segment as Segment@@ -161,15 +161,6 @@ exun :: QuasiQuoter exun =   exonWith Nothing False True---- |A variant of 'exon' that ignores all literal whitespace in the quote (not in interpolated expressions).------ > [intron|x|] === skipWs [exonws|x|]------ @since 1.0.0.0-intron :: QuasiQuoter-intron =-  exonWith (Just ([e|SkipWs|], [e|skipWs|])) True False  -- |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'.

@@ -0,0 +1,42 @@+-- |Whitespace skipping quoter, internal+module Exon.SkipWs where++import Language.Haskell.TH.Quote (QuasiQuoter)++import Exon.Class.Exon (ExonString (exonWhitespace))+import Exon.Data.Result (Result (Empty))+import Exon.Quote (exonWith)++-- |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)++-- |Defined separately because TH chokes on the selector.+--+-- @since 1.0.0.0+skipWs :: SkipWs a -> a+skipWs (SkipWs a) =+  a++-- |The instance used when the result type is wrapped in 'SkipWs', which is done by 'Exon.intron'.+--+-- It returns 'Empty' for any whitespace.+instance (+    IsString builder+  ) => ExonString (SkipWs result) builder where+  exonWhitespace _ =+    Empty+  {-# inline exonWhitespace #-}++-- |A variant of 'exon' that ignores all literal whitespace in the quote (not in interpolated expressions).+--+-- > [intron|x|] === skipWs [exonws|x|]+--+-- @since 1.0.0.0+intron :: QuasiQuoter+intron =+  exonWith (Just ([e|SkipWs|], [e|skipWs|])) True False

@@ -3,10 +3,11 @@ import Data.Text (toUpper) import Hedgehog (TestT, (===)) -import Exon.Class.Exon (ExonSegment (exonSegment), SkipWs (SkipWs), skipWs)+import Exon.Class.Exon (ExonSegment (exonSegment)) import Exon.Data.Result (Result (Result)) import qualified Exon.Data.Segment as Segment-import Exon.Quote (exon, exonws, intron)+import Exon.Quote (exon, exonws)+import Exon.SkipWs (SkipWs (SkipWs), intron, skipWs)  newtype Mon =   Mon String@@ -51,10 +52,10 @@  newtype Thing = Thing String deriving stock (Generic) deriving newtype (IsString, Show, Eq) -instance ExonSegment Thing String where-  exonSegment = \case+instance ExonSegment Thing inner String where+  exonSegment builder = \case     Segment.String s -> Result s-    Segment.Expression thing -> Result thing+    Segment.Expression thing -> Result (builder thing)     Segment.Whitespace _ -> Result " >>> "  test_customWhitespace :: TestT IO ()

@@ -2,9 +2,10 @@  import Hedgehog (TestT, (===)) -import Exon.Class.Exon (SkipWs (SkipWs), exonProcess, exonProcessWith, skipWs)+import Exon.Class.Exon (exonProcess, exonProcessWith) import Exon.Class.ToSegment (toSegment) import Exon.Data.Segment (Segment (Expression, Whitespace))+import Exon.SkipWs (SkipWs (SkipWs), skipWs)  newtype Str =   Str String

@@ -2,8 +2,9 @@  import Hedgehog (TestT, (===)) -import Exon.Class.Exon (exonUse, skipWs)+import Exon.Class.Exon (exonUse) import Exon.Quote (exon, exonws, exun)+import Exon.SkipWs (skipWs)  newtype Nt =   Nt Text

@@ -2,7 +2,8 @@  import Hedgehog (TestT, (===)) -import Exon.Quote (exon, intron)+import Exon.Quote (exon)+import Exon.SkipWs (intron)  newtype Mon =   Mon String