eventuo11y-dsl 0.1.0.0 → 0.2.0.0

raw patch · 4 files changed

+55/−24 lines, 4 filesdep −th-compatdep ~basedep ~template-haskellPVP ok

version bump matches the API change (PVP)

Dependencies removed: th-compat

Dependency ranges changed: base, template-haskell

API changes (from Hackage documentation)

Files

• CHANGELOG.md +4/−0
• eventuo11y-dsl.cabal +4/−5
• src/Observe/Event/DSL.hs +30/−10
• src/Observe/Event/DSL/Compile.hs +17/−9

@@ -1,5 +1,9 @@ # Revision history for eventuo11y-dsl +## 0.2.0.0 -- 2022-12-23++- Alias `AnyQuote` to `Q` in old `template-haskell` for direct `[t|Foo|]` syntax+ ## 0.1.0.0 -- 2022-10-23  Initial release

@@ -1,6 +1,6 @@ cabal-version:      3.0 name:               eventuo11y-dsl-version:            0.1.0.0+version:            0.2.0.0 synopsis:           DSL for defining eventuo11y fields and selectors description:   Exposes a DSL for low-boilerplate definition of [eventuo11y](https://hackage.haskell.org/package/eventuo11y) fields and selectors.@@ -9,7 +9,7 @@    See "Observe.Event.DSL.Compile" for the TemplateHaskell code to generate the field and selector types. -  See [Example.hs](https://github.com/shlevy/eventuo11y/tree/v0.5.0.0/Example.hs) for an example.+  See [Example.hs](https://github.com/shlevy/eventuo11y/tree/v0.6.0.0/Example.hs) for an example.    Packages providing @EventBackend@s should likely also provide extensions to the DSL and generate default renderers. @@ -34,9 +34,8 @@     Observe.Event.Syntax    build-depends:-    , base              ^>= { 4.14, 4.16 }-    , template-haskell  ^>= { 2.16, 2.18 }-    , th-compat         ^>= 0.1.4+    , base              ^>= { 4.14, 4.16, 4.17 }+    , template-haskell  ^>= { 2.16, 2.18, 2.19 }    hs-source-dirs:   src   default-language: Haskell2010

@@ -6,6 +6,9 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+-- Duplication due to compatibility for AnyQuote+{-# OPTIONS_GHC -Wno-duplicate-exports #-}  -- | -- Description : DSL for generating 'Observe.Event.Event' fields and selectors@@ -17,7 +20,7 @@ -- -- Typical entrypoint is 'SelectorSpec'. ----- See [Example.hs](https://github.com/shlevy/eventuo11y/tree/v0.5.0.0/Example.hs) for an idiomatic example.+-- See [Example.hs](https://github.com/shlevy/eventuo11y/tree/v0.6.0.0/Example.hs) for an idiomatic example. -- -- See "Observe.Event.DSL.Compile" to compile this into the relevant types. module Observe.Event.DSL@@ -35,6 +38,7 @@      -- ** Quote polymorphism     AnyQuote (..),+    toQuote,     AnyType,      -- ** Names@@ -47,14 +51,15 @@   ) where +#if MIN_VERSION_template_haskell(2,18,0) import Control.Applicative+#endif import Data.Char import Data.List import Data.List.NonEmpty hiding (fromList, toList) import Data.String import GHC.Exts import Language.Haskell.TH-import Language.Haskell.TH.Syntax.Compat as THC import Observe.Event.Syntax  -- | A specification for an 'Observe.Event.Event' selector type@@ -155,12 +160,16 @@ instance (a ~ ExplodedName) => RecordField a Name FieldConstructorSpec where   k ≔ v = k ≔ ((pure $ ConT v) :| []) --- | A concrete type capturing values that can be instantiated in any--- 'THC.Quote'.-newtype AnyQuote a = AnyQuote (forall m. THC.Quote m => m a) deriving (Functor)---- | A 'Type' in any 'THC.Quote'-type AnyType = AnyQuote Type+#if MIN_VERSION_template_haskell(2,18,0)+-- | A concrete type for TH quotes that retains full 'Quote' polymorphism+--+-- Prior to @template-haskell@ @2.18@, this is just an alias for 'Q'+newtype AnyQuote a = AnyQuote+  { -- | Extract this value in a particular 'Quote' monad+    --+    -- Prior to @template-haskell@ @2.18@, this projects into 'Q'.+    toQuote :: forall m. Quote m => m a+  } deriving (Functor)  instance Applicative AnyQuote where   pure x = AnyQuote $ pure x@@ -175,8 +184,19 @@     let AnyQuote res = f x'     res -instance THC.Quote AnyQuote where-  newName s = AnyQuote $ THC.newName s+instance Quote AnyQuote where+  newName s = AnyQuote $ newName s++#else+-- | A type alias for TH quotes+type AnyQuote = Q++toQuote :: AnyQuote a -> Q a+toQuote = id+#endif++-- | A 'Type' in any 'Quote'+type AnyType = AnyQuote Type  -- | A name for some element, broken up into words. --

@@ -1,4 +1,9 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE TemplateHaskellQuotes #-}+#if ! MIN_VERSION_template_haskell(2,18,0)+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE TypeFamilies #-}+#endif  -- | -- Description : Compile the "Observe.Event.DSL" with TemplateHaskell@@ -11,11 +16,14 @@ import Data.Void import GHC.Exts import Language.Haskell.TH-import Language.Haskell.TH.Syntax.Compat as THC import Observe.Event.DSL +#if ! MIN_VERSION_template_haskell(2,18,0)+type Quote m = m ~ Q+#endif+ -- | Compile a 'SelectorSpec' into appropriate declarations.-compile :: (THC.Quote m) => SelectorSpec -> m [Dec]+compile :: (Quote m) => SelectorSpec -> m [Dec] compile (SelectorSpec selectorNameBase selectors) = do   (selectorCtors, defs) <- foldM stepSelectors mempty selectors   let selectorDef =@@ -35,8 +43,8 @@             [mkName $ upperCamel nm]             [(Bang NoSourceUnpackedness SourceStrict, AppT (ConT t) (VarT varX))]             (AppT (ConT selectorName) (VarT varX))-    stepSelectors (selectorCtors, defs) (SelectorConstructorSpec nm (SimpleType (AnyQuote mt))) = do-      t <- mt+    stepSelectors (selectorCtors, defs) (SelectorConstructorSpec nm (SimpleType mt)) = do+      t <- toQuote mt       let ctor = GadtC [mkName $ upperCamel nm] [] (AppT (ConT selectorName) t)       pure (ctor : selectorCtors, defs)     stepSelectors (selectorCtors, defs) (SelectorConstructorSpec nm (Specified fieldSpec)) = do@@ -44,7 +52,7 @@       let ctor = GadtC [mkName $ upperCamel nm] [] (AppT (ConT selectorName) (ConT fieldName))       pure (ctor : selectorCtors, fieldDef : defs) -compileFieldSpec :: (THC.Quote m) => FieldSpec -> m (Name, Dec)+compileFieldSpec :: (Quote m) => FieldSpec -> m (Name, Dec) compileFieldSpec (FieldSpec fieldNameBase fields) = do   ctors <- mapM fieldCtor fields   pure@@ -52,13 +60,13 @@       DataD [] fieldName [] Nothing ctors []     )   where-    makeBangType (AnyQuote mt) = do-      t <- mt+    makeBangType mt = do+      t <- toQuote mt       pure (Bang NoSourceUnpackedness SourceStrict, t)      fieldCtor (FieldConstructorSpec nm ts) = do-      let AnyQuote margs = toList <$> mapM makeBangType ts-      args <- margs+      let margs = toList <$> mapM makeBangType ts+      args <- toQuote margs       pure $ NormalC (mkName $ upperCamel nm) args      fieldName = mkName $ upperCamel fieldNameBase <> "Field"