type-of-html 1.5.1.0 → 1.5.2.0
raw patch · 7 files changed
+93/−10 lines, 7 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
+ Html.Attribute: custom_ :: a -> 'CustomA b := a
+ Html.Type: CustomA :: Symbol -> Attribute
Files
- ChangeLog.md +5/−0
- Readme.md +30/−3
- src/Html/Attribute.hs +21/−0
- src/Html/Type/Internal.hs +14/−5
- test/Custom.hs +11/−0
- test/Value.hs +7/−0
- type-of-html.cabal +5/−2
ChangeLog.md view
@@ -1,5 +1,10 @@ # Revision history for type-of-html +## 1.5.2.0 -- 2020-10-10++* make error messages nicer+* allow custom attributes+ ## 1.5.1.0 -- 2020-01-18 * improve compile times and run times for big pages
Readme.md view
@@ -19,12 +19,12 @@ >>> td_ (tr_ "a") <interactive>:1:1: error:- • 'Tr is not a valid child of 'Td+ • <tr> is not a valid child of <td> • In the expression: td_ (tr_ "a") In an equation for ‘it’: it = td_ (tr_ "a") <interactive>:1:6: error:- • 'Tr can't contain a string+ • <tr> can't contain a string • In the first argument of ‘td_’, namely ‘(tr_ "a")’ In the expression: td_ (tr_ "a") In an equation for ‘it’: it = td_ (tr_ "a")@@ -39,7 +39,7 @@ >>> td_A (A.coords_ "a") "b" <interactive>:1:1: error:- • 'CoordsA is not a valid attribute of 'Td+ • coords is not a valid attribute of <td> • In the expression: td_A (A.coords_ "a") "b" In an equation for ‘it’: it = td_A (A.coords_ "a") "b" @@ -393,6 +393,33 @@ ) ) ```++## Custom Attributes++You can define your own attributes, for example data-* or htmx. These+custom attributes reside as well 100% at the type level and don't+incur any performance penalty. Beware that it is up to you to choose a+valid attribute name.++```haskell+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeOperators #-}++module Main where++import Html+import qualified Html.Attribute as A++dataName_ :: a -> 'CustomA "data-name" := a+dataName_ = A.custom_++main :: IO ()+main = print $ div_A (dataName_ "foo") "bar"+```++I'd recommend that you put all your custom attributes in one module+which reexports Html.Attribute, so you can just qualified import your+module and have an uniform naming scheme. ## FAQ
src/Html/Attribute.hs view
@@ -494,5 +494,26 @@ wrap_ :: a -> 'WrapA := a wrap_ = AT +-- | Escape hatch for defining non standard attributes. Note that it's+-- your responsibility to choose valid attribute names, these are at+-- the moment not checked. These custom attributes don't carry any+-- performance penalty, they are fused at compiletime just as much as+-- standard attributes.+--+-- @+-- {-\# LANGUAGE DataKinds \#-}+-- {-\# LANGUAGE TypeOperators \#-}+-- import Html+-- import qualified Html.Attribute as A+--+-- dataName_ :: a -> 'CustomA "data-name" := a+-- dataName_ = A.custom_+-- @+--+-- >>> div_A (dataName_ "foo") "bar"+-- <div data-name="foo">bar</div>+custom_ :: a -> 'CustomA b := a+custom_ = AT+ addAttributes :: (a <?> (b # b')) c => b' -> (a :@: b) c -> (a :@: (b # b')) c addAttributes b' (WithAttributes b c) = WithAttributes (b # b') c
src/Html/Type/Internal.hs view
@@ -415,6 +415,8 @@ | WidthA | WrapA + | CustomA Symbol+ -- | We need efficient cons, snoc and append. This API has cons(O1) -- and snoc(O1) but append(On). Optimal would be a FingerTree. data List = List [Symbol] Symbol@@ -455,20 +457,26 @@ -- | Check whether `a` is a valid attribute and `b` is a valid child of `p`. type (<?>) p a b = (Check Attribute p a, Check Element p b) +type TextE a = Text (EInfoName (GetEInfo a))+type TextA a = Text (AInfoName (GetAInfo a))+type TagE a = Text "<" :<>: TextE a :<>: Text ">"+ type family Check f a b :: Constraint where Check _ _ () = () Check _ _ (Raw _) = () Check f a (b # c) = (Check f a b, Check f a c) Check f a (Maybe b) = Check f a b Check f a (Either b c) = (Check f a b, Check f a c)- Check f a (b -> c) = TypeError (ShowType a :<>: Text " can't contain a function.")+-- Check f a (b -> c) = TypeError (ShowType a :<>: Text " can't contain a function.")+ Check f a (b -> c) = TypeError (TagE a :<>: Text " can't contain a function.") Check Element a ((b :@: _) _) = MaybeTypeError a b (CheckContentCategory (EInfoContent (GetEInfo a)) (SingleElement b ': EInfoCategories (GetEInfo b))) Check Element a (f ((b :@: c) d)) = Check Element a ((b :@: c) d) Check Element a (f (b # c)) = Check Element a (b # c)+ Check Element a (b := c) = TypeError (TagE a :<>: Text " can't contain an attribute." :$$: Text "Try '" :<>: TextE a :<>: Text "_A' instead.") Check Element a b = CheckString a b Check Attribute a (b := _) = If (Elem a (AInfoElements (GetAInfo b)) || Null (AInfoElements (GetAInfo b))) (() :: Constraint)- (TypeError (ShowType b :<>: Text " is not a valid attribute of " :<>: ShowType a))+ (TypeError (TextA b :<>: Text " is not a valid attribute of " :<>: TagE a :<>: Text ".")) Check Attribute _ b = TypeError (ShowType b :<>: Text " is not an attribute.") -- | Combine two elements or attributes sequentially.@@ -606,7 +614,7 @@ type family CheckString (a :: Element) b where CheckString a b = If (CheckContentCategory (EInfoContent (GetEInfo a)) '[OnlyText, FlowContent, PhrasingContent]) (() :: Constraint)- (TypeError (ShowType a :<>: Text " can't contain a " :<>: ShowType b))+ (TypeError (TagE a :<>: Text " can't contain a " :<>: ShowType b)) -- | Content categories according to the html spec. data ContentCategory@@ -627,7 +635,7 @@ type family MaybeTypeError (a :: Element) (b :: Element) c where MaybeTypeError a b c = If c (() :: Constraint)- (TypeError (ShowType b :<>: Text " is not a valid child of " :<>: ShowType a))+ (TypeError (TagE b :<>: Text " is not a valid child of " :<>: TagE a :<>: Text ".")) type family Elem (a :: k) (xs :: [k]) where Elem a (a : xs) = True@@ -642,7 +650,7 @@ type family AInfoName x where AInfoName (AInfo s _) = s -- | Get type list of valid elements for a given attribute. An empty list signifies global attribute.-type family GetAInfo a = r | r -> a where+type family GetAInfo a where GetAInfo RoleA = AInfo "role" '[] GetAInfo AriaActivedescendantA = AInfo "aria-activedescendant" '[]@@ -808,6 +816,7 @@ GetAInfo ValueA = AInfo "value" '[Button, Option, Input, Li, Meter, Progress, Param, Data] GetAInfo WidthA = AInfo "width" '[Canvas, Embed, Iframe, Img, Input, Object, Video] GetAInfo WrapA = AInfo "wrap" '[Textarea]+ GetAInfo (CustomA x) = AInfo x '[] -- | Retrieve type level meta data about elements. type family GetEInfo a = r | r -> a where
+ test/Custom.hs view
@@ -0,0 +1,11 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeOperators #-}++module Custom where++import Html++import qualified Html.Attribute as A++hxPost_ :: a -> 'CustomA "hx-post" := a+hxPost_ = A.custom_
test/Value.hs view
@@ -12,6 +12,7 @@ import Data.Proxy import Test.Hspec import Test.QuickCheck+import Custom main :: IO () main = hspec spec@@ -230,6 +231,12 @@ renderString (div_A A.hidden_ () # img_) `shouldBe` "<div hidden></div><img>"++ it "handles custom attributes" $ do++ renderString (div_A (hxPost_ "x") "y")+ `shouldBe`+ "<div hx-post=\"x\">y</div>" it "handles Ints" $ do
type-of-html.cabal view
@@ -1,5 +1,5 @@ name: type-of-html-version: 1.5.1.0+version: 1.5.2.0 synopsis: High performance type driven html generation. description: This library makes most invalid html documents compile time errors and uses advanced type level features to realise compile time computations. license: BSD3@@ -7,7 +7,9 @@ author: Florian Knupfer maintainer: fknupfer@gmail.com homepage: https://github.com/knupfer/type-of-html-tested-with: GHC == 8.6.5+tested-with: GHC == 8.10.2+ , GHC == 8.8.4+ , GHC == 8.6.5 , GHC == 8.6.4 , GHC == 8.4.4 , GHC == 8.4.3@@ -45,6 +47,7 @@ type: exitcode-stdio-1.0 main-is: Value.hs hs-source-dirs: test+ other-modules: Custom ghc-options: -Wall -O0 default-language: Haskell2010 build-depends: base >= 4.10 && <= 5