miso-css (empty) → 0.0.1
raw patch · 41 files changed
+3538/−0 lines, 41 filesdep +QuickCheckdep +add-dependent-filedep +base
Dependencies added: QuickCheck, add-dependent-file, base, bytestring, containers, css-parser, filepath, miso, miso-css, mtl, tagged, tasty, tasty-discover, tasty-hunit, tasty-quickcheck, template-haskell, text
Files
- LICENSE +32/−0
- changelog.md +4/−0
- miso-css.cabal +521/−0
- src/Miso/Css.hs +19/−0
- src/Miso/Css/Escape.hs +48/−0
- src/Miso/Css/Event.hs +42/−0
- src/Miso/Css/Gen.hs +256/−0
- src/Miso/Css/IncludeCss.hs +18/−0
- src/Miso/Css/List.hs +49/−0
- src/Miso/Css/Miso.hs +145/−0
- src/Miso/Css/Operator.hs +114/−0
- src/Miso/Css/Parser.hs +91/−0
- src/Miso/Css/Prelude.hs +15/−0
- src/Miso/Css/Qq.hs +97/−0
- src/Miso/Css/Segment.hs +150/−0
- src/Miso/Css/Sibling.hs +64/−0
- src/Miso/Css/Style.hs +13/−0
- src/Miso/Css/Style/AncestorConstraint.hs +22/−0
- src/Miso/Css/Style/E.hs +197/−0
- src/Miso/Css/Style/OrClass.hs +14/−0
- src/Miso/Css/Style/PostAppend.hs +103/−0
- src/Miso/Css/Style/PreAppend.hs +75/−0
- src/Miso/Css/Tags.hs +94/−0
- test/Discovery.hs +1/−0
- test/Driver.hs +13/−0
- test/Miso/Css/Test/BindEventHandlers.hs +11/−0
- test/Miso/Css/Test/HelloWorld.hs +43/−0
- test/Miso/Css/Test/IncludeCssAsserts.hs +24/−0
- test/Miso/Css/Test/Prelude.hs +17/−0
- test/Miso/Css/Test/QqAsserts.hs +38/−0
- test/Miso/Css/Test/Style.hs +510/−0
- test/Miso/Css/Test/StyleMock.hs +527/−0
- test/Miso/Css/Test/Th/AmoreBmoreC.hs +9/−0
- test/Miso/Css/Test/Th/AplusBplusC.hs +9/−0
- test/Miso/Css/Test/Th/DivPlusPtildeSpanMoreAplusB.hs +26/−0
- test/Miso/Css/Test/Th/DotAdotB.hs +7/−0
- test/Miso/Css/Test/Th/ForkBranchOnJnMatchAfterNol.hs +54/−0
- test/Miso/Css/Test/Th/ForkBranchSibling.hs +14/−0
- test/Miso/Css/Test/Th/PmoreXplusYplusZmoreAspaceBmoreC.hs +27/−0
- test/Miso/Css/Test/Th/RootMoreA.hs +22/−0
- test/style.css +3/−0
+ LICENSE view
@@ -0,0 +1,32 @@+This module is under this "3 clause" BSD license:++Copyright (c) 2025-2025, Daniil Iaitskov+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are+met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * The names of the contributors may not be used to endorse or+ promote products derived from this software without specific+ prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ changelog.md view
@@ -0,0 +1,4 @@+# miso-css changelog++## Version 0.0.1 2026-05-30+ * init
+ miso-css.cabal view
@@ -0,0 +1,521 @@+cabal-version: 3.0+name: miso-css+version: 0.0.1++synopsis: wrapper over miso checking CSS classes applicability through dependent types+description:+ == Motivation+ #motivation#+ + __miso-css__ is an evolutionary step ahead from+ <https://github.com/yaitskov/css-class-bindings css-class-bindings>.+ + CSS class of an atomic selector can be applied to any DOM element, but+ that is not true for classes used in composite selectors. Rules with+ partially matched selectors are silently ignored by browser and this+ open a door for introducing bugs during consequent changes.+ Css-class-binding just cannot cope with such problem and miso-css uses+ dependent types to track what CSS classes can applied to HTML elements.+ + == Usage+ #usage#+ + miso-css runs a css parser to extract CSS selectors and generates+ Haskell constants for every CSS class with correspondent name that is+ found in the input. A type of such constant describes all possible ways+ the class can used in DOM.+ + Besides that the library ships __E__ type representing an HTML element+ and a set of operators for constructing tags and combining them in DOM+ tree. E is miso+ <https://hackage-content.haskell.org/package/miso/docs/Miso-Types.html#t:View VNode>+ type protected with a few type parameters.+ + === Composing tags+ #composing-tags#+ + Before jumping straight to style application lets get familiar with+ syntax for tag composition because it is different in vanilla+ <https://hackage-content.haskell.org/package/miso miso>.+ + ==== Appending a child+ #appending-a-child#+ + > div_ </ p_+ + > <div>+ > <p></p>+ > </div>+ + ==== Adding a sibling+ #adding-a-sibling#+ + > ul_ </ li_ </ li_+ + > <ul>+ > <li></li>+ > <li></li>+ > </ul>+ + ==== Appending a child to child+ #appending-a-child-to-child#+ + > body_ </ (section_ </ p_)+ + > <body>+ > <section>+ > <p></p>+ > </section>+ > </body>+ + ==== Adding CDATA+ #adding-cdata#+ + > a_ <@ "click"+ + > <a>click</a>+ + ==== Adding a raw miso DOM chunk+ #adding-a-raw-miso-dom-chunk#+ + > import Miso.Html qualified as MH+ > import Miso.Html.Property qualified as MH+ >+ > go = div_ =< MH.p_ [] [ "h" ]+ + > <div>+ > <p>h</p>+ > </div>+ + ==== Adding tag attribute+ #adding-tag-attribute#+ + > a_ =<| atr @"href" "http://link.com"+ + > <a href="http://link.com"></a>+ + ==== Binding event handler+ #binding-event-handler#+ + > button_ =! onClick YourActionDc+ + ==== Applying CSS class+ #applying-css-class#+ + > {-# LANGUAGE QuasiQuotes #-}+ > {-# OPTIONS_GHC -Wno-missing-signatures #-}+ > [css|.red { color: red; }|]+ >+ > div_ =. red+ + > <div class="red"></div>+ + ==== Adding tag ID+ #adding-tag-id#+ + Handmade tag id:+ + > div_ =# ElementId "footer"+ + Generated tag id:+ + > {-# LANGUAGE QuasiQuotes #-}+ > {-# OPTIONS_GHC -Wno-missing-signatures #-}+ > [css|#footer { color: red; }|]+ >+ > div_ =# Footer+ + > <div id="footer"></div>+ + ==== Mix all at once+ #mix-all-at-once#+ + > {-# LANGUAGE QuasiQuotes #-}+ > {-# OPTIONS_GHC -Wno-missing-signatures #-}+ > [css|.form .red { color: red; }|]+ >+ > div_ =. form =# ElementId "footer"+ > </ (a_ =. red =<| atr @"href" "/click.php?x=1"+ > </ (span_ <@ "Click me"))+ + > <div class="form" id="footer>+ > <a class="red" href="/click.php?x=1">+ > <span>Click me</span>+ > </a>+ > </div>+ + === Breaking rules+ #breaking-rules#+ + Until now all above samples must be valid and should type check. This+ section enumerates HTML snippets with ill-applied classes, expected+ errors and comments.+ + ==== There can be only one+ #there-can-be-only-one#+ + An element ID can be used once in a HTML document.+ + > div_ =# ElementId "Duncan MacLeod"+ > </ div_ =# ElementId "Duncan MacLeod"+ + > Couldn't match type: '[DuplicatedId "Duncan MacLeod"]+ > with: '[]+ + ==== Parent class is missing+ #parent-class-is-missing#+ + > [css|.a .b {}|]+ >+ > div_ =. b+ + The error message is a list of triples where first element is a list of+ not applied classes, ids (hashes), tag names or attribute names.+ + > [([C "a"], [], [])]+ + Class __a__ and __b__ are missing:+ + > [css|.a .b .c {}|]+ >+ > div_ =. c+ + > [ ([C "b"], [], [])+ > , ([C "a"], [], [])+ > ]+ + ==== B element+ #b-element#+ + When selector with a child relation is partially applied the triple+ contains B element. It is a synthetic element preventing the failed rule+ from matching later somewhere upper in DOM by an accident.+ + > [css|.a > .b {}|]+ >+ > div_ </ div_ =. b+ + > [([B, C "a"], [], [])]+ + ==== One of classes is missing+ #one-of-classes-is-missing#+ + Second element of triple is a list of applied classes. It helps to+ understand what worked out and what didn’t in a composite selector.+ + > [css|.a.b > .c {}|]+ >+ > div_ =. a </ div_ =. c+ + > [([B, C "b"], [C "a"], [])]+ + ===== Sibling is missing+ #sibling-is-missing#+ + The third element of triple explains sibling errors.+ + > [css|.a + .b {}|]+ >+ > div_ </ div_ =. b+ + Class __a__ is not applied:+ + > [([B], [], [[ [B], [C "a"]]])]+ + === Non-leaf classes constraints+ #non-leaf-classes-constraints#+ + By default non-leaf classes in selector don’t contribute to constraints.+ e.g.+ + > .a > .b .c+ + @b@ doesn’t require @a@ as immediate parent it is handled by constraints+ form @c@.+ + It is possible to generate constraints for @b@ to make checking even+ stricter, though in such mode following DOM can’t pass type check:+ + > enableRulesForNonLeafClasses+ >+ > [css|.a > .b .c {}|]+ > test_t = testGroup cssAsLiteralText+ > [ doNotTcNoBr [] [[[(JustNow, [B], [C "a"], [])]]] $+ > div_ =. a </ (div_ =. b </ (div_ =. b </ div_ =. c))+ > ]+ + === E type+ #e-type#+ + > data E+ > model+ > action+ > (en :: Symbol)+ > (es :: ElementStructure)+ > (re :: Maybe Root)+ > (ei :: Maybe Symbol)+ > (atrs :: [Symbol])+ > (knownIds :: KnownIDS)+ > (cls :: [Symbol])+ > (l :: [[[Seg]]])+ > (children :: [[SubSeg]])+ + First two parameters __model__ and __action__ are forwarded to miso+ <https://hackage-content.haskell.org/package/miso/docs/Miso-Types.html#t:View VNode>+ type.+ + ==== en - tag name+ #en---tag-name#+ + In ghci session:+ + > :t div_+ > div_+ > :: E model+ > action+ > "div"+ > ...+ + ==== es - element structure+ #es---element-structure#+ + Most often its value is __Composite__ which means that the element could+ have children. /Es/ parameter of /CDATA/ element is __Atomic__.+ + ==== re - root indicator+ #re---root-indicator#+ + It is a root tag indicator. A root tag cannot be adopted.+ + > [css|:root > .a {}|]+ + ==== ei - HTML tag hash+ #ei---html-tag-hash#+ + > div_ =# ElementId "Duncan"+ + ==== atrs - names of tag attributes+ #atrs---names-of-tag-attributes#+ + > :t a_ =# ElementId "x" =<| atr @"href" "/click.php?x=1"+ > ...+ > ["href", "id"]+ > ...+ + ==== knownIds - hashes used in tag descendants+ #knownids---hashes-used-in-tag-descendants#+ + > :t div_ =# ElementId "x" </ div_ =# ElementId "y" </ div_ =# ElementId "z"+ > ...+ > (KnownIds '[] ["x", "y", "z"])+ > ...+ + ==== cls - classes applied to tag+ #cls---classes-applied-to-tag#+ + Classes applied to children and descendants are not included.+ + > :t div_ =. a =. b </ div_ =. c+ > ...+ > ["b", "a"]+ > ...+ + ==== l - ancestor constraints+ #l---ancestor-constraints#+ + The parameter describes requirements to be satisfied in ancestors of the+ tag.+ + > [css|.a .b {}|]+ + > :t div_ =. b+ > ...+ > '[ '[['(AutoClean, '[], '[], '[]),+ > '(NowOrLater, '[C "a"], '[], '[])]]]+ > ...+ + ==== children+ #children#+ + List of lists of children subselectors in reverse order.+ + > [css|.a {} .b {}|]+ + > :t div_ </ ul_ =. a =. b </ ol_ =# ElementId "x"+ > ...+ > [[I "x", T "ol"], [T "ul", C "b", C "a"]]+ > ...+ + === Hello World+ #hello-world#+ + > {-# LANGUAGE QuasiQuotes #-}+ > {-# OPTIONS_GHC -Wno-missing-signatures #-}+ > module Miso.Css.Test.HelloWorld where+ >+ > import Miso ( component, App, CSS(Style), Component(styles), View )+ > import Miso.Css+ > import Prelude+ >+ > type Model = ()+ > type Action = ()+ >+ > -- default name is "cssAsLiteralText"+ > renameCssTextConst "cssFromQq"+ >+ > [css|+ > .c .b .a {+ > color: #fc2c2c;+ > }+ > |]+ >+ > -- instead of quasi-quoted CSS+ > -- the whole CSS file can be included with:+ > -- includeCss "assets/style.css"+ >+ > app :: App Model Action+ > app = (component () pure viewModel)+ > { styles = [ Style cssFromQq ] }+ >+ > {-+ > viewModel produce following HTML snippet:+ >+ > <div class="c">+ > <div class="b">+ > <button class="a">+ > Submit+ > </button>+ > </div>+ > </div>+ >+ > html_ and body_ don't produce tags,+ > because miso mount cannot be higher than body tag.+ >+ > they serve just for type checking purpose+ > (e.g. html_ satisfies :root pseudo class)+ >+ > -}+ > viewModel :: Model -> View Model Action+ > viewModel () = toView . html_ . body_ $+ > div_ =. c+ > </ (div_ =. b+ > </ (button_ =. a+ > <@ "Submit"))+ + == Development environment+ #development-environment#+ + HLS should be available inside the default dev shell.+ + > $ nix develop+ > $ emacs src/*/*/Qq.hs &+ > $ cabal build+ > $ cabal test --test-option=--hide-successes+ + miso-css was developed with miso v1.9+homepage: http://github.com/yaitskov/miso-css+license: BSD-3-Clause+license-file: LICENSE+author: Daniil Iaitskov+maintainer: dyaitskov@gmail.com+copyright: Daniil Iaitkov 2026+category: Miso, HTML, CSS, Template Haskell+build-type: Simple+bug-reports: https://github.com/yaitskov/miso-css/issues+extra-source-files:+ test/style.css+extra-doc-files:+ changelog.md+tested-with:+ GHC == 9.12.2++source-repository head+ type:+ git+ location:+ https://github.com/yaitskov/miso-css.git++common base+ default-language: GHC2024+ ghc-options: -Wall+ default-extensions:+ DefaultSignatures+ NoImplicitPrelude+ OverloadedRecordDot+ OverloadedStrings+ TemplateHaskell+ build-depends:+ , base >=4.7 && < 5+ , template-haskell < 3++library+ import: base+ hs-source-dirs: src+ exposed-modules:+ Miso.Css+ Miso.Css.Escape+ Miso.Css.Event+ Miso.Css.Gen+ Miso.Css.IncludeCss+ Miso.Css.List+ Miso.Css.Miso+ Miso.Css.Operator+ Miso.Css.Parser+ Miso.Css.Prelude+ Miso.Css.Qq+ Miso.Css.Segment+ Miso.Css.Sibling+ Miso.Css.Style+ Miso.Css.Style.E+ Miso.Css.Style.AncestorConstraint+ Miso.Css.Style.OrClass+ Miso.Css.Style.PostAppend+ Miso.Css.Style.PreAppend+ Miso.Css.Tags+ build-depends:+ , add-dependent-file >= 0.0.2 && < 1+ , containers < 1+ , css-parser < 1+ , filepath < 2+ , miso >= 1.9 && < 2+ , mtl < 3+ , tagged < 1+ , template-haskell < 3+ , text < 3++test-suite test+ import: base+ type: exitcode-stdio-1.0+ main-is: Driver.hs+ default-extensions:+ MultilineStrings+ QuasiQuotes+ other-modules:+ Miso.Css.Test.BindEventHandlers+ Miso.Css.Test.HelloWorld+ Miso.Css.Test.IncludeCssAsserts+ Miso.Css.Test.Prelude+ Miso.Css.Test.QqAsserts+ Miso.Css.Test.Style+ Miso.Css.Test.StyleMock+ Miso.Css.Test.Th.AmoreBmoreC+ Miso.Css.Test.Th.AplusBplusC+ Miso.Css.Test.Th.DivPlusPtildeSpanMoreAplusB+ Miso.Css.Test.Th.DotAdotB+ Miso.Css.Test.Th.ForkBranchOnJnMatchAfterNol+ Miso.Css.Test.Th.ForkBranchSibling+ Miso.Css.Test.Th.PmoreXplusYplusZmoreAspaceBmoreC+ Miso.Css.Test.Th.RootMoreA+ Discovery+ hs-source-dirs:+ test+ ghc-options: -Wall -Wno-missing-signatures -rtsopts -threaded -main-is Driver+ build-depends:+ , bytestring+ , miso+ , miso-css+ , QuickCheck+ , tasty+ , tasty-discover+ , tasty-hunit+ , tasty-quickcheck
+ src/Miso/Css.hs view
@@ -0,0 +1,19 @@+-- | Module provides a quasi quoter translating CSS classes to Haskell functions+module Miso.Css+ ( module X+ , css+ , cssToDecs+ , includeCss+ , renameCssTextConst+ ) where++import Miso.Css.Event as X+import Miso.Css.IncludeCss ( includeCss )+import Miso.Css.Miso as X+import Miso.Css.Operator as X+import Miso.Css.Qq ( css, cssToDecs, renameCssTextConst )+import Miso.Css.Segment as X (SubSeg (..), MatchScope (..))+import Miso.Css.Style as X+ ( ElementId, E(..), ElementStructure (..), KnownIDS (..)+ , CD, HTML, BODY, Root, RMV)+import Miso.Css.Tags as X
+ src/Miso/Css/Escape.hs view
@@ -0,0 +1,48 @@+module Miso.Css.Escape where++import Data.Char+ ( isAlpha,+ isAlphaNum,+ isLowerCase,+ isUpper,+ toLower,+ toUpper )+import Prelude++escapeValIden :: String -> String+escapeValIden s =+ case escapeIdenChar <$> hyphensToCamelCase s of+ s'@(fl:ol)+ | not (isAlpha fl) -> '_' : s'+ | isUpper fl -> toLower fl : ol+ | otherwise -> s'+ [] -> []++escapeTypeIden :: String -> String+escapeTypeIden s =+ case escapeValIden s of+ es@(fl : ol)+ | isLowerCase fl -> toUpper fl : ol+ | otherwise -> es+ [] -> []++escapeIdenChar :: Char -> Char+escapeIdenChar c+ | isAlphaNum c || c == '_' = c+ | otherwise = '_'++hyphensToCamelCase :: String -> String+hyphensToCamelCase = concatMap ucFirst . splitOn '-'++ucFirst :: String -> String+ucFirst "" = ""+ucFirst (h:t) = toUpper h : t++splitOn :: Eq a => a -> [a] -> [[a]]+splitOn x xs = go xs []+ where+ go [] acc = [reverse acc]+ go (y : ys) acc =+ if x == y+ then reverse acc : go ys []+ else go ys (y : acc)
+ src/Miso/Css/Event.hs view
@@ -0,0 +1,42 @@+{-# LANGUAGE FunctionalDependencies #-}+module Miso.Css.Event where++import Miso+import Miso.Event as E+import Miso.Css.Prelude++class EventFactory ef a | ef -> a where+ eventName :: ef -> MisoString+ mkActionAttribute :: ef -> Attribute a++data AtomicEvent a = AtomicEvent MisoString a deriving (Show, Eq, Ord)++instance EventFactory (AtomicEvent a) a where+ eventName (AtomicEvent e _) = e+ mkActionAttribute (AtomicEvent e a) =+ E.on e emptyDecoder $ \() _ -> a++data VarEvent a = forall r. VarEvent MisoString (Decoder r) (r -> DOMRef -> a)++instance EventFactory (VarEvent a) a where+ eventName (VarEvent en _ _) = en+ mkActionAttribute (VarEvent en decoder af) =+ on en decoder af++onClick :: a -> AtomicEvent a+onClick = AtomicEvent "click"++onVar :: Decoder r -> MisoString -> (r -> a) -> VarEvent a+onVar d n f = VarEvent n d (\a _ -> f a)++onInput :: (MisoString -> a) -> VarEvent a+onInput = onVar valueDecoder "input"++onChange :: (MisoString -> a) -> VarEvent a+onChange = onVar valueDecoder "change"++onKeyPress :: (KeyCode -> a) -> VarEvent a+onKeyPress = onVar keycodeDecoder "keypress"++onKeyUp :: (KeyCode -> a) -> VarEvent a+onKeyUp = onVar keycodeDecoder "keyup"
+ src/Miso/Css/Gen.hs view
@@ -0,0 +1,256 @@+module Miso.Css.Gen where++import Control.Monad.State ( MonadState(put), runState, State )+import CssParser+import CssParser.Rule.Pseudo as P+import Data.Map.Strict qualified as M+import Data.Text (unpack)+import Language.Haskell.TH.Syntax+import Miso.Css.Escape ( escapeTypeIden, escapeValIden )+import Miso.Css.List ( spanMaybe )+import Miso.Css.Parser ( CssIndex(byClass, hashSet), Selectors )+import Miso.Css.Prelude+import Miso.Css.Segment+ ( MatchScope(NowOrLater, AutoClean, JustNow), SubSeg(A, T, C) )+import Miso.Css.Sibling (SiblingBranch(NilSibBranch))+import Miso.Css.Style++type TsFilter = TagSubSelector -> Bool+type TsTr = (TagSelector, TagRelation)+type TsSibRel = (TagSelector, SibRel)+type TsHierRel = (TagSelector, HierRel)++data SibRel = SibDir | SibGen deriving (Show, Eq, Ord)+data HierRel = HierChild | HierDescendant deriving (Show, Eq, Ord)++cssIdentToTypeDec :: Ident -> Dec+cssIdentToTypeDec (Ident i) = TySynD n [] (AppT (ConT ''ElementId) (LitT (StrTyLit ns)))+ where+ ns = unpack i+ n = mkName $ escapeTypeIden ns++selectorsToDecs :: CssIndex -> Q [ Dec ]+selectorsToDecs cidx =+ ((cssIdentToTypeDec <$> cidx.hashSet ) <>) . concat <$> mapM go (M.toList cidx.byClass)+ where+ go (i, sels) =+ [d|$(pure . VarP $ identToName i) = $(selectorsToExp i sels)|]++-- type of result Exp is :: OrClass p c+selectorsToExp :: Ident -> Selectors -> Q Exp+selectorsToExp i sels =+ [| ($(composeExpsWithDot <$> mapM (selectorToExp i) sels))+ (TopOrClass $(identToSymbol i)) |]++identToName :: Ident -> Name+identToName (Ident i) = mkName . escapeValIden $ unpack i++identToSymbol :: Ident -> Q Exp+identToSymbol (Ident i) =+ [| Proxy :: Proxy $(pure . LitT . StrTyLit $ unpack i) |]++-- type of result exp is :: OrClass p c -> OrClass p c+selectorToExp :: Ident -> [ (TagRelation, TagSelector) ] -> Q Exp+selectorToExp i s =+ case runState (shiftSelector s) Nothing of+ (tsTrs, Just (lastTs :: TagSelector)) -> do+ [| AddAncestorBranch ($(foldShiftedTsTr iFilter lastTs tsTrs)) |]+ o -> fail $ "Dead code on " <> show i <> " " <> show s <> " due: " <> show o+ where+ iFilter = \case+ AtomicClass c -> c /= i+ _ -> True++-- .a > .b > .c+tagNameToExp :: TagName -> Q [Exp]+tagNameToExp = \case+ TagName i -> fmap (:[]) [| AddSubSegConstraint (Proxy @T) $(identToSymbol i) |]+ AmpersandTag -> pure [] -- todo expand local alias+ _ -> pure []++tagSubSelectorToExp :: TagSubSelector -> Q [Exp]+tagSubSelectorToExp = \case+ AtomicClass c ->+ fmap (:[]) [| AddSubSegConstraint (Proxy @C) $(identToSymbol c) |]+ HasAttr an ->+ fmap (:[]) [| AddSubSegConstraint (Proxy @A) $(identToSymbol an.attrName) |]+ Hash i ->+ fmap (:[]) [| AddSubSegConstraint (Proxy @A) $(identToSymbol i) |]+ AtomicPseudoClass P.Root ->+ fmap (:[]) [| AddRoot |]+ _ -> pure []++-- every Exp represents a function :: AncestorConstraint -> AncestorConstraint+tagSelectorToExp :: (TagSubSelector -> Bool) -> TagSelector -> Q Exp+tagSelectorToExp tsFilter ts = do+ tn <- tagNameToExp ts.tagName+ composeExpsWithArr . (tn <>) . concat <$>+ mapM tagSubSelectorToExp (filter tsFilter ts.tagSubSelectors)++jn :: Proxy JustNow+jn = Proxy @JustNow+nol :: Proxy NowOrLater+nol = Proxy @NowOrLater+acn :: Proxy AutoClean+acn = Proxy @AutoClean++passAll :: b -> Bool+passAll = const True++lastSelectorToExp :: TsFilter -> TagSelector -> Q Exp+lastSelectorToExp tsf lastTs = [| NextAncestor acn >>> $(tagSelectorToExp tsf lastTs) |]++-- returns exp that is :: AncestorConstraint p+foldShiftedTsTr :: TsFilter -> TagSelector -> [ TsTr ] -> Q Exp+foldShiftedTsTr tsFilter lastTs tsTrs =+ case spanSiblings tsTrs of+ ([], []) -> [| (CssOrphan acn & $(tagSelectorToExp tsFilter lastTs)) |]+ ([], [(ts, Child)]) ->+ [| (CssOrphan jn & ($(tagSelectorToExp passAll ts) >>> $(lastSelectorToExp tsFilter lastTs))) |]+ ([], [(ts, Descendant)]) ->+ [| (CssOrphan nol & ($(tagSelectorToExp passAll ts) >>> $(lastSelectorToExp tsFilter lastTs))) |]++ ([], (ts, Child) : tsTrs') ->+ [| (CssOrphan jn & ($(go (tagSelectorToExp passAll ts) tsTrs'))) |]+ ([], (ts, Descendant) : tsTrs') ->+ [| (CssOrphan nol & ($(go (tagSelectorToExp passAll ts) tsTrs'))) |]++ (tsSrs, []) ->+ [| (CssOrphan jn & ($(tsTrsToAddSiblingBranchExp tsSrs) >>> $(lastSelectorToExp tsFilter lastTs))) |]++ (tsSrs, [(ts, Child)]) ->+ [| (CssOrphan jn & ( $(tsTrsToAddSiblingBranchExp tsSrs)+ >>> NextAncestor jn+ >>> $(tagSelectorToExp passAll ts))) |]+ (tsSrs, [(ts, Descendant)]) ->+ [| (CssOrphan nol & ( $(tsTrsToAddSiblingBranchExp tsSrs)+ >>> NextAncestor jn+ >>> $(tagSelectorToExp passAll ts))) |]++ (tsSrs, (ts, Child) : tsTrs') ->+ [| (CssOrphan jn & ( $(tsTrsToAddSiblingBranchExp tsSrs)+ >>> NextAncestor jn+ >>> $(go (tagSelectorToExp passAll ts) tsTrs'))) |]+ (tsSrs, (ts, Descendant) : tsTrs') ->+ [| (CssOrphan nol & ( $(tsTrsToAddSiblingBranchExp tsSrs)+ >>> NextAncestor jn+ >>> $(go (tagSelectorToExp passAll ts) tsTrs'))) |]++ o -> fail $ "Unexpected tsTrs" <> show tsTrs <> " due case: " <> show o+ where+ go b tsTrs' =+ case spanSiblings tsTrs' of+ ([], []) -> [| $b >>> $(lastSelectorToExp tsFilter lastTs) |]+ ([], [(ts, Child)]) ->+ [| $b >>> NextAncestor jn+ >>> $(tagSelectorToExp passAll ts)+ >>> $(lastSelectorToExp tsFilter lastTs) |]+ ([], [(ts, Descendant)]) ->+ [| $b >>> NextAncestor nol+ >>> $(tagSelectorToExp passAll ts)+ >>> $(lastSelectorToExp tsFilter lastTs) |]+ ([], (ts, Child) : tsTrs'') ->+ go [| $b >>> NextAncestor jn >>> $(tagSelectorToExp passAll ts) |] tsTrs''+ ([], (ts, Descendant) : tsTrs'') ->+ go [| $b >>> NextAncestor nol >>> $(tagSelectorToExp passAll ts) |] tsTrs''+ (tsSrs, []) ->+ [| $b >>> $(tsTrsToAddSiblingBranchExp tsSrs) >>> $(lastSelectorToExp tsFilter lastTs) |]+ (tsSrs, tsTrs'') ->+ go [| $b >>> $(tsTrsToAddSiblingBranchExp tsSrs) |] tsTrs''++sibRelToNilSibExp :: SibRel -> Q Exp+sibRelToNilSibExp = \case+ SibDir -> [| NilSib (Proxy @NowOrLater) |]+ SibGen -> [| NilSib (Proxy @JustNow) |]++-- @AddSiblingBranch (... >>> ... $ NilSibBranch)@+tsTrsToAddSiblingBranchExp :: [TsSibRel] -> Q Exp+tsTrsToAddSiblingBranchExp tsSrs =+ [| AddSiblingBranch (($(go)) NilSibBranch) |]+ where+ go = composeExpsWithArr <$> mapM tsTrToAddSegToSibBrExp tsSrs++-- @AddSegToSibBranch (AddSib (Proxy @C) pa $ NilSib nol)@+tsTrToAddSegToSibBrExp :: TsSibRel -> Q Exp+tsTrToAddSegToSibBrExp (ts, sr) =+ [| AddSegToSibBranch (($(tagSelectorToSibBrSeg ts)) $(sibRelToNilSibExp sr)) |]++-- Exp is :: Sibling ms ss -> Sibling ms ss+-- @AddSib (Proxy @C) pa@+tagSelectorToSibBrSeg :: TagSelector -> Q Exp+tagSelectorToSibBrSeg ts = composeExpsWithDot <$> go+ where+ go :: Q [Exp]+ go = (:) <$> tagNameToAddSibExp ts.tagName+ <*> mapM tagSubSelectorToAddSibExp ts.tagSubSelectors++dotOp :: (b -> c) -> (a -> b) -> a -> c+dotOp = (.)++-- compose the list of unary functions Exp+composeExpsWithDot :: [Exp] -> Exp+composeExpsWithDot = foldr go (VarE 'id)+ where+ go aE = UInfixE aE (VarE 'dotOp)++composeExpsWithArr :: [Exp] -> Exp+composeExpsWithArr = foldl' go (VarE 'id)+ where+ go bE = UInfixE bE (VarE 'arr)++arr :: (a -> b) -> (b -> c) -> a -> c+arr = (>>>)++tagNameToAddSibExp :: TagName -> Q Exp+tagNameToAddSibExp = \case+ TagName i ->+ [| AddSib (Proxy @T) $(identToSymbol i) |]+ AmpersandTag -> [| id |] -- todo expand local alias+ _ -> [| id |]++tagSubSelectorToAddSibExp :: TagSubSelector -> Q Exp+tagSubSelectorToAddSibExp = \case+ AtomicClass c ->+ [| AddSib (Proxy @C) $(identToSymbol c) |]+ HasAttr an ->+ [| AddSib (Proxy @A) $(identToSymbol an.attrName) |]+ Hash i ->+ [| AddSib (Proxy @A) $(identToSymbol i) |]+ _ -> [| id |]++-- every Exp represents a function :: AncestorConstraint -> AncestorConstraint+tagRelationToExp :: TagRelation -> Q [Exp]+tagRelationToExp = \case+ Descendant -> (:[]) <$> [| NextAncestor (Proxy @NowOrLater) |]+ Child -> (:[]) <$> [| NextAncestor (Proxy @JustNow) |]+ NextSibling -> (:[]) <$> [| NextAncestor (Proxy @JustNow) |]+ GeneralSibling -> (:[]) <$> [| NextAncestor (Proxy @NowOrLater) |]++isSiblingRel :: TagRelation -> Maybe SibRel+isSiblingRel = \case+ NextSibling -> pure SibDir+ GeneralSibling -> pure SibGen+ _ -> Nothing++isHierRel :: TagRelation -> Maybe HierRel+isHierRel = \case+ Child -> pure HierChild+ Descendant -> pure HierDescendant+ _ -> Nothing++spanSiblings :: [TsTr] -> ([TsSibRel], [TsTr])+spanSiblings = spanMaybe (\(ts, tr) -> isSiblingRel tr <&> (ts,))++spanHierarchy :: [TsTr] -> ([TsHierRel], [TsTr])+spanHierarchy = spanMaybe (\(ts, tr) -> isHierRel tr <&> (ts,))++shiftSelector :: [(TagRelation, TagSelector)] -> State (Maybe TagSelector) [TsTr]+shiftSelector = \case+ [] -> pure []+ [(_, s)] -> put (Just s) >> pure []+ (_, s) : t -> go s t+ where+ go s = \case+ [] -> pure []+ [(r, lastS)] -> put (Just lastS) >> pure [(s, r)]+ (r', s') : t -> ((s, r') :) <$> go s' t
+ src/Miso/Css/IncludeCss.hs view
@@ -0,0 +1,18 @@+module Miso.Css.IncludeCss (includeCss) where++import AddDependentFile ( (</>), addDependentFile, getPackageRoot )+import Miso.Css.Escape ( escapeValIden )+import Miso.Css.Qq (cssToDecs')+import Language.Haskell.TH.Syntax ( mkName, Q, Dec, runIO )+import Miso.Css.Prelude+ ( ($), Maybe(Just), (=<<), (<$>), readFile, FilePath )+import System.FilePath (takeBaseName)++-- | like css quasi quoter but+-- css input is exported via constant equal to base file name+-- instead of cssAsLiteralText.+includeCss :: FilePath -> Q [Dec]+includeCss p = do+ ap <- (</> p) <$> getPackageRoot+ addDependentFile ap+ cssToDecs' (mkName (escapeValIden $ takeBaseName p)) (Just ap) =<< runIO (readFile ap)
+ src/Miso/Css/List.hs view
@@ -0,0 +1,49 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}+module Miso.Css.List where++import Data.Type.Bool ( If )+import Data.Type.Equality ( type (==) )+import Prelude++type family Append a b where+ Append (x:xs) b = x : Append xs b+ Append '[] b = b++type family RemoveElem s l x where+ RemoveElem _ _ '[] = Nothing+ RemoveElem s k (h:t) =+ If (k == h)+ (Just '( k, Append s t))+ (RemoveElem (h : s) k t)++type family PrependMb mb l where+ PrependMb Nothing l = l+ PrependMb (Just x) l = x : l++type family Elem e l where+ Elem _ '[] = False+ Elem h (h : l) = True+ Elem h (_ : l) = Elem h l++type family MergeUniq a b s where+ MergeUniq '[] b s = Right (Append b s)+ MergeUniq (ah : at) b s =+ If (Elem ah b)+ (Left ah)+ (MergeUniq at b (ah : s))++type family IsSubSetCase rer t where+ IsSubSetCase Nothing _t = False+ IsSubSetCase (Just '( _, l)) t = IsSubSet t l++type family IsSubSet a b where+ IsSubSet '[] _ = True+ IsSubSet (h : t) l = IsSubSetCase (RemoveElem '[] h l) t++spanMaybe :: (a -> Maybe b) -> [a] -> ([b], [a])+spanMaybe _ xs@[] = ([], xs)+spanMaybe p xs@(x : xs') = case p x of+ Just y -> let (ys, zs) = spanMaybe p xs' in (y : ys, zs)+ Nothing -> ([], xs)
+ src/Miso/Css/Miso.hs view
@@ -0,0 +1,145 @@+module Miso.Css.Miso where++import Miso+ ( ms,+ vtext,+ prop,+ MisoString,+ Attribute(Property, ClassList),+ View(VNode) )+import Miso.JSON ( ToJSON(..) )+import Miso.Html ( nodeHtml )+import Miso.Html.Property (id_)+import Miso.Css.Event ( EventFactory(mkActionAttribute) )+import Miso.Css.List ( PrependMb, Append )+import Miso.Css.Segment+ ( ApplyClass,+ MbSymToMbI,+ SubSeg(T, R),+ UnwrapBranches,+ RemoveMatchScope )+import Miso.Css.Style+import Miso.Css.Style.PostAppend+ ( MapMaybeFilterOutFullyMatchedHead )+import Miso.Css.Prelude++injectClass :: MisoString -> View model action -> View model action+injectClass cn = \case+ VNode ns tg atrs children -> VNode ns tg (injClass atrs) children+ o -> o+ where+ injClass = \case+ [] -> [ClassList [cn]]+ ClassList cls : atrs' -> ClassList (cls <> [cn]) : atrs'+ o : atrs' -> o : injClass atrs'++injectElementId :: MisoString -> View model action -> View model action+injectElementId ik = \case+ VNode ns tg atrs children -> VNode ns tg (injId atrs) children+ o -> o+ where+ injId = \case+ [] -> [id_ ik]+ -- Property "key" _v : atrs' -> key_ ik : atrs'+ Property "id" _v : atrs' -> id_ ik : atrs'+ o : atrs' -> o : injId atrs'++injectElementAtr :: ToJSON v => MisoString -> v -> View model action -> View model action+injectElementAtr ik v = \case+ VNode ns tg atrs children -> VNode ns tg (injId atrs) children+ o -> o+ where+ p = prop ik v+ injId = \case+ [] -> [p]+ -- Property "key" _v : atrs' -> key_ ik : atrs'+ Property pn pnv : atrs'+ | pn == ik -> Property pn (toJSON v) : atrs'+ | otherwise -> Property pn pnv : injId atrs'+ o : atrs' -> o : injId atrs'++injectEventHandler :: EventFactory ef action =>+ ef -> View model action -> View model action+injectEventHandler ef = \case+ VNode ns tg atrs children ->+ VNode ns tg (mkActionAttribute ef : atrs) children+ o -> o++className :: forall p c. KnownSymbol c => OrClass p c -> MisoString+className _ =+ ms $ symbolVal $ Proxy @c++data Child++appChild :: Tagged Child (View model action) -> View model action -> View model action+appChild (Tagged c) = \case+ VNode ns tg atrs children -> VNode ns tg atrs $ children <> [c]+ o -> o++eToView :: E model action en es r ei atrs knownIds cls eacs children -> View model action+eToView = \case+ RawMisoView rmv -> rmv+ CDataE txt -> vtext txt+ NilE enp -> nodeHtml (ms $ symbolVal enp) [] []+ IdE eni e -> injectElementId (ms $ symbolVal eni) (eToView e)+ AppClsE orCls e -> injectClass (className orCls) (eToView e)+ AppendChildE ce pe -> appChild (Tagged @Child (eToView ce)) (eToView pe)+ AddAtrE a e -> injectElementAtr (elAtrKey a) (elAtrVal a) (eToView e)+ BindEventE ef e -> injectEventHandler ef (eToView e)+ SealDomE e -> eToView e+ VirtualBodyE b -> eToView b++toView :: forall m a en es r ei atrs kids cls ecs children.+ ( RemoveMatchScope (UnwrapBranches (MapMaybeFilterOutFullyMatchedHead '[] ecs)) ~ '[]+ , DuplicatedIds kids ~ '[]+ ) =>+ E m a en es r ei atrs kids cls ecs children -> View m a+toView = eToView++-- | More detailed types that 'toView'+toView' :: forall m a en es r ei atrs kids cls ecs children.+ ( UnwrapBranches (MapMaybeFilterOutFullyMatchedHead '[] ecs) ~ '[]+ , DuplicatedIds kids ~ '[]+ ) =>+ E m a en es r ei atrs kids cls ecs children -> View m a+toView' = eToView++body_ ::+ E model action ce cs Nothing ci atrs knownIds ccls ceacs cchildren ->+ E model action BODY Composite Nothing Nothing atrs knownIds+ '[] -- classes+ (AppendChild+ '[] -- pchildren+ ceacs+ '[ T BODY ]+ '[])+ '[ PrependMb (MbSymToMbI ci) (T ce : SymsToSubSeg ccls) ]+body_ = VirtualBodyE++html_ ::+ E model action ce cs Nothing ci catrs ckids ccls ceacs cchildren ->+ E model action HTML Composite (Just 'Root) Nothing+ catrs ckids+ '[]+ (MapMaybeFilterOutFullyMatchedHead+ '[]+ (ApplyClass '[] (T HTML) (ApplyClass '[] R ceacs)))+ '[ PrependMb (MbSymToMbI ci) (T ce : SymsToSubSeg ccls) ]+html_ = SealDomE++page ::+ E model action ce cs Nothing ci catrs ckids ccls ceacs cchildren ->+ E model action HTML Composite (Just 'Root) Nothing catrs ckids '[]+ (MapMaybeFilterOutFullyMatchedHead+ '[]+ (ApplyClass+ '[] (T HTML)+ (ApplyClass+ '[] R+ (Append+ (MapMaybeFilterOutFullyMatchedHead+ '[]+ (ApplyClass '[] (T BODY) ceacs))+ '[]))))+ '[ '[T BODY]]+page x = html_ (body_ x)
+ src/Miso/Css/Operator.hs view
@@ -0,0 +1,114 @@+{-# LANGUAGE RequiredTypeArguments #-}+{-# LANGUAGE UndecidableInstances #-}+module Miso.Css.Operator where++import Miso ( View )+import Miso.Css.Event ( EventFactory )+import Miso.Css.Prelude ( Proxy(..), Maybe(Just, Nothing), KnownSymbol, type (~) )+import Miso.Css.Segment ( SubSeg(A, T), ApplyClass )+import Miso.Css.Style+import Miso.JSON ( ToJSON )+++(=.) :: (KnownSymbol en, KnownSymbol c) =>+ E model action en Composite r ei atrs kids cls eacs children ->+ OrClass p c ->+ E model action en Composite r ei ("class" : atrs) kids (c:cls)+ (ConstraintsAfterClassApp ei en atrs cls p c eacs)+ children+e =. c = AppClsE c e++infixl 3 =.++atr :: forall k v. (KnownSymbol k, ToJSON v) => v -> ElAtr k v+atr = ElAtr++(=<|) :: (KnownSymbol k, ToJSON v) =>+ E model action en Composite r ei atrs kids cls eacs children ->+ ElAtr k v ->+ E model action en Composite r ei (k : atrs) kids cls+ (ApplyClass '[] (A k) eacs) -- eacs+ children+e =<| a = AddAtrE a e++infixl 3 =<|++(=#) :: forall model action en r catrs kids cls eacs children ee.+ (KnownSymbol en, KnownSymbol ee) =>+ E model action en Composite r Nothing catrs kids cls eacs children ->+ forall ei -> (ei ~ ElementId ee) =>+ E model+ action+ en+ Composite+ r+ (Just ee)+ ("id" : catrs)+ (AddTagId ee kids)+ cls+ (ConstraintsAfteId ee eacs)+ children+e =# _ = IdE (Proxy @ee) e++infixl 3 =#++(=!) ::+ EventFactory ef action =>+ E model action en es r ei atrs kids cls eacs children ->+ ef ->+ E model action en es r ei atrs kids cls eacs children+e =! ef = BindEventE ef e++infixl 3 =!++(</) ::+ KnownSymbol cen =>+ E model action pen Composite r pi patrs pKids pcls peacs pchildren ->+ E model action cen cs Nothing ci catrs cKids ccls ceacs cchildren ->+ E model action pen Composite r pi patrs+ (MergeKids cKids pKids)+ pcls+ (ConstraintsAfterAppend pchildren ceacs pi pen patrs pcls peacs)+ (ChildrenConstrAfterAppend ci cen ccls pchildren)++p </ c = AppendChildE c p++infixl 2 </++(<@) ::+ E model action pen Composite r pi patrs kids pcls peacs pchildren ->+ E model action CD Atomic Nothing Nothing '[] EmptyKids '[] '[] '[] ->+ E+ model+ action+ pen+ Composite+ r+ pi+ patrs+ (MergeKids EmptyKids kids)+ pcls+ (ConstraintsAfterAppend pchildren '[] pi pen patrs pcls peacs)+ (ChildrenConstrAfterAppend Nothing CD '[] pchildren)+(<@) = (</)++infixl 2 <@++(=<) ::+ E model action pen Composite r pi atrs kids pcls peacs pchildren ->+ View model action ->+ E+ model+ action+ pen+ Composite+ r+ pi+ atrs+ (MergeKids EmptyKids kids)+ pcls+ (ConstraintsAfterAppend pchildren '[] pi pen atrs pcls peacs)+ ('[T RMV] : pchildren)+p =< rmv = p </ RawMisoView rmv++infixl 2 =<
+ src/Miso/Css/Parser.hs view
@@ -0,0 +1,91 @@+module Miso.Css.Parser where++import CssParser as CP+import Data.Map.Strict qualified as M+import Data.Set qualified as S+import Miso.Css.Prelude++type RelTag = [ (TagRelation, TagSelector) ]+type Selectors = [ RelTag ]+type SelIdxByLeafClass = M.Map Ident Selectors++data RulesForNonLeafClasses = RulesForNonLeafClasses deriving (Show, Eq, Ord)++type ParserM = Reader (Maybe RulesForNonLeafClasses)++indexByLeafClass :: SelIdxByLeafClass -> RelTag -> ParserM SelIdxByLeafClass+indexByLeafClass m = \case+ [] -> pure m+ reversedSels@((_, lastTs) : t) ->+ case mapMaybe atomicClassName lastTs.tagSubSelectors of+ [] -> indexByLeafClass m t+ clsNames ->+ ask >>= \case+ Just RulesForNonLeafClasses ->+ indexByLeafClass (foldr (go $ reverse reversedSels) m clsNames) t+ Nothing ->+ pure $ addNonLeafClasses (foldr (go $ reverse reversedSels) m clsNames) t+ where+ go rrs i = M.insertWith (<>) i [rrs]+ addNonLeafClasses m' = \case+ [] -> m'+ (_, ts) : t ->+ addNonLeafClasses+ (foldl' (\m'' clsName -> M.insertWith (<>) clsName [] m'')+ m'+ (mapMaybe atomicClassName ts.tagSubSelectors))+ t++atomicClassName :: TagSubSelector -> Maybe Ident+atomicClassName = \case+ AtomicClass x -> Just x+ _ -> Nothing++hashOnly :: TagSubSelector -> Maybe Ident+hashOnly = \case+ Hash i -> pure i+ _ -> Nothing++hashesOfTagSelector :: TagSelector -> [ Ident ]+hashesOfTagSelector ts = mapMaybe hashOnly ts.tagSubSelectors++hashIndex :: Selectors -> S.Set Ident+hashIndex = S.fromList . concatMap (hashesOfTagSelector . snd) . concat++data CssIndex+ = CssIndex+ { byClass :: SelIdxByLeafClass+ , hashSet :: [Ident]+ }++indexFile :: CssFile -> ParserM CssIndex+indexFile cf =+ (`CssIndex` S.toList (hashIndex sels)) <$>+ foldM indexByLeafClass mempty (fmap reverse sels)+ where+ sels = fileToSelectors cf++fileToSelectors :: CssFile -> Selectors+fileToSelectors cf = concatMap ruleToSelectors cf.rules++ruleToSelectors :: CssRule -> Selectors+ruleToSelectors =+ fmap (concatMap selectorToTagRelSel) . extractSelectors++selectorToTagRelSel :: Selector -> RelTag+selectorToTagRelSel = \case+ Selector ftr fts os -> (fromMaybe Descendant ftr, fts) : os+ PeSelector ftr fts os _ -> (fromMaybe Descendant ftr, fts) : os+ PeSelectorOnly {} -> []++extractSelectors :: CssRule -> [[Selector]]+extractSelectors = \case+ CssRule sels subRules ->+ let selsList = toList sels in+ (pure <$> selsList) <> [ a : b | a <- selsList, b <- concatMap goSubRules subRules ]+ AtRule {} -> []+ where+ goSubRules = \case+ CssLeafRule {} -> []+ CssEnumLeaf {} -> []+ CssNestedRule cr -> extractSelectors cr
+ src/Miso/Css/Prelude.hs view
@@ -0,0 +1,15 @@+module Miso.Css.Prelude (module X) where++import Control.Arrow as X ((>>>))+import Control.Monad as X ((<=<), foldM, join)+import Control.Monad.Reader as X+import Data.Function as X ((&))+import Data.Functor as X ((<&>))+import Data.List.NonEmpty as X (toList)+import Data.Maybe as X (fromMaybe, mapMaybe)+import Data.Proxy as X ( Proxy(Proxy) )+import Data.String as X ( IsString )+import Data.Tagged as X ( Tagged(Tagged) )+import GHC.Generics as X (Generic)+import GHC.TypeLits as X ( KnownSymbol, Symbol, TypeError, ErrorMessage(Text, (:<>:), ShowType), symbolVal )+import Prelude as X
+ src/Miso/Css/Qq.hs view
@@ -0,0 +1,97 @@+-- | Module provides a quasi quoter translating CSS classes to Haskell functions+module Miso.Css.Qq where++import CssParser as CP ( parseCssP, P(Failed, Ok) )+import Miso.Css.Gen ( selectorsToDecs )+import Miso.Css.Parser+ ( indexFile, RulesForNonLeafClasses(RulesForNonLeafClasses) )+import Miso.Css.Prelude+import Language.Haskell.TH.Quote ( QuasiQuoter(..) )+import Language.Haskell.TH.Syntax++{- | quasi quoter accepts CSS and generates definitions for CSS classes++> .foo > .bar {+> padding: 0px;+> }++is expanded as:++@+{-# INLINE fooBar #-}++foo = TopOrClass (Proxy @"foo")++bar =+ AddAncestorBranch+ (CssOrphan jn & ( AddSubSegConstraint (Proxy @C) (Proxy @"foo")))+ (TopOrClass (Proxy @"bar"))++{-# INLINE cssAsLiteralText #-}+cssAsLiteralText :: IsString s => s+cssAsLiteralText = ".foo > .bar { padding: 0px; }"+@++-}+css :: QuasiQuoter+css = QuasiQuoter+ { quoteExp = \_ -> fail "quoteExp: not implemented"+ , quotePat = \_ -> fail "quotePat: not implemented"+ , quoteType = \_ -> fail "quoteType: not implemented"+ , quoteDec = cssToDecs Nothing+ }++newtype CssTextConstName = CssTextConstName { unCssTextConstName :: String } deriving newtype (Show, Eq, Ord)++-- | default name is @cssAsLiteralText@+renameCssTextConst :: String -> Q [Dec]+renameCssTextConst = pure . const [] <=< putQ . CssTextConstName++getInputExportName :: Q Name+getInputExportName = mkName . maybe "cssAsLiteralText" unCssTextConstName <$> getQ++cssToDecs :: Maybe FilePath -> String -> Q [Dec]+cssToDecs fileNameMb s = do+ inputExportName <- getInputExportName+ cssToDecs' inputExportName fileNameMb s++enableRulesForNonLeafClasses :: Q [Dec]+enableRulesForNonLeafClasses =+ putQ (Just RulesForNonLeafClasses) >> pure []++disableRulesForNonLeafClasses :: Q [Dec]+disableRulesForNonLeafClasses =+ putQ (Nothing :: Maybe RulesForNonLeafClasses) >> pure []++cssToDecs' :: Name -> Maybe FilePath -> String -> Q [Dec]+cssToDecs' inputExportName fileNameMb s =+ case parseCssP s of+ Ok cssFile -> do+ parserConfig :: Maybe (Maybe RulesForNonLeafClasses) <- getQ+ (cssAsLiteralTextD inputExportName s <>) <$>+ selectorsToDecs (runReader (indexFile cssFile) (join parserConfig))+ Failed cssErr ->+ case fileNameMb of+ Nothing -> fail $ "Failed to parse QuasiQuoted CSS due: " <> cssErr+ Just fn -> fail $ "Failed to parse CSS from " <> fn <> " due: " <> cssErr++{- | generate definition like:+@@+ {-# INLINE cssAsLiteralText #-}+ cssAsLiteralText :: IsString s => s+ cssAsLiteralText = s+@@+-}+cssAsLiteralTextD :: Name -> String -> [Dec]+cssAsLiteralTextD n s =+ [ SigD n+ (ForallT+ [PlainTV st InferredSpec]+ [AppT (ConT ''IsString) (VarT st)]+ (VarT st))+ , FunD n [ Clause [] body [] ]+ , PragmaD (InlineP n Inline FunLike AllPhases)+ ]+ where+ st = mkName "s"+ body = NormalB (LitE (StringL s))
+ src/Miso/Css/Segment.hs view
@@ -0,0 +1,150 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}++module Miso.Css.Segment where++import Miso.Css.List ( RemoveElem )+import Miso.Css.Prelude++data SubSeg+ = C Symbol -- ^ Element Class+ | T Symbol -- ^ Element Name (Tag)+ | I Symbol -- ^ Element Id+ | A Symbol -- ^ Attribute Name+ | R -- ^ CSS :root+ | B -- ^ Bottom is added to Seg to prevent matching branch later+ -- used to support CSS '>' syntax++type family MbSymToMbI mbs where+ MbSymToMbI Nothing = Nothing+ MbSymToMbI (Just s) = Just (I s)++data MatchScope+ = NowOrLater+ | JustNow+ | AutoClean -- ^ similar to JustNow but Segment is removed right away once UM list becomes empty.+ -- an empty JustNow segment lives until </, this way+ -- subseg constrains of tag to be applied+ -- why JustNow cannot be replaced with AutoClean?+ -- it cannot be replaced because following selector .a > p.c is indistiguishable from p.c.a+ -- Seg.siblings are empty for AutoClean+ deriving (Show, Eq)++-- | Composite segment+-- matched part is appended to unmatched when algorithm goes up to parent node+-- if unmatched is not empty+-- if unmatched is empty then list head is dropped+-- every SubSeg match step (ie class, id or tag name)+type Seg =+ ( MatchScope+ , [SubSeg] -- unmatched+ , [SubSeg] -- matched+ , [[(MatchScope, [SubSeg])]] -- siblings+ )++-- Initially Branch was [Seg] but it turned out that+-- selector ".a > .b" fails on hierarchy:+-- <p class="a">+-- <p class="b">+-- <p class="b">+-- The solution is to fork a branch if its head segment is JN when it matches+-- current element and match scope of previous segment in the branch is NL+newtype BRANCH = Branch [Seg]++type SegsOfBranch :: BRANCH -> [Seg]+type family SegsOfBranch b where+ SegsOfBranch (Branch sgs) = sgs+type family UnwrapBranchesInElem e where+ UnwrapBranchesInElem '[] = '[]+ UnwrapBranchesInElem (b : bs) = SegsOfBranch b : UnwrapBranchesInElem bs+type family UnwrapBranches es where+ UnwrapBranches '[] = '[]+ UnwrapBranches (e : es) = UnwrapBranchesInElem e : UnwrapBranches es+++type RemoveMatchScopeInSubSibling :: (MatchScope, [SubSeg]) -> [SubSeg]+type family RemoveMatchScopeInSubSibling sib where+ RemoveMatchScopeInSubSibling '( _, sb) = sb+type RemoveMatchScopeInSibling :: [(MatchScope, [SubSeg])] -> [[SubSeg]]+type family RemoveMatchScopeInSibling sib where+ RemoveMatchScopeInSibling '[] = '[]+ RemoveMatchScopeInSibling (x : xs) =+ RemoveMatchScopeInSubSibling x : RemoveMatchScopeInSibling xs+type family RemoveMatchScopeInSiblings sibs where+ RemoveMatchScopeInSiblings '[] = '[]+ RemoveMatchScopeInSiblings (s : ss) =+ RemoveMatchScopeInSibling s : RemoveMatchScopeInSiblings ss+type family RemoveMatchScopeSegments e where+ RemoveMatchScopeSegments '[] = '[]+ RemoveMatchScopeSegments ( '(_, um, m, sibs) : bs) =+ '(um, m, RemoveMatchScopeInSiblings sibs) : RemoveMatchScopeSegments bs++type family RemoveMatchScopeInBranch b where+ RemoveMatchScopeInBranch sgs = RemoveMatchScopeSegments sgs+type family RemoveMatchScopeInElem e where+ RemoveMatchScopeInElem '[] = '[]+ RemoveMatchScopeInElem (b : bs) = RemoveMatchScopeInBranch b : RemoveMatchScopeInElem bs+type family RemoveMatchScope es where+ RemoveMatchScope '[] = '[]+ RemoveMatchScope (e : es) = RemoveMatchScopeInElem e : RemoveMatchScope es++type SegsToBranch :: [Seg] -> BRANCH+type family SegsToBranch segs where+ SegsToBranch sgs = Branch sgs+type MkListOfranches :: [[Seg]] -> [BRANCH]+type family MkListOfranches segsList where+ MkListOfranches '[] = '[]+ MkListOfranches (segs : t) = SegsToBranch segs : MkListOfranches t+++type AddSubSeg :: SubSeg -> [Seg] -> [Seg]+type family AddSubSeg c ac where+ AddSubSeg c '[] =+ -- unreachable+ TypeError (Text "AddSubSeg " :<>: ShowType c :<>: Text " to empty list")+ AddSubSeg c ( '( mtScope, um, m, sib) : t) =+ ( '( mtScope, c : um, m, sib) : t)++type family ApplySubSegToSeg removed ss sg where+ ApplySubSegToSeg Nothing ss h = h+ ApplySubSegToSeg (Just '(k, um')) _ss '( mts, um, m, sib) =+ '( mts, um', k : m, sib)++type ApplyClassToBranch :: SubSeg -> BRANCH -> BRANCH+type family ApplyClassToBranch subSeg sgs where+ ApplyClassToBranch _ (Branch '[]) = Branch '[]+ ApplyClassToBranch ss (Branch ( '( mts, um, m, sib) : t)) =+ Branch+ (ApplySubSegToSeg (RemoveElem '[] ss um) ss '( mts, um, m, sib) : t)+++type ApplyClassToElem :: SubSeg -> [BRANCH]-> [BRANCH]+type family ApplyClassToElem c bs where+ ApplyClassToElem _ '[] = '[]+ ApplyClassToElem c (b : bs) = ApplyClassToBranch c b : ApplyClassToElem c bs++type ApplyClass :: [[Seg]] -> SubSeg -> [[BRANCH]] -> [[BRANCH]]+type family ApplyClass acs c eacs where+ ApplyClass '[] _ '[] = '[]+ ApplyClass acs _ '[] = '[MkListOfranches acs]+ ApplyClass acs c (h : eacs) = ApplyClassToElem c h : ApplyClass acs c eacs++type ApplySubSegToBranch :: SubSeg -> [Seg] -> [Seg]+type family ApplySubSegToBranch subSeg sgs where+ ApplySubSegToBranch _ '[] = '[]+ ApplySubSegToBranch ss ( '( mts, um, m, sib) : t) =+ (ApplySubSegToSeg+ (RemoveElem '[] ss um)+ ss+ '( mts, um, m, sib) : t)++type family ApplySubSegToElem c bs where+ ApplySubSegToElem _ '[] = '[]+ ApplySubSegToElem c (b : bs) =+ ApplySubSegToBranch c b : ApplySubSegToElem c bs++type ApplySubSegsToElem :: [SubSeg] -> [[Seg]] -> [[Seg]]+type family ApplySubSegsToElem ss bs where+ ApplySubSegsToElem '[] bs = bs+ ApplySubSegsToElem (h : t) bs = ApplySubSegsToElem t (ApplySubSegToElem h bs)
+ src/Miso/Css/Sibling.hs view
@@ -0,0 +1,64 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}++module Miso.Css.Sibling where++import GHC.TypeError+ ( TypeError, ErrorMessage(Text, (:<>:), ShowType) )+import Miso.Css.List ( IsSubSet )+import Miso.Css.Prelude+ ( KnownSymbol, Bool(False, True), Maybe(Nothing, Just), Proxy )+import Miso.Css.Segment+ ( MatchScope(JustNow, NowOrLater), Seg, SubSeg(B) )+++type family MatchSiblingElemCaseMts mts p where+ MatchSiblingElemCaseMts JustNow p = Just '( JustNow, B : p)+ MatchSiblingElemCaseMts NowOrLater _p = Nothing++type family MatchSiblingElemCaseIsSubSet iss mts p where+ MatchSiblingElemCaseIsSubSet True _ _ = '( True, Nothing)+ MatchSiblingElemCaseIsSubSet False mts p = '( False, MatchSiblingElemCaseMts mts p)++type family MatchSiblingElem sibling mts_p where+ MatchSiblingElem _el '( mts, B : p) = '( False, Just '( mts, B : p))+ MatchSiblingElem el '( mts, p) = -- el :: [SubSug] , p :: [SubSeg]+ MatchSiblingElemCaseIsSubSet (IsSubSet p el) mts p++type family MatchSiblingBranchCase mser es p ps where+ MatchSiblingBranchCase '( True, _) es _p ps = MatchSiblingBranch es ps+ MatchSiblingBranchCase '( False, Nothing) es p ps = MatchSiblingBranch es (p:ps)+ MatchSiblingBranchCase '( False, Just p') _es p ps = p' : ps++type family MatchSiblingBranch siblings branch where+ MatchSiblingBranch _ '[] = '[]+ MatchSiblingBranch '[] p = '( JustNow, '[ B]) : p+ MatchSiblingBranch (e:es) (p:ps) =+ MatchSiblingBranchCase (MatchSiblingElem e p) es p ps++type family MatchSiblingsCase b r siblings bs where+ MatchSiblingsCase '[] _ _ _ = '[]+ MatchSiblingsCase b' r siblings bs = MatchSiblings (b' : r) siblings bs++type family MatchSiblings r siblings bs where+ MatchSiblings r _ '[] = r+ MatchSiblings r siblings (b:bs) =+ MatchSiblingsCase (MatchSiblingBranch siblings b) r siblings bs++data Sibling (ms :: MatchScope) (ss :: [SubSeg]) where+ NilSib :: Proxy ms -> Sibling ms '[]+ AddSib :: KnownSymbol t => Proxy c -> Proxy t -> Sibling ms ss -> Sibling ms (c t : ss)++data SiblingBranch (sgs :: [(MatchScope, [SubSeg])]) where+ NilSibBranch :: SiblingBranch '[]+ AddSegToSibBranch :: Sibling ms ss -> SiblingBranch sgs -> SiblingBranch ( '( ms, ss) : sgs)++type AddSiblingBr :: [(MatchScope, [SubSeg])] -> [Seg] -> [Seg]+type family AddSiblingBr sgs ac where+ AddSiblingBr sgs '[] =+ -- unreachable+ TypeError (Text "AddSiblingBr " :<>: ShowType sgs :<>: Text " to empty list")+ AddSiblingBr sgs ( '( mtScope, um, m, sib) : t) =+ ( '( mtScope, um, m, sgs : sib) : t)
+ src/Miso/Css/Style.hs view
@@ -0,0 +1,13 @@+-- {-# OPTIONS_GHC -ddump-splices #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE TypeAbstractions #-}++module Miso.Css.Style (module X) where++import Miso.Css.Style.E as X+import Miso.Css.Style.OrClass as X+import Miso.Css.Style.AncestorConstraint as X
+ src/Miso/Css/Style/AncestorConstraint.hs view
@@ -0,0 +1,22 @@+module Miso.Css.Style.AncestorConstraint where++import Miso.Css.Prelude ( KnownSymbol, Proxy )+import Miso.Css.Segment+import Miso.Css.Sibling ( AddSiblingBr, SiblingBranch )+++data AncestorConstraint (p :: [Seg]) where+ CssOrphan :: Proxy ms -> AncestorConstraint '[ '( ms, '[], '[], '[] )]+ AddRoot ::+ AncestorConstraint ac -> AncestorConstraint (AddSubSeg R ac)+ AddSiblingBranch ::+ SiblingBranch sgs ->+ AncestorConstraint ac ->+ AncestorConstraint (AddSiblingBr sgs ac)+ NextAncestor :: -- CSS star+ Proxy ms ->+ AncestorConstraint ac ->+ AncestorConstraint ('( ms, '[], '[], '[]) : ac)+ AddSubSegConstraint ::+ KnownSymbol a =>+ Proxy c -> Proxy a -> AncestorConstraint ac -> AncestorConstraint (AddSubSeg (c a) ac)
+ src/Miso/Css/Style/E.hs view
@@ -0,0 +1,197 @@+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE UndecidableInstances #-}++module Miso.Css.Style.E where++import Data.String ( IsString(..) )+import Data.Type.Bool ( If )+import Miso ( MisoString, ms, View )+import Miso.Css.Event (EventFactory)+import Miso.Css.List ( MergeUniq, Elem, PrependMb, Append )+import Miso.Css.Prelude+import Miso.Css.Segment+ ( ApplyClass,+ ApplySubSegsToElem,+ BRANCH,+ MbSymToMbI,+ SubSeg(C, R, I, T, A) )++import Miso.Css.Style.OrClass ( OrClass )+import Miso.Css.Style.PostAppend qualified as Post+import Miso.Css.Style.PreAppend qualified as Pre+import Miso.JSON ( ToJSON )++data ElementId (ei :: Symbol)++newtype ElAtr k v = ElAtr v deriving newtype (Eq, Ord, Show, ToJSON) deriving (Generic)++elAtrKey :: forall k v. KnownSymbol k => ElAtr k v -> MisoString+elAtrKey _ = ms $ symbolVal (Proxy @k)++elAtrVal :: forall {k1} {k2 :: k1} {v}. ElAtr k2 v -> v+elAtrVal (ElAtr v) = v++type family AppendChild children ceacs pcls peacs where+ AppendChild children ceacs '[] peacs =+ (Append (Post.MapMaybeFilterOutFullyMatchedHead children ceacs) peacs)+ AppendChild children ceacs (pclsH : pcls') peacs =+ AppendChild children (ApplyClass '[] pclsH ceacs) pcls' peacs++type family SymsToSubSeg l where+ SymsToSubSeg '[] = '[]+ SymsToSubSeg (h : l) = C h : SymsToSubSeg l++type family SymsToAtrs l where+ SymsToAtrs '[] = '[]+ SymsToAtrs (h : l) = A h : SymsToAtrs l++data ElementStructure = Atomic | Composite++newtype DuplicatedID = DuplicatedId Symbol++data KnownIDS = KnownIds { duplicatedIds :: [DuplicatedID], knownIds :: [Symbol] }++type family DuplicatedIds kids where+ DuplicatedIds (KnownIds dids _) = dids++type family AddTagId x kids where+ AddTagId x (KnownIds dids kids) =+ If (Elem x kids)+ (KnownIds (DuplicatedId x : dids) kids)+ (KnownIds dids (x : kids))++type family MergeKidsCase r didsA didsB kidsA kidsB where+ MergeKidsCase (Left e) didsA didsB kidsA kidsB =+ KnownIds+ (DuplicatedId e : Append didsA didsB)+ (Append kidsA kidsB)+ MergeKidsCase (Right kidsAB) didsA didsB _kidsA _kidsB =+ KnownIds+ (Append didsA didsB)+ kidsAB++type family MergeKids a b where+ MergeKids (KnownIds didsA kidsA) (KnownIds didsB kidsB) =+ MergeKidsCase (MergeUniq kidsA kidsB '[]) didsA didsB kidsA kidsB++type EmptyKids = KnownIds '[] '[]++type CD = "CDATA"+type RMV = "RawMisoView"+type HTML = "html"+type BODY = "body"+data Root = Root deriving (Show, Eq)++type ConstraintsAfterAppend ::+ [[SubSeg]] -> [[BRANCH]] ->+ Maybe Symbol -> Symbol -> [Symbol] -> [Symbol] ->+ [[BRANCH]] -> [[BRANCH]]+type family ConstraintsAfterAppend pchildren ceacs pi pe pAtrs pcls peacs where+ ConstraintsAfterAppend pchildren ceacs pi pe pAtrs pcls peacs =+ AppendChild+ pchildren+ (Pre.MapMaybeFilterOutFullyMatchedHead '[] ceacs)+ (PrependMb+ (MbSymToMbI pi)+ (T pe : Append (SymsToAtrs pAtrs) (SymsToSubSeg pcls)))+ peacs++type family ChildrenConstrAfterAppend ci ce ccls pchildren where+ ChildrenConstrAfterAppend ci ce ccls pchildren =+ PrependMb (MbSymToMbI ci) (T ce : SymsToSubSeg ccls) : pchildren++type family ConstraintsAfterClassApp ei en atrs cls p c eacs where+ ConstraintsAfterClassApp ei en atrs cls p c eacs =+ ApplyClass+ (ApplySubSegsToElem+ (PrependMb+ (MbSymToMbI ei)+ (T en : A "class" : Append (SymsToAtrs atrs) (SymsToSubSeg cls)))+ p)+ (C c)+ eacs++type family ConstraintsAfteId ei eacs where+ ConstraintsAfteId ei eacs = ApplyClass '[] (A "id") (ApplyClass '[] (I ei) eacs)++data E+ model+ action+ (en :: Symbol)+ (es :: ElementStructure)+ (re :: Maybe Root)+ (ei :: Maybe Symbol)+ (atrs :: [Symbol])+ (knownIds :: KnownIDS)+ (cls :: [Symbol])+ (l :: [[BRANCH]])+ (children :: [[SubSeg]])+ where+ RawMisoView ::+ View model action ->+ E model action RMV Atomic Nothing Nothing '[] EmptyKids '[] '[] '[]+ CDataE ::+ MisoString ->+ E model action CD Atomic Nothing Nothing '[] EmptyKids '[] '[] '[]+ NilE :: KnownSymbol en =>+ Proxy en ->+ E model action en Composite Nothing Nothing '[] EmptyKids '[] '[] '[]+ AddAtrE :: (KnownSymbol k, ToJSON v) =>+ ElAtr k v ->+ E model action en Composite r ei atrs kids cls eacs children ->+ E model action en Composite r ei (k : atrs) kids cls+ (ApplyClass '[] (A k) eacs)+ children+ IdE :: KnownSymbol ei =>+ Proxy ei ->+ E model action en Composite r Nothing atrs kids cls eacs children ->+ E model action en Composite r (Just ei) ("id" : atrs)+ (AddTagId ei kids)+ cls+ (ConstraintsAfteId ei eacs)+ children+ BindEventE :: EventFactory ef action =>+ ef ->+ E model action en es r ei atrs kids cls eacs children ->+ E model action en es r ei atrs kids cls eacs children+ AppClsE :: (KnownSymbol en, KnownSymbol c) =>+ OrClass p c ->+ E model action en Composite r ei atrs kIds cls eacs children ->+ E model action en Composite r ei ("class" : atrs) kIds (c : cls)+ (ConstraintsAfterClassApp ei en atrs cls p c eacs)+ children+ AppendChildE :: KnownSymbol ce =>+ E model action ce cs Nothing ci cAtrs ckIds ccls ceacs cchildren ->+ E model action pe Composite r pi pAtrs pkIds pcls peacs pchildren ->+ E model action pe Composite r pi pAtrs+ (MergeKids ckIds pkIds)+ pcls+ (ConstraintsAfterAppend pchildren ceacs pi pe pAtrs pcls peacs)+ (ChildrenConstrAfterAppend ci ce ccls pchildren)+ -- Miso can render view up to body to support :root the library provide+ -- VirtualBodyE and SealDomE to emulate top DOM elements (body and html) without+ -- generating them because the already exist+ VirtualBodyE ::+ E model action ce cs Nothing ci catrs ckids ccls ceacs cchildren ->+ E model action BODY Composite Nothing Nothing catrs+ ckids+ '[]+ (AppendChild+ '[] -- pchildren+ ceacs+ '[ T BODY ]+ '[])+ '[ PrependMb (MbSymToMbI ci) (T ce : SymsToSubSeg ccls) ]+ SealDomE ::+ E model action ce cs Nothing ci catrs ckids ccls ceacs cchildren ->+ E model action HTML Composite (Just 'Root) Nothing catrs+ ckids+ '[]+ (Post.MapMaybeFilterOutFullyMatchedHead+ '[]+ (ApplyClass '[] (T HTML) (ApplyClass '[] R ceacs)))+ '[ PrependMb (MbSymToMbI ci) (T ce : SymsToSubSeg ccls) ]++instance IsString (E model action CD Atomic Nothing Nothing '[] EmptyKids '[] '[] '[]) where+ fromString = CDataE . ms
+ src/Miso/Css/Style/OrClass.hs view
@@ -0,0 +1,14 @@+module Miso.Css.Style.OrClass where++import Miso.Css.Prelude+import Miso.Css.Segment+import Miso.Css.Style.AncestorConstraint ( AncestorConstraint )++-- | 'OrClass' describes all selector prefixes+-- possible for the last selector segment+data OrClass+ (p :: [[Seg]])+ (c :: Symbol)+ where+ TopOrClass :: KnownSymbol c => Proxy c -> OrClass '[] c+ AddAncestorBranch :: AncestorConstraint ac -> OrClass bs c -> OrClass (ac ': bs) c
+ src/Miso/Css/Style/PostAppend.hs view
@@ -0,0 +1,103 @@+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}++module Miso.Css.Style.PostAppend where++import Miso.Css.List ( Append )+import Miso.Css.Segment+ ( BRANCH(Branch),+ MatchScope(NowOrLater, JustNow, AutoClean),+ SubSeg(B) )+import Miso.Css.Sibling ( MatchSiblings )+++type family FilterOutFullyMatchedHeadCaseSibling+ siblingBranches siblings firstBranchTail r mts matched bs+ where+ FilterOutFullyMatchedHeadCaseSibling '[] siblings firstBranchTail r _mts _matched bs =+ FilterOutFullyMatchedHead+ siblings+ (Branch firstBranchTail : r)+ bs+ FilterOutFullyMatchedHeadCaseSibling unmatchedSiblingBranches siblings firstBranchTail r mts matched bs =+ FilterOutFullyMatchedHead+ siblings+ (Branch ('(mts, '[ B], matched, unmatchedSiblingBranches) : firstBranchTail) : r)+ bs++type FilterOutFullyMatchedHead :: [[SubSeg]] -> [BRANCH] -> [BRANCH] -> [BRANCH]+type family FilterOutFullyMatchedHead siblings r bs where+ FilterOutFullyMatchedHead _siblings r '[] = r+ -- empty branch+ FilterOutFullyMatchedHead _siblings _r (Branch '[] : _t) = '[]+ -- matched last branch segment+ FilterOutFullyMatchedHead _siblings _r+ (Branch '[ '( _mts, '[], _matched, '[]) ] : _bs) = '[]++ -- reset segment and copy branch if previous tag relation in NOL+ -- and current relation is JN+ FilterOutFullyMatchedHead siblings r+ (Branch ( '(NowOrLater, '[], matched, '[])+ : '(JustNow, m_next, um_next, sib_next)+ : firstBranchTail+ )+ : bs+ ) =+ FilterOutFullyMatchedHead+ siblings+ ( Branch ( '(JustNow, m_next, um_next, sib_next)+ : firstBranchTail)+ : Branch ( '(NowOrLater, matched, '[], '[])+ : '(JustNow, m_next, um_next, sib_next)+ : firstBranchTail)+ : r+ ) bs++ -- matched head seg in branch+ FilterOutFullyMatchedHead siblings r+ (Branch ( '(mts, '[], _matched, '[]) : firstBranchTail) : bs) =+ FilterOutFullyMatchedHead siblings (Branch firstBranchTail : r) bs+ -- filter siblings after all+ FilterOutFullyMatchedHead siblings r+ (Branch ( '(mts, '[], matched, siblingBranches) : firstBranchTail) : bs) =+ FilterOutFullyMatchedHeadCaseSibling+ (MatchSiblings '[] siblings siblingBranches)+ siblings firstBranchTail r mts matched bs++ -- skip locked+ FilterOutFullyMatchedHead siblings r+ (Branch ( '(_mts, B : unMatched, matched, sib) : firstBranchTail) : bs) =+ FilterOutFullyMatchedHead+ siblings+ (Branch ( '(_mts, B : unMatched, matched, sib) : firstBranchTail) : r) bs++ -- reset+ FilterOutFullyMatchedHead siblings r+ (Branch ( '(NowOrLater, unMatched, matched, sib) : firstBranchTail) : bs) =+ FilterOutFullyMatchedHead siblings+ (Branch ( '(NowOrLater, Append unMatched matched, '[], sib) : firstBranchTail) : r) bs++ -- lock+ FilterOutFullyMatchedHead siblings r+ (Branch ( '(JustNow, unMatched, matched, sib) : firstBranchTail) : bs) =+ FilterOutFullyMatchedHead siblings+ (Branch ( '(JustNow, B : unMatched, matched, sib) : firstBranchTail) : r) bs++ FilterOutFullyMatchedHead siblings r+ (Branch ( '(AutoClean, unMatched, matched, sib) : firstBranchTail) : bs) =+ FilterOutFullyMatchedHead siblings+ (Branch ( '(AutoClean, B : unMatched, matched, sib) : firstBranchTail) : r) bs++type family MapMaybeFilterOutFullyMatchedHeadCase elems children t where+ MapMaybeFilterOutFullyMatchedHeadCase '[] children t =+ MapMaybeFilterOutFullyMatchedHead children t+ MapMaybeFilterOutFullyMatchedHeadCase h children t =+ h : MapMaybeFilterOutFullyMatchedHead children t++type family MapMaybeFilterOutFullyMatchedHead children eacs where+ MapMaybeFilterOutFullyMatchedHead _ '[] = '[]+ MapMaybeFilterOutFullyMatchedHead children (h : t) =+ MapMaybeFilterOutFullyMatchedHeadCase+ (FilterOutFullyMatchedHead children '[] h)+ children+ t
+ src/Miso/Css/Style/PreAppend.hs view
@@ -0,0 +1,75 @@+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}++module Miso.Css.Style.PreAppend where++import Miso.Css.Segment+ ( BRANCH(Branch), MatchScope(AutoClean), SubSeg(B) )+import Miso.Css.Sibling ( MatchSiblings )+++type family FilterOutFullyMatchedHeadCaseSibling+ siblingBranches siblings firstBranchTail r mts matched bs+ where+ FilterOutFullyMatchedHeadCaseSibling '[] siblings firstBranchTail r _mts _matched bs =+ FilterOutFullyMatchedHead siblings (Branch firstBranchTail : r) bs+ FilterOutFullyMatchedHeadCaseSibling unmatchedSiblingBranches siblings firstBranchTail r mts matched bs =+ FilterOutFullyMatchedHead+ siblings+ (Branch ( '(mts, '[ B], matched, unmatchedSiblingBranches) : firstBranchTail) : r)++ bs++type FilterOutFullyMatchedHead :: [[SubSeg]] -> [BRANCH] -> [BRANCH] -> [BRANCH]+type family FilterOutFullyMatchedHead siblings r bs where+ FilterOutFullyMatchedHead _siblings r '[] = r+ -- empty branch+ FilterOutFullyMatchedHead _siblings _r (Branch '[] : _t) = '[]+ -- matched last branch segment+ FilterOutFullyMatchedHead _siblings _r+ (Branch '[ '(AutoClean, '[], _matched, '[]) ] : _bs) = '[]+ -- matched head seg in branch+ FilterOutFullyMatchedHead siblings r+ (Branch ( '(AutoClean, '[], _matched, '[]) : firstBranchTail) : bs) =+ FilterOutFullyMatchedHead siblings (Branch firstBranchTail : r) bs+ -- filter siblings after all+ FilterOutFullyMatchedHead siblings r+ (Branch ( '(AutoClean, '[], matched, siblingBranches) : firstBranchTail) : bs) =+ FilterOutFullyMatchedHeadCaseSibling+ (MatchSiblings '[] siblings siblingBranches)+ siblings firstBranchTail r AutoClean matched bs++ -- skip locked+ FilterOutFullyMatchedHead siblings r+ (Branch ( '(mts, B : unMatched, matched, sib) : firstBranchTail) : bs) =+ FilterOutFullyMatchedHead+ siblings+ (Branch ( '(mts, B : unMatched, matched, sib) : firstBranchTail) : r) bs++ -- lock+ FilterOutFullyMatchedHead siblings r+ (Branch ( '(AutoClean, unMatched, matched, sib) : firstBranchTail) : bs) =+ FilterOutFullyMatchedHead+ siblings+ (Branch ( '(AutoClean, B : unMatched, matched, sib) : firstBranchTail) : r) bs++ -- skip the rest (ie non AutoClean)+ FilterOutFullyMatchedHead siblings r+ (Branch ( '(mts, unMatched, matched, sib) : firstBranchTail) : bs) =+ FilterOutFullyMatchedHead+ siblings+ (Branch ( '(mts, unMatched, matched, sib) : firstBranchTail) : r) bs++type family MapMaybeFilterOutFullyMatchedHeadCase elems children t where+ MapMaybeFilterOutFullyMatchedHeadCase '[] children t =+ MapMaybeFilterOutFullyMatchedHead children t+ MapMaybeFilterOutFullyMatchedHeadCase h children t =+ h : MapMaybeFilterOutFullyMatchedHead children t++type family MapMaybeFilterOutFullyMatchedHead children eacs where+ MapMaybeFilterOutFullyMatchedHead _ '[] = '[]+ MapMaybeFilterOutFullyMatchedHead children (h : t) =+ MapMaybeFilterOutFullyMatchedHeadCase+ (FilterOutFullyMatchedHead children '[] h)+ children+ t
+ src/Miso/Css/Tags.hs view
@@ -0,0 +1,94 @@+module Miso.Css.Tags where++import Miso.Css.Prelude ( Maybe(Nothing), Proxy(Proxy) )+import Miso.Css.Style ( E(NilE), ElementStructure(Composite), EmptyKids )++div_ :: E model action "div" Composite Nothing Nothing '[] EmptyKids '[] '[] '[]+div_ = NilE (Proxy @"div")++span_ :: E model action "span" Composite Nothing Nothing '[] EmptyKids '[] '[] '[]+span_ = NilE (Proxy @"span")++p_ :: E model action "p" Composite Nothing Nothing '[] EmptyKids '[] '[] '[]+p_ = NilE (Proxy @"p")++b_ :: E model action "b" Composite Nothing Nothing '[] EmptyKids '[] '[] '[]+b_ = NilE (Proxy @"b")++i_ :: E model action "i" Composite Nothing Nothing '[] EmptyKids '[] '[] '[]+i_ = NilE (Proxy @"i")++th_ :: E model action "th" Composite Nothing Nothing '[] EmptyKids '[] '[] '[]+th_ = NilE (Proxy @"th")++td_ :: E model action "td" Composite Nothing Nothing '[] EmptyKids '[] '[] '[]+td_ = NilE (Proxy @"td")++table_ :: E model action "table" Composite Nothing Nothing '[] EmptyKids '[] '[] '[]+table_ = NilE (Proxy @"table")++thead_ :: E model action "thead" Composite Nothing Nothing '[] EmptyKids '[] '[] '[]+thead_ = NilE (Proxy @"thead")++tbody_ :: E model action "tbody" Composite Nothing Nothing '[] EmptyKids '[] '[] '[]+tbody_ = NilE (Proxy @"tbody")++tr_ :: E model action "tr" Composite Nothing Nothing '[] EmptyKids '[] '[] '[]+tr_ = NilE (Proxy @"tr")++h1_ :: E model action "h1" Composite Nothing Nothing '[] EmptyKids '[] '[] '[]+h1_ = NilE (Proxy @"h1")++img_ :: E model action "img" Composite Nothing Nothing '[] EmptyKids '[] '[] '[]+img_ = NilE (Proxy @"img")++br_ :: E model action "br" Composite Nothing Nothing '[] EmptyKids '[] '[] '[]+br_ = NilE (Proxy @"br")++hr_ :: E model action "hr" Composite Nothing Nothing '[] EmptyKids '[] '[] '[]+hr_ = NilE (Proxy @"hr")++ul_ :: E model action "ul" Composite Nothing Nothing '[] EmptyKids '[] '[] '[]+ul_ = NilE (Proxy @"ul")++ol_ :: E model action "ol" Composite Nothing Nothing '[] EmptyKids '[] '[] '[]+ol_ = NilE (Proxy @"ol")++li_ :: E model action "li" Composite Nothing Nothing '[] EmptyKids '[] '[] '[]+li_ = NilE (Proxy @"li")++a_ :: E model action "a" Composite Nothing Nothing '[] EmptyKids '[] '[] '[]+a_ = NilE (Proxy @"a")++article_ :: E model action "article" Composite Nothing Nothing '[] EmptyKids '[] '[] '[]+article_ = NilE (Proxy @"article")++section_ :: E model action "section" Composite Nothing Nothing '[] EmptyKids '[] '[] '[]+section_ = NilE (Proxy @"section")++h2_ :: E model action "h2" Composite Nothing Nothing '[] EmptyKids '[] '[] '[]+h2_ = NilE (Proxy @"h2")++h3_ :: E model action "h3" Composite Nothing Nothing '[] EmptyKids '[] '[] '[]+h3_ = NilE (Proxy @"h3")++h4_ :: E model action "h4" Composite Nothing Nothing '[] EmptyKids '[] '[] '[]+h4_ = NilE (Proxy @"h4")++h5_ :: E model action "h5" Composite Nothing Nothing '[] EmptyKids '[] '[] '[]+h5_ = NilE (Proxy @"h5")++h6_ :: E model action "h6" Composite Nothing Nothing '[] EmptyKids '[] '[] '[]+h6_ = NilE (Proxy @"h6")++form_ :: E model action "form" Composite Nothing Nothing '[] EmptyKids '[] '[] '[]+form_ = NilE (Proxy @"form")++input_ :: E model action "input" Composite Nothing Nothing '[] EmptyKids '[] '[] '[]+input_ = NilE (Proxy @"input")++button_ :: E model action "button" Composite Nothing Nothing '[] EmptyKids '[] '[] '[]+button_ = NilE (Proxy @"button")++label_ :: E model action "label" Composite Nothing Nothing '[] EmptyKids '[] '[] '[]+label_ = NilE (Proxy @"label")
+ test/Discovery.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF tasty-discover -optF --generated-module=Discovery #-}
+ test/Driver.hs view
@@ -0,0 +1,13 @@+module Driver where++import qualified Discovery+import Prelude+import Test.Tasty ( defaultMain, testGroup, TestTree )++main :: IO ()+main = defaultMain =<< testTree+ where+ testTree :: IO TestTree+ testTree = do+ tests <- Discovery.tests+ pure $ testGroup "css-class-bindings" [ tests ]
+ test/Miso/Css/Test/BindEventHandlers.hs view
@@ -0,0 +1,11 @@+module Miso.Css.Test.BindEventHandlers where++import Miso.Css.Test.StyleMock+++test_t = testGroup "bind event handlers"+ [ """<div ></div>""" `go` div_ =! onClick ()+ , """<button ></button>""" `go` button_ =! onKeyPress (const ())+ , """<input name="comment"/>""" `go`+ input_ =! onChange (const ()) =<| atr @"name" ("comment" :: MisoString)+ ]
+ test/Miso/Css/Test/HelloWorld.hs view
@@ -0,0 +1,43 @@+{-# LANGUAGE QuasiQuotes #-}+{-# OPTIONS_GHC -Wno-missing-signatures #-}+module Miso.Css.Test.HelloWorld where++import Miso ( component, App, CSS(Style), Component(styles), View )+import Miso.Css+import Prelude++type Model = ()+type Action = ()++-- default name is "cssAsLiteralText"+renameCssTextConst "cssFromQq"++[css|+.a .b .c {+ color: #fc2c2c;+}+|]++-- instead of quasi-quoted CSS+-- the whole CSS file can be included with:+-- includeCss "assets/style.css"++app :: App Model Action+app = (component () pure viewModel)+ { styles = [ Style cssFromQq ] }++{-+ <div class="a">+ <div class="b">+ <button class="b">+ Submit+ </button>+ </div>+ </div>+-}+viewModel :: Model -> View Model Action+viewModel () = toView . html_ . body_ $+ div_ =. a+ </ (div_ =. b+ </ (button_ =. c+ <@ "Submit"))
+ test/Miso/Css/Test/IncludeCssAsserts.hs view
@@ -0,0 +1,24 @@+-- {-# OPTIONS_GHC -ddump-splices #-}+module Miso.Css.Test.IncludeCssAsserts where++import Miso.Css.Test.StyleMock++includeCss "test/style.css"++test_include_css :: TestTree+test_include_css =+ testGroup "IncludeCss"+ [ """<div class="foo"></div>""" `go` div_ =. foo+ , """<div class="foo"><div class="bar"></div></div>""" `go` div_ =. foo </ div_ =. bar+ , testGroup "bad"+ [ doNotTcNoBr [] [[[(JustNow, [C "foo"], [], [])]]] $ div_ =. bar+ ]+ , testCase "golden" (expectedCss @=? style)+ ]+ where+ expectedCss :: String+ expectedCss = """+ .foo > .bar {+ color: #f212ff;+ }+ """ <> "\n"
+ test/Miso/Css/Test/Prelude.hs view
@@ -0,0 +1,17 @@+module Miso.Css.Test.Prelude (module X) where++import Miso as X (MisoString, ms)+import Miso.Css as X ( includeCss )+import Miso.Css.Event as X+import Miso.Css.Gen as X+import Miso.Css.Miso as X+import Miso.Css.Operator as X+import Miso.Css.Prelude as X+import Miso.Css.Qq as X+import Miso.Css.Segment as X+import Miso.Css.Sibling as X+import Miso.Css.Style as X+import Miso.Css.Tags as X+import Miso.Html as X ( ToHtml(toHtml) )+import Test.Tasty as X ( TestTree, testGroup )+import Test.Tasty.HUnit as X ( testCase, (@?=), (@=?) )
+ test/Miso/Css/Test/QqAsserts.hs view
@@ -0,0 +1,38 @@+-- {-# OPTIONS_GHC -ddump-splices #-}+module Miso.Css.Test.QqAsserts where++import Miso.Css.Test.StyleMock++[css|.foo > .bar {+ color: #1212ff;+}|]++renameCssTextConst "css2"+[css|.x {}+|]++renameCssTextConst "classlessSelectors"+[css|+body > div[x] {}+#xxx {}+|]++test_qq :: TestTree+test_qq =+ testGroup "QQ"+ [ """<div class="foo"></div>""" `go` div_ =. foo+ , """<div class="foo"><div class="bar"></div></div>""" `go` div_ =. foo </ div_ =.bar+ , """<div id="xxx"></div>""" `go` div_ =# Xxx+ , testGroup "bad"+ [ doNotTcNoBr [] [[[(JustNow, [C "foo"], [], [])]]] $ div_ =. bar+ ]+ , testCase "golden" (expectedCss @=? cssAsLiteralText)+ , testCase "golden2" ((".x {}\n" :: String) @=? css2)+ ]+ where+ expectedCss :: String+ expectedCss = """+ .foo > .bar {+ color: #1212ff;+ }+ """
+ test/Miso/Css/Test/Style.hs view
@@ -0,0 +1,510 @@+{-# LANGUAGE BlockArguments #-}+module Miso.Css.Test.Style where++import Miso.Css.Test.StyleMock+import Miso.Html qualified as MH+import Miso.Html.Property qualified as MH++test_style :: TestTree+test_style =+ testGroup "Style"+ [ testCase "div_" do+ toHtml (MH.div_ [] []) @?= "<div></div>"+ , testGroup "eToView"+ [ testGroup "empty eacs"+ [ testGroup "bitter"+ [ testGroup "class"+ [ "cdata hello" `go` CDataE "cdata hello"+ -- No instance for ‘ghc-internal-9.1202.0:GHC.Internal.Data.String.IsString+ -- (E en0 es0 cls0 '[])’+ -- arising from the literal ‘"cdata hello"’+ -- , "cdata hello" `go` "cdata hello"+ , "<div></div>" `go` NilE (Proxy @"div")+ , """<div class="c"></div>""" `go`+ AppClsE (TopOrClass (Proxy @"c")) (NilE (Proxy @"div"))+ , """<div class="c">cd</div>""" `go`+ AppendChildE+ (CDataE "cd")+ (AppClsE (TopOrClass (Proxy @"c"))+ (NilE (Proxy @"div")))+ , """<div class="c"><br/></div>""" `go`+ AppendChildE+ (NilE $ Proxy @"br")+ (AppClsE (TopOrClass (Proxy @"c"))+ (NilE (Proxy @"div")))+ , """<div class="a"><div class="b"></div></div>""" `go`+ AppendChildE+ (AppClsE (TopOrClass (Proxy @"b"))+ (NilE $ Proxy @"div"))+ (AppClsE (TopOrClass (Proxy @"a"))+ (NilE (Proxy @"div")))+ ]+ ]+ , testGroup "sweet"+ [ go "<div> </div>" $ div_ <@ ""+ , go """<div class="c"> </div>""" $ div_ =. c <@ ""+ , go """<div class="c">cd</div>""" $+ div_ =. c <@ "cd"+ , go """<div class="c"><hr/></div>""" $ div_ =. c </ hr_+ , go """<div class="a"><div class="b"></div></div>""" $+ div_ =. a </ div_ =. b+ , go """<div class="a"><div class="b"></div><div class="c"></div></div>""" $+ div_ =. a </ div_ =. b </ div_ =. c+ , go """<div class="a"><div class="b"><div class="c"></div></div></div>""" $+ div_ =. a </ (div_ =. b </ div_ =. c)+ ]+ ]+ , testGroup "non-empty-eacs"+ [ testGroup "bitter"+ [ """<div class="a"><div class="b"></div></div>""" `go`+ AppendChildE+ (AppClsE ab (NilE (Proxy @"div")))+ (AppClsE a (NilE (Proxy @"div")))+ , """<div class="a"><div class="b"><div class="c"></div></div></div>""" `go`+ AppendChildE+ (AppendChildE+ (AppClsE abc (NilE (Proxy @"div")))+ (AppClsE b (NilE (Proxy @"div"))))+ (AppClsE a (NilE (Proxy @"div")))+ , """<div class="a"><div class="b"><div class="c"></div></div></div>""" `go`+ AppendChildE+ (AppendChildE+ (AppClsE abc (NilE (Proxy @"div")))+ (AppClsE ab (NilE (Proxy @"div"))))+ (AppClsE a+ (NilE (Proxy @"div")))+ ]+ , testGroup "sweet"+ [ testGroup "tag"+ [ go """<ul><li class="a"></li></ul>""" $+ ul_ </ li_ =. ul_a+ , go """<ul class="a"><li class="b"></li></ul>""" $+ ul_ =. a </ li_ =. ul_and_a_b+ , go """<div><div class="div_child"></div></div>""" $+ div_ </ div_ =. div_child+ , go """<div><ul><div class="div_ul_child"></div></ul></div>""" $+ div_ </ (ul_ </ div_ =. div_ul_child)+ ]+ , testGroup "misc"+ [ testGroup "dangling hierarchy relation"+ [ doNotTcNoBr [] [] $ div_ =. nol_c+ , doNotTcNoBr [] [] $ div_ =. jn_c+ ]+ ]+ , testGroup "star"+ [ go """<div><ul><li class="c"></li></ul></div>""" $+ div_ </ (ul_ </ li_ =. star_dir_star_dir_c)+ ]+ , testGroup ":root"+ [ go """<div class="a"><div class="b"></div></div>"""+ (SealDomE (div_ =. a </ div_ =. root_b))+ , go """<div class="b"></div>""" $+ page (div_ =. root_b)+ , go """<div><div class="b"></div></div>"""+ (SealDomE $ VirtualBodyE (div_ </ div_ =. root_b))+ , go """<div class="a"><div class="b"></div></div>""" $+ page (div_ =. a </ div_ =. root_dir_body_dir_a_dir_b)+ ]+ , testGroup "sibling"+ [ testGroup "adjacent"+ [ go """<div><div class="a"></div><div class="b"></div></div>""" $+ div_ </ div_ =. a </ div_ =. a_dirSib_b+ , testGroup ".a + .b"+ [ doNotTcNoBr [] [[[(NowOrLater, [B], [], [[(JustNow, [B]), (JustNow, [C "a"])]])]]] $+ div_ </ div_ =. a_dirSib_b+ ]+ , go """<div><div class="a"></div><div class="b"><div class="c"></div></div></div>""" $+ div_ </ div_ =. a </ (div_ =. b </ div_ =. a_dirSib_b_dir_c)+ , testGroup "div between a and b"+ [ doNotTcNoBr [] [[[(JustNow, [B], [], [[(JustNow, [B, C "a"])]])]]] $+ div_ </ div_ =. a </ div_ </ (div_ =. b </ div_ =. a_dirSib_b_dir_c)+ ]+ , testGroup "a missing"+ [ doNotTcNoBr [] [[[(JustNow, [B], [], [[(JustNow, [B, C "a"])]])]]] $+ div_ </ div_ </ (div_ =. b </ div_ =. a_dirSib_b_dir_c)+ ]+ , testGroup "a and b are flipped"+ [ doNotTcNoBr [] [[[(JustNow, [B], [], [[(JustNow, [B]), (JustNow, [C "a"])]])]]] $+ div_ </ (div_ =. b </ div_ =. a_dirSib_b_dir_c) </ div_ =. a+ ]+ , testGroup "b missing"+ [ doNotTcNoBr [] [[[(JustNow, [B, C "b"], [], []),(JustNow, [], [], [[ (JustNow, [C "a"])]])]]] $+ div_ </ div_ =. a </ (div_ </ div_ =. a_dirSib_b_dir_c)+ ]+ , testGroup "b in root 1"+ [ doNotTcNoBr [] [[[(JustNow, [B], [], [[(JustNow, [B]), (JustNow, [C "a"])]])]]] $+ div_ =. b </ div_ =. a </ div_ =. a_dirSib_b_dir_c+ ]+ , testGroup "b in root 2"+ [ doNotTcNoBr [] [[[(JustNow, [B], [C "b"], []), (JustNow, [], [], [[ (JustNow, [C "a"])]])]]] $+ div_ =. b </ div_ =. a </ (div_ </ div_ =. a_dirSib_b_dir_c)+ ]+ , testGroup "b with c 1"+ [ doNotTcNoBr [] [[[(JustNow, [B, C "b"], [], []), (JustNow, [], [], [[ (JustNow, [C "a"])]])]]] $+ div_ </ div_ =. a </ div_ =. a_dirSib_b_dir_c =. b+ ]+ , testGroup "b with c 2"+ [ doNotTcNoBr [] [[[(JustNow, [B, C "b"], [], []), (JustNow, [], [], [[ (JustNow, [C "a"])]])]]] $+ div_ </ div_ =. a </ (div_ </ div_ =. a_dirSib_b_dir_c =. b)+ ]+ , testGroup "c is wrapped in div"+ [ doNotTcNoBr [] [[[(JustNow, [B], [C "b"], []), (JustNow, [], [], [[(JustNow, [C "a"])]])]]] $+ div_ </ div_ =. a </ (div_ =. b </ (div_ </ div_ =. a_dirSib_b_dir_c))+ ]+ , go """<div><div class="a"></div><div class="b"></div><div class="c"></div></div>""" $+ div_ </ div_ =. a </ div_ =. b </ div_ =. a_dirSib_b_dirSib_c+ , testGroup "flipped a and b"+ [ doNotTcNoBr [] [[[(JustNow, [B], [], [[(JustNow, [B, C "b"]), (JustNow, [C "a"])]])]]] $+ div_ </ div_ =. b </ div_ =. a </ div_ =. a_dirSib_b_dirSib_c+ ]+ , testGroup "extra elem between a and b"+ [ doNotTcNoBr [] [[[(JustNow, [B], [], [[(JustNow, [B, C "a"])]])]]] $+ div_ </ div_ =. a </ div_ </ div_ =. b </ div_ =. a_dirSib_b_dirSib_c+ ]+ , testGroup "extra elem between b and c"+ [ doNotTcNoBr [] [[[(JustNow, [B], [], [[(JustNow, [B, C "b"]), (JustNow, [C "a"])]])]]] $+ div_ </ div_ =. a </ div_ =. b </ div_ </ div_ =. a_dirSib_b_dirSib_c+ ]+ , testGroup "missing a class"+ [ doNotTcNoBr [] [[[(JustNow, [B], [], [[(JustNow, [B, C "a"])]])]]] $+ div_ </ div_ </ div_ =. b </ div_ =. a_dirSib_b_dirSib_c+ ]+ , testGroup "missing a tag"+ [ doNotTcNoBr [] [[[(JustNow, [B], [], [[(JustNow, [B]), (JustNow, [C "a"])]])]]] $+ div_ </ div_ =. b </ div_ =. a_dirSib_b_dirSib_c+ ]+ , testGroup "missing b tag"+ [ doNotTcNoBr [] [[[(JustNow, [B], [], [[(JustNow, [B, C "b"]), (JustNow, [C "a"])]])]]] $+ div_ </ div_ =. a </ div_ =. a_dirSib_b_dirSib_c+ ]+ , go """<div class="c"><div class="a"></div><div class="b"></div></div>""" $+ div_ =. c </ div_ =. a </ div_ =. c_dir_a_dirSib_b+ , go """<div class="c"><div class="b"></div><div class="a"></div><div class="b"></div></div>""" $+ div_ =. c </ div_ =. b </ div_ =. a </ div_ =. c_dir_a_dirSib_b+ , go """<div class="c"><div></div><div class="a"></div><div class="b"></div></div>""" $+ div_ =. c </ div_ </ div_ =. a </ div_ =. c_dir_a_dirSib_b+ , go """<div class="c"><div class="a"></div><div class="b"></div><div></div></div>""" $+ div_ =. c </ div_ =. a </ div_ =. c_dir_a_dirSib_b </ div_+ , go """<div class="c"><div class="a"></div><div class="b"><div class="d"></div></div></div>""" $+ div_ =. c </ div_ =. a </ (div_ =. b </ div_ =. c_dir_a_dirSib_b_spc_d)+ , go """<div class="c"><div class="a"></div><div class="b"><div><div class="d"></div></div></div></div>""" $+ div_ =. c </ div_ =. a </ (div_ =. b </ (div_ </ div_ =. c_dir_a_dirSib_b_spc_d))+ , testGroup "parent c is missing"+ [ doNotTcNoBr [] [[[(JustNow, [B, C "c"], [], [[(JustNow, [C "a"])]])]]] $+ div_ </ div_ =. a </ div_ =. c_dir_a_dirSib_b+ ]+ , testGroup "extra node between .a and .b"+ [ doNotTcNoBr [] [[[(JustNow, [B], [C "c"], [[(JustNow, [B, C "a"])]])]]] $+ div_ =. c </ div_ =. a </ div_ </ div_ =. c_dir_a_dirSib_b+ ]+ , testGroup "extra node between .c and .a + .b"+ [ doNotTcNoBr [] [[[(JustNow, [B], [C "c"], [[(JustNow, [C "a"])]])]]] $+ div_ =. c </ (div_ </ (div_ =. a </ div_ =. c_dir_a_dirSib_b))+ ]+ , testGroup "a and b wrapped into extra div"+ [ doNotTcNoBr []+ [[ [ (NowOrLater, [C "b"], [], [])+ , (JustNow, [C "c"], [], [ [ (JustNow, [C "a"])]]) ]+ , [ (JustNow, [B], [C "c"], [ [ (JustNow, [C "a"])]]) ]+ ]] $+ div_ =. c </ (div_ </ div_ =. a </ (div_ =. b </ div_ =. c_dir_a_dirSib_b_spc_d))+ ]+ , testGroup "parent c is missing"+ [ doNotTcNoBr []+ [[ [ (NowOrLater, [C "b"], [], [])+ , (JustNow, [C "c"], [], [ [ (JustNow, [C "a"])]]) ]+ , [ (JustNow, [B, C "c"], [], [ [ (JustNow, [C "a"])]]) ]+ ]] $+ div_ </ div_ =. a </ (div_ =. b </ div_ =. c_dir_a_dirSib_b_spc_d)+ ]+ , go """<div><div class="a b"></div><div class="c"></div></div>""" $+ div_ </ div_ =. a =. b </ div_ =. a_with_b_dirSib_c+ ]+ , testGroup "general"+ [ go """<div><div class="a"></div><span></span><div class="b"></div></div>""" $+ div_ </ div_ =. a </ span_ </ div_ =. a_genSib_b+ , go """<div><div class="a"></div><div class="b"><div class="c"></div></div></div>""" $+ div_ </ div_ =. a </ (div_ =. b </ div_ =. a_genSib_b_spc_c)+ , go """<div><div class="a"></div><div></div><div class="b"><div class="c"></div></div></div>""" $+ div_ </ div_ =. a </ div_ </ (div_ =. b </ div_ =. a_genSib_b_spc_c)+ , go """<div><div class="a"></div><div></div><div></div><div class="b"><div class="c"></div></div></div>""" $+ div_ </ div_ =. a </ div_ </ div_ </ (div_ =. b </ div_ =. a_genSib_b_spc_c)+ , go """<div><div class="a"></div><div class="b"><div><div class="c"></div></div></div></div>""" $+ div_ </ div_ =. a </ (div_ =. b </ (div_ </ div_ =. a_genSib_b_spc_c))+ , go """<div><div class="a"></div><div class="b"><div><div><div class="c"></div></div></div></div></div>""" $+ div_ </ div_ =. a </ (div_ =. b </ (div_ </ (div_ </ div_ =. a_genSib_b_spc_c)))+ , testGroup "a missing"+ [ doNotTcNoBr [] [[[(NowOrLater, [B], [], [[(JustNow, [B]), (NowOrLater, [C "a"])]])]]] $+ div_ </ div_ </ (div_ =. b </ div_ =. a_genSib_b_spc_c)+ ]+ , testGroup "a in parent"+ [ doNotTcNoBr [] [[[(NowOrLater, [B], [], [[(JustNow, [B]), (NowOrLater, [C "a"])]])]]] $+ div_ =. a </ div_ </ (div_ =. b </ div_ =. a_genSib_b_spc_c)+ ]+ , testGroup "b missing"+ [ doNotTcNoBr [] [[[(NowOrLater, [C "b"], [], []), (NowOrLater, [], [], [[ (NowOrLater, [C "a"])]])]]] $+ div_ </ div_ =. a </ (div_ </ div_ =. a_genSib_b_spc_c)+ ]+ , testGroup "b on same tag with c"+ [ doNotTcNoBr [] [[[(NowOrLater, [C "b"], [], []), (NowOrLater, [], [], [[ (NowOrLater, [C "a"])]])]]] $+ div_ </ div_ =. a </ (div_ </ div_ =. a_genSib_b_spc_c =. b)+ ]+ , go """<div><div class="a"></div><div class="b"></div><div class="c"></div></div>""" $+ div_ </ div_ =. a </ div_ =. b </ div_ =. a_genSib_b_genSib_c+ , testGroup "flipped a and b"+ [ doNotTcNoBr [] [[[(JustNow, [B], [], [[(JustNow, [B]), (NowOrLater, [C "a"])]])]]] $+ div_ </ div_ =. b </ div_ =. a </ div_ =. a_genSib_b_genSib_c+ ]+ , testGroup "extra elem between a and b"+ [ go """<div><div class="a"></div><div></div><div class="b"></div><div class="c"></div></div>""" $+ div_ </ div_ =. a </ div_ </ div_ =. b </ div_ =. a_genSib_b_genSib_c+ ]+ , testGroup "extra elem between b and c"+ [ go """<div><div class="a"></div><div class="b"></div><div></div><div class="c"></div></div>""" $+ div_ </ div_ =. a </ div_ =. b </ div_ </ div_ =. a_genSib_b_genSib_c+ ]+ , testGroup "prepended div before a"+ [ go """<div><div></div><div class="a"></div><div class="b"></div><div class="c"></div></div>""" $+ div_ </ div_ </ div_ =. a </ div_ =. b </ div_ =. a_genSib_b_genSib_c+ ]+ , testGroup "appended div after c"+ [ go """<div><div class="a"></div><div class="b"></div><div class="c"></div><div></div></div>""" $+ div_ </ div_ =. a </ div_ =. b </ div_ =. a_genSib_b_genSib_c </ div_+ ]+ , testGroup "missing a class"+ [ doNotTcNoBr [] [[[(JustNow, [B], [], [[ (JustNow, [B])+ , (NowOrLater, [C "a"])]])]]] $+ div_ </ div_ </ div_ =. b </ div_ =. a_genSib_b_genSib_c+ ]+ , testGroup "missing a tag"+ [ doNotTcNoBr [] [[[(JustNow, [B], [],[[ (JustNow, [B])+ , (NowOrLater, [C "a"])]])]]] $+ div_ </ div_ =. b </ div_ =. a_genSib_b_genSib_c+ ]+ , testGroup "missing b tag"+ [ doNotTcNoBr [] [[[(JustNow, [B], [], [[ (JustNow, [B])+ , (NowOrLater, [C "b"])+ , (NowOrLater, [C "a"])]])]]] $+ div_ </ div_ =. a </ div_ =. a_genSib_b_genSib_c+ ]+ ]+ , testGroup "mix"+ [ go """<div><div></div><p></p><span><div class="a"></div><div class="b"></div></span></div>""" $+ div_ </ div_ </ p_ </ (span_ </ div_ =. a </ div_ =. div_genSib_p_dirSib_span_dir_a_dirSib_b)+ , go """<div><div></div><p></p><p></p><span><div class="a"></div><div class="b"></div></span></div>""" $+ div_ </ div_ </ p_ </ p_ </ (span_ </ div_ =. a </ div_ =. div_genSib_p_dirSib_span_dir_a_dirSib_b)+ , go """<div><div></div><p></p><span><p></p><div class="a"></div><div class="b"></div></span></div>""" $+ div_ </ div_ </ p_ </ (span_ </ p_ </ div_ =. a </ div_ =. div_genSib_p_dirSib_span_dir_a_dirSib_b)+ , testGroup "li tag is between p and span"+ [ doNotTcNoBr [] [[[(JustNow, [B], [], [[(JustNow, [B, T "p"]), (NowOrLater, [T "div"])]])]]] $+ div_ </ div_ </ p_ </ li_ </ (span_ </ div_ =. a </ div_ =. div_genSib_p_dirSib_span_dir_a_dirSib_b)+ ]+ , testGroup ".a and .b are wrapped into extra div"+ [ doNotTcNoBr [] [[[ (JustNow, [B], [T "span"], [ [ (JustNow, [C "a"])]])+ , (JustNow, [], [], [[ (JustNow, [T "p"])+ , (NowOrLater, [T "div"])]])]]] $+ div_ </ div_ </ p_ </ (span_ </ (div_ </ div_ =. a </ div_ =. div_genSib_p_dirSib_span_dir_a_dirSib_b))+ ]+ , go """<div><p></p><span><div class="a"></div><div></div></span></div>""" $+ div_ </ p_ </ (span_ </ div_ =. p_genSib_span_dir_a </ div_)+ , go """<div><div></div><p></p><span><div class="a"></div><div></div></span></div>""" $+ div_ </ div_ </ p_ </ (span_ </ div_ =. div_dirSib_p_genSib_span_dir_a </ div_)+ , """<div><div></div><p></p><span><div class="a"></div><div class="b"></div><div></div></span></div>"""+ `go`+ (div_+ </ div_+ </ p_+ </ (span_+ </ div_ =. p_genSib_span_dir_a+ </ div_ =. div_dirSib_p_genSib_span_dir_a_dirSib_b+ </ div_+ ))+ ]+ , testGroup "mix2"+ [ go """<div><div></div><p></p><span><div class="a"></div><div class="b"></div></span></div>""" $+ div_ </ div_ </ p_ </ (span_ </ div_ =. a </ div_ =. div_dirSib_p_genSib_span_dir_a_dirSib_b)+ , go """<div><li></li><div></div><p></p><span><div class="a"></div><div class="b"></div></span></div>""" $+ div_ </ li_ </ div_ </ p_ </ (span_ </ div_ =. a </ div_ =. div_dirSib_p_genSib_span_dir_a_dirSib_b)+ , go """<div><div></div><p></p><li></li><span><div class="a"></div><div class="b"></div></span></div>""" $+ div_ </ div_ </ p_ </ li_ </ (span_ </ div_ =. a </ div_ =. div_dirSib_p_genSib_span_dir_a_dirSib_b)+ , testGroup "li tag is between div and p"+ [ doNotTcNoBr [] [[[(JustNow, [B], [], [[(JustNow, [B, T "div"])]])]]] $+ div_ </ div_ </ li_ </ p_ </ (span_ </ div_ =. a </ div_ =. div_dirSib_p_genSib_span_dir_a_dirSib_b)+ ]+ , testGroup ".a and .b are wrapped into extra div"+ [ doNotTcNoBr [] [[[ (JustNow, [B], [T "span"], [[(JustNow, [C "a"])]])+ , (JustNow, [], [], [[(NowOrLater, [T "p"]), (JustNow, [T "div"])]])]]] $+ div_ </ div_ </ p_ </ (span_ </ (div_ </ div_ =. a </ div_ =. div_dirSib_p_genSib_span_dir_a_dirSib_b))+ ]+ ]+ ]+ , testGroup "id"+ [ go """<div id="a"></div>""" $ div_ =# Ai+ , go """<div id="a"><div id="b"></div></div>""" $ div_ =# Ai </ div_ =# Bi+ , testGroup "duplicated ID"+ [ doNotTc [DuplicatedId "b"] [] $ div_ =# Bi </ div_ =# Bi+ , doNotTc [DuplicatedId "b"] [] $ div_ </ div_ =# Bi </ div_ =# Bi+ , doNotTc [DuplicatedId "b"] [] $ div_ </ div_ =# Bi </ div_ </ div_ =# Bi+ , doNotTc [DuplicatedId "b"] [] $ div_ =# Bi </ (div_ </ (div_ </ div_ =# Bi))+ , doNotTc [DuplicatedId "b"] [] $ div_ =# Bi </ (div_ =# Ci </ (div_ =# Ai </ div_ =# Bi))+ ]+ ]+ , testGroup "attr"+ [ go """<div a="av"><div class="a"></div></div>""" $+ div_ =<| atr @"a" av </ div_ =. a_wants_a_attr_in_parent+ , go """<div class="a" a="av"></div>""" $ div_ =. a_wants_a_attr =<| atr @"a" av+ , go """<div class="a" a="av"></div>""" $ div_ =. a_wants_a_attr =<| atr @"a" av =<| atr @"a" av+ , go """<div a="av" class="a"></div>""" $ div_ =<| atr @"a" av =. a_wants_a_attr =<| atr @"a" av+ , go """<div a="av" class="a"></div>""" $ div_ =<| atr @"a" av =. a_wants_a_attr+ ]+ , testGroup "id+class+raw"+ [ go """<div id="a" class="a"><p>h</p></div>""" $+ div_ =# Ai =. a =< MH.p_ [] [ "h" ]+ , go """<div id="b"><div class="a"><i class="rc">aaa</i></div></div>""" $+ div_ =# Bi </ (div_ =. id_a =< MH.i_ [ MH.class_ "rc" ] [ "aaa" ])+ ]+ , testGroup "id+class"+ [ go """<div id="a" class="a"></div>""" $ div_ =# Ai =. a_id_a+ , go """<div class="a" id="a"></div>""" $ div_ =. a_id_a =# Ai+ , testGroup "#a is on parent but required to be in tag with class"+ [ doNotTcNoBr [] [[[(AutoClean, [B], [I "a"], [])]]] $+ div_ =# Ai </ (div_ =. a_id_a )+ ]+ , go """<div id="a"><div class="b"></div></div>""" $+ div_ =# Ai </ div_ =. b+ , go """<div id="b"><div class="a"></div></div>""" $+ div_ =# Bi </ div_ =. id_a+ , go """<div id="c" class="a"><div class="b"></div></div>""" $+ div_ =# Ci =. a </ div_ =. idC_and_a_b+ ]+ , testGroup "class"+ [ go """<div class="a"><div class="b"></div></div>""" $+ div_ =. a </ (div_ =. ab)+ , go """<div class="a b"><div class="c"></div></div>""" $+ div_ =. a =. b </ (div_ =. a_with_b_dir_c)+ , go """<div class="b a"><div class="c"></div></div>""" $+ div_ =. b =. a </ (div_ =. a_with_b_dir_c)+ , go """<div class="b c a"><div class="c"></div></div>""" $+ div_ =. b =. c =. a </ (div_ =. a_with_b_dir_c)+ , testGroup "extra div around c"+ [ doNotTcNoBr [] [[[(JustNow, [B], [C "b", C "a"], [])]]] do+ div_ =. b =. a </ (div_ </ div_ =. a_with_b_dir_c)+ ]+ , testGroup "a missing"+ [ doNotTcNoBr [] [[[(JustNow, [B, C "a"], [C "b"], [])]]] do+ div_ =. b =. b </ div_ =. a_with_b_dir_c+ ]+ , testGroup "a is parent of b"+ [ doNotTcNoBr [] [[[(JustNow, [B], [C "a", C "b"], [])]]] do+ div_ =. a </ (div_ =. b </ div_ =. a_with_b_dir_c)+ ]+ , testGroup "a and b are applied to siblings"+ [ doNotTcNoBr [] [[[(JustNow, [B, C "a"], [C "b"],[])]]] do+ div_ </ div_ =. a </ (div_ =. b </ div_ =. a_with_b_dir_c)+ ]+ , testGroup ".a is applied to this elem rather than parent one"+ [ doNotTcNoBr [] [[[(NowOrLater, [C "a"], [], [])]]] do+ div_ </ (div_ =. ab =. a)+ ]+ , testGroup ".a is not applied to parent elem"+ [ doNotTcNoBr [] [[[(NowOrLater, [C "a"], [], [])]]] do+ div_ </ (div_ =. ab)+ , doNotTcNoBr [] [[[(NowOrLater, [C "a"], [], [])]]] do+ div_ =. ab+ ]+ , go """<div class="b a"></div>""" $+ div_ =. a_next_to_b =. b_next_to_a+ , go """<div class="a b"></div>""" $+ div_ =. b_next_to_a =. a_next_to_b+ , go """<div class="a b"></div>""" $+ div_ =. b_next_to_a =. a_next_to_b+ , go """<div class="a b a"></div>""" $+ div_ =. b_next_to_a =. a_next_to_b =. b_next_to_a+ , go """<div class="a"><div class="b"><div class="c"></div></div></div>""" $+ div_ =. a </ (div_ =. ab </ div_ =. abc)+ , testGroup "b is missing"+ [ doNotTcNoBr [] [[[(NowOrLater, [C "b"], [], []), (NowOrLater, [C "a"], [], [])]]] $+ div_ =. a </ (div_ </ div_ =. abc)+ , doNotTcNoBr [] [[[(NowOrLater, [C "b"], [], []), (NowOrLater, [C "a"], [], [])]]] $+ div_ =. a </ div_ =. abc+ ]+ , testGroup "a and b are flipped"+ [ doNotTcNoBr [] [[[(NowOrLater, [C "a"], [], [])]]] $+ div_ =. b </ (div_ =. a </ div_ =. abc)+ ]+ , testGroup "a is missing"+ [ doNotTcNoBr [] [[[(NowOrLater, [C "a"], [], [])]]] $+ div_ =. b </ div_ =. abc+ ]+ , go """<div class="a"><div class="b"><ul><div class="c"></div></ul></div></div>""" $+ div_ =. a </ (div_ =. ab </ (ul_ </ div_ =. abc))+ , go """<div class="a"><div class="b"></div><div class="c"></div></div>""" $+ div_ =. a </ div_ =. ab </ div_ =. ac+ , go """<div class="a"><div class="b"><div class="c"></div></div></div>""" $+ div_ =. a </ (div_ =. ab </ div_ =. ac)+ , go """<div class="a b"><div class="c"></div></div>""" $+ div_ =. a =. b </ (div_ =. ab_c)+ , go """<div class="a b"><div class="c"></div></div>""" $+ div_ =. a =. b </ (div_ =. ba_c)+ , go """<div class="b a"><div class="c"></div></div>""" $+ div_ =. b =. a </ (div_ =. ba_c)+ , go """<div class="a"><div class="b"><div class="c"></div></div></div>""" $+ div_ =. a </ (div_ =. b </ div_ =. a_dir_b_dir_c)+ , go """<div class="a"><div class="b"><p><div class="c"></div></p></div></div>""" $+ div_ =. a </ (div_ =. b </ (p_ </ div_ =. a_dir_b_sp_c))+ , go """<div class="a"><p><div class="b"><div class="c"></div></div></p></div>""" $+ div_ =. a </ (p_ </ (div_ =. b </ div_ =. a_sp_b_dir_c))+ , go """<div class="a"><div class="b"><div class="c"><div class="d"></div></div></div></div>""" $+ div_ =. a </ (div_ =. b </ (div_ =. c </ div_ =. a_dir_b_dir_c_dir_d))+ , go """<div class="a"><div class="b"></div></div>""" $+ div_ =. a </ div_ =. a_dir_b+ , testGroup ".a > .b"+ [ testGroup "a is missing"+ [ doNotTcNoBr [] [[[(JustNow, [B, C "a"], [], [])]]] $ div_ </ div_ =. a_dir_b+ , doNotTcNoBr [] [[[(JustNow, [C "a"], [], [])]]] $ div_ =. a_dir_b+ ]+ ]+ , go """<div class="a"><div class="b"><div class="c"></div></div></div>""" $+ div_ =. a </ (div_ =. b </ div_ =. a_dir_b_spc_c)+ , go """<div class="a"><div class="b"><div><div class="c"></div></div></div></div>""" $+ div_ =. a </ (div_ =. b </ (div_ </ div_ =. a_dir_b_spc_c))++ , go """<div class="c"><div class="a b"></div></div>""" $+ div_ =. c </ div_ =. a =. c_dir_a_with_b+ , go """<div class="c"><div class="b a"></div></div>""" $+ div_ =. c </ div_ =. c_dir_a_with_b =. a+ , go """<div class="c"><div></div><div class="b a"></div></div>""" $+ div_ =. c </ div_ </ div_ =. c_dir_a_with_b =. a+ , go """<div class="c"><div class="b a"></div><div></div></div>""" $+ div_ =. c </ div_ =. c_dir_a_with_b =. a </ div_+ , testGroup "a is missing"+ [ doNotTcNoBr [] [[[(AutoClean, [B, C "a"], [], []), (JustNow, [C "c"], [], [])]]] $+ div_ =. c </ div_ =. c_dir_a_with_b+ ]+ , testGroup "c is missing"+ [ doNotTcNoBr [] [[[(JustNow, [B, C "c"], [], [])]]] $+ div_ </ div_ =. a =. c_dir_a_with_b+ ]+ , testGroup "c is sibling"+ [ doNotTcNoBr [] [[[(JustNow, [B, C "c"], [], [])]]] $+ div_ </ div_ =. c </ div_ =. a =. c_dir_a_with_b+ ]+ , testGroup "c and a are mixed"+ [ doNotTcNoBr [] [[[(AutoClean, [B], [C "a"], []), (JustNow, [C "c"], [], [])]]] $+ div_ =. a </ div_ =. c =. c_dir_a_with_b+ , doNotTcNoBr [] [[[(AutoClean, [B], [C "a"], []), (JustNow, [C "c"], [], [])]]] $+ div_ =. a </ div_ =. c_dir_a_with_b =. c+ ]+ , testGroup "a is sibling"+ [ doNotTcNoBr [] [[[(AutoClean, [B, C "a"], [], []), (JustNow, [C "c"], [], [])]]] $+ div_ =. c </ div_ =. a </ div_ =. c_dir_a_with_b+ , doNotTcNoBr [] [[[(AutoClean, [B, C "a"], [], []), (JustNow, [C "c"], [], [])]]] $+ div_ =. c </ div_ =. c_dir_a_with_b </ div_ =. a+ ]+ ]+ ]+ ]+ ]+ ]+ where+ av :: MisoString = "av"
+ test/Miso/Css/Test/StyleMock.hs view
@@ -0,0 +1,527 @@+{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE RequiredTypeArguments #-}++module Miso.Css.Test.StyleMock+ ( module Miso.Css.Test.StyleMock+ , module X+ ) where++import Data.ByteString.Lazy qualified as L+import Data.ByteString.Char8 qualified as C8+import Miso.Css.Style.PostAppend as Post+import Miso.Css.Test.Prelude as X++domLbs :: forall m a en es r ei atrs kids cls ecs children.+ ( UnwrapBranches (MapMaybeFilterOutFullyMatchedHead '[] ecs) ~ '[]+ , DuplicatedIds kids ~ '[]+ ) =>+ E m a en es r ei atrs kids cls ecs children ->+ L.ByteString+domLbs = toHtml . toView++doNotTcNoBr :: forall m a en es r ei atrs kids cls ecs children.+ forall exDids -> (DuplicatedIds kids ~ exDids) =>+ forall exEcs -> (UnwrapBranches (MapMaybeFilterOutFullyMatchedHead '[] ecs) ~ exEcs) =>+ E m a en es r ei atrs kids cls ecs children ->+ TestTree+doNotTcNoBr _ _ _ =+ testCase "see type message from the checker" do+ () @?= ()++doNotTc :: forall m a en es r ei atrs kids cls ecs children.+ forall exDids -> (DuplicatedIds kids ~ exDids) =>+ forall exEcs -> (MapMaybeFilterOutFullyMatchedHead '[] ecs ~ exEcs) =>+ E m a en es r ei atrs kids cls ecs children ->+ TestTree+doNotTc _ _ _ =+ testCase "see type message from the checker" do+ () @?= ()++go :: forall m a en es r ei atrs kids cls ecs children.+ ( UnwrapBranches (MapMaybeFilterOutFullyMatchedHead '[] ecs) ~ '[]+ , DuplicatedIds kids ~ '[]+ ) =>+ L.ByteString -> E m a en es r ei atrs kids cls ecs children -> TestTree+go ex el =+ testCase (C8.unpack $ C8.toStrict ex) do+ domLbs el @?= ex++infixl 1 `go`++a :: OrClass '[] "a"+a = TopOrClass pa+b :: OrClass '[] "b"+b = TopOrClass pb+c :: OrClass '[] "c"+c = TopOrClass pc+d :: OrClass '[] "d"+d = TopOrClass pd+pul :: Proxy "ul"+pul = Proxy @"ul"+{- HLINT ignore "Use camelCase" -}+ul_a :: OrClass '[ '[ '(NowOrLater, '[T "ul"], '[], '[])]] "a"+ul_a = AddAncestorBranch (AddSubSegConstraint (Proxy @T) pul $ CssOrphan nol) a+-- #x .a+id_a :: OrClass '[ '[ '(NowOrLater, '[I "b"], '[], '[])]] "a"+id_a = AddAncestorBranch (AddSubSegConstraint (Proxy @I) pb $ CssOrphan nol) a+pa :: Proxy "a"+pa = Proxy @"a"+pb :: Proxy "b"+pb = Proxy @"b"+pc :: Proxy "c"+pc = Proxy @"c"+pd :: Proxy "d"+pd = Proxy @"d"++type Ai = ElementId "a"+type Bi = ElementId "b"+type Ci = ElementId "c"+type Di = ElementId "d"++nol_c :: OrClass '[ '[ '(NowOrLater, '[], '[], '[])]] "c"+nol_c = AddAncestorBranch (CssOrphan nol) c+jn_c :: OrClass '[ '[ '(JustNow, '[], '[], '[])]] "c"+jn_c = AddAncestorBranch (CssOrphan jn) c++ac :: OrClass '[ '[ '(NowOrLater, '[C "a"], '[], '[])]] "c"+ac = AddAncestorBranch (AddSubSegConstraint (Proxy @C) pa $ CssOrphan nol) c++-- .a _ .b+ab :: OrClass '[ [ '(AutoClean, '[], '[], '[])+ , '(NowOrLater, '[C "a"], '[], '[])+ ] ] "b"+ab =+ AddAncestorBranch+ ( CssOrphan nol+ & ( AddSubSegConstraint (Proxy @C) pa+ >>> NextAncestor acn) ) b++-- .a _ .b _ .c+abc :: OrClass+ '[ [ '(AutoClean, '[], '[], '[])+ , '(NowOrLater, '[C "b"], '[], '[])+ , '(NowOrLater, '[C "a"], '[], '[])+ ] ] "c"+abc =+ AddAncestorBranch+ ( CssOrphan nol+ & ( AddSubSegConstraint (Proxy @C) pa+ >>> NextAncestor nol+ >>> AddSubSegConstraint (Proxy @C) pb+ >>> NextAncestor acn) )+ c+-- .a.b _ .c+ab_c :: OrClass '[['(AutoClean, '[], '[], '[]), '(NowOrLater, [C "b", C "a"], '[], '[])]] "c"+ab_c =+ AddAncestorBranch+ ( CssOrphan nol+ & ( AddSubSegConstraint (Proxy @C) pa+ >>> AddSubSegConstraint (Proxy @C) pb+ >>> NextAncestor acn) )+ c+-- .b.a _ .c+ba_c :: OrClass '[ '[ '(NowOrLater, [C "a", C "b"], '[], '[])]] "c"+ba_c =+ AddAncestorBranch+ ( CssOrphan nol+ & ( AddSubSegConstraint (Proxy @C) pb+ >>> AddSubSegConstraint (Proxy @C) pa) )+ c+-- #c.a _ .b+idC_and_a_b :: OrClass '[ '[ '(NowOrLater, [I "c", C "a"], '[], '[])]] "b"+idC_and_a_b =+ AddAncestorBranch+ ( CssOrphan nol+ & ( AddSubSegConstraint (Proxy @C) pa+ >>> AddSubSegConstraint (Proxy @I) pc) )+ b+ul_and_a_b :: OrClass '[ '[ '(NowOrLater, [T "ul", C "a"], '[], '[])]] "b"+ul_and_a_b =+ AddAncestorBranch+ ( CssOrphan nol+ & ( AddSubSegConstraint (Proxy @C) pa+ >>> AddSubSegConstraint (Proxy @T) pul) )+ b+-- id_a = AddAncestorBranch (AddSubSegConstraint (Proxy @I) pb $ CssOrphan nol) a+a_id_a :: OrClass '[ '[ '(AutoClean, '[I "a"], '[], '[])]] "a"+a_id_a =+ AddAncestorBranch (CssOrphan acn & AddSubSegConstraint (Proxy @I) pa) a++-- .a.b+a_next_to_b :: OrClass '[ '[ '(AutoClean, '[C "a"], '[], '[])]] "b"+a_next_to_b =+ AddAncestorBranch (CssOrphan acn & AddSubSegConstraint (Proxy @C) pa) b++-- .c > .a.b+c_dir_a_with_b :: OrClass+ '[ [ '(AutoClean, '[C "a"], '[], '[])+ , '(JustNow, '[C "c"], '[], '[])+ ] ] "b"+c_dir_a_with_b =+ AddAncestorBranch+ ( CssOrphan jn+ & ( AddSubSegConstraint (Proxy @C) pc+ >>> NextAncestor acn+ >>> AddSubSegConstraint (Proxy @C) pa))+ b++-- .b.a+b_next_to_a :: OrClass '[ '[ '(AutoClean, '[C "b"], '[], '[])]] "a"+b_next_to_a =+ AddAncestorBranch+ (AddSubSegConstraint (Proxy @C) pb $ CssOrphan acn) a+-- .a[a]+a_wants_a_attr :: OrClass '[ '[ '(AutoClean, '[A "a"], '[], '[])]] "a"+a_wants_a_attr = AddAncestorBranch (AddSubSegConstraint (Proxy @A) pa $ CssOrphan acn) a+-- [a] > .a+a_wants_a_attr_in_parent :: OrClass '[ '[ '(JustNow, '[A "a"], '[], '[])]] "a"+a_wants_a_attr_in_parent = AddAncestorBranch (AddSubSegConstraint (Proxy @A) pa $ CssOrphan jn) a++pdiv :: Proxy "div"+pdiv = Proxy @"div"+div_child :: OrClass+ '[ [ '(AutoClean, '[], '[], '[])+ , '(JustNow, '[T "div"], '[], '[])+ ] ] "div_child"+div_child = -- div > .div_child+ AddAncestorBranch+ ( CssOrphan jn+ & ( AddSubSegConstraint (Proxy @T) pdiv+ >>> NextAncestor acn) )+ (TopOrClass (Proxy @"div_child"))+div_ul_child :: OrClass+ '[ [ '(AutoClean, '[], '[], '[])+ , '(JustNow, '[T "ul"], '[], '[])+ , '(JustNow, '[T "div"], '[], '[])+ ]+ ] "div_ul_child"+div_ul_child =+ AddAncestorBranch+ ( CssOrphan jn+ & ( AddSubSegConstraint (Proxy @T) pdiv+ >>> NextAncestor jn+ >>> AddSubSegConstraint (Proxy @T) pul+ >>> NextAncestor acn) )+ (TopOrClass (Proxy @"div_ul_child"))+-- .a > .b > .c+a_dir_b_dir_c :: OrClass+ '[ [ '(AutoClean, '[], '[], '[])+ , '(JustNow, '[C "b"], '[], '[])+ , '(JustNow, '[C "a"], '[], '[])+ ]+ ] "c"+a_dir_b_dir_c =+ AddAncestorBranch+ ( CssOrphan jn+ & ( AddSubSegConstraint (Proxy @C) pa+ >>> NextAncestor jn+ >>> AddSubSegConstraint (Proxy @C) pb+ >>> NextAncestor acn) )+ c+-- .a > .b _ .c+a_dir_b_sp_c :: OrClass+ '[ [ '(AutoClean, '[], '[], '[])+ , '(NowOrLater, '[C "b"], '[], '[])+ , '(JustNow, '[C "a"], '[], '[])+ ] ] "c"+a_dir_b_sp_c =+ AddAncestorBranch+ ( CssOrphan jn+ & ( AddSubSegConstraint (Proxy @C) pa+ >>> NextAncestor nol+ >>> AddSubSegConstraint (Proxy @C) pb+ >>> NextAncestor acn) )+ c+-- .a _ .b > .c+a_sp_b_dir_c :: OrClass+ '[ [ '(AutoClean, '[], '[], '[])+ , '(JustNow, '[C "b"], '[], '[])+ , '(NowOrLater, '[C "a"], '[], '[])+ ] ] "c"+a_sp_b_dir_c =+ AddAncestorBranch+ ( CssOrphan nol+ & ( AddSubSegConstraint (Proxy @C) pa+ >>> NextAncestor jn+ >>> AddSubSegConstraint (Proxy @C) pb+ >>> NextAncestor acn) )+ c++-- .a > .b > .c > .d+a_dir_b_dir_c_dir_d :: OrClass+ '[ [ '(AutoClean, '[], '[], '[])+ , '(JustNow, '[C "c"], '[], '[])+ , '(JustNow, '[C "b"], '[], '[])+ , '(JustNow, '[C "a"], '[], '[])+ ]+ ] "d"+a_dir_b_dir_c_dir_d =+ AddAncestorBranch+ ( CssOrphan jn -- .a+ & ( AddSubSegConstraint (Proxy @C) pa+ >>> NextAncestor jn -- .b+ >>> AddSubSegConstraint (Proxy @C) pb+ >>> NextAncestor jn -- .c+ >>> AddSubSegConstraint (Proxy @C) pc+ >>> NextAncestor acn) )+ d+-- * > * > .c+star_dir_star_dir_c :: OrClass '[['(JustNow, '[], '[], '[]), '(JustNow, '[], '[], '[])]] "c"+star_dir_star_dir_c =+ AddAncestorBranch (CssOrphan jn & NextAncestor jn)+ c+-- .a > .b+a_dir_b :: OrClass+ '[ [ '(AutoClean, '[], '[], '[])+ , '(JustNow, '[C "a"], '[], '[])+ ] ] "b"+a_dir_b =+ AddAncestorBranch+ ( CssOrphan jn+ & ( AddSubSegConstraint (Proxy @C) pa+ >>> NextAncestor acn) )+ b++-- .a > .b _ .c+a_dir_b_spc_c :: OrClass+ '[ [ '(AutoClean, '[], '[], '[])+ , '(NowOrLater, '[C "b"], '[], '[])+ , '(JustNow, '[C "a"], '[], '[])+ ] ] "c"+a_dir_b_spc_c =+ AddAncestorBranch+ ( CssOrphan jn+ & ( AddSubSegConstraint (Proxy @C) pa+ >>> NextAncestor nol+ >>> AddSubSegConstraint (Proxy @C) pb+ >>> NextAncestor acn) )+ c+-- .a + .b+a_dirSib_b :: OrClass+ '[ [ '(AutoClean, '[], '[], '[])+ , '(NowOrLater, '[], '[], '[ '[ '(JustNow, '[C "a"])]])+ ] ] "b"+a_dirSib_b =+ AddAncestorBranch+ ( CssOrphan nol+ & ( AddSiblingBranch (AddSegToSibBranch (AddSib (Proxy @C) pa $ NilSib jn) NilSibBranch)+ >>> NextAncestor acn) )+ b+-- .a + .b + .c+a_dirSib_b_dirSib_c :: OrClass+ '[ [ '(AutoClean, '[], '[], '[])+ , '(JustNow, '[], '[], '[ [ '(JustNow, '[C "b"])+ , '(JustNow, '[C "a"]) ] ])+ ] ] "c"+a_dirSib_b_dirSib_c =+ AddAncestorBranch+ ( CssOrphan jn+ & ( AddSiblingBranch+ ( AddSegToSibBranch (AddSib (Proxy @C) pa $ NilSib jn)+ >>> AddSegToSibBranch (AddSib (Proxy @C) pb $ NilSib jn)+ $ NilSibBranch+ )+ >>> NextAncestor acn+ ) )+ c++-- .a ~ .b ~ .c+a_genSib_b_genSib_c :: OrClass+ '[ [ '(AutoClean, '[], '[], '[])+ , '(JustNow, '[], '[], '[['(NowOrLater, '[C "b"]), '(NowOrLater, '[C "a"])]])+ ] ] "c"+a_genSib_b_genSib_c =+ AddAncestorBranch+ ( CssOrphan jn+ & ( AddSiblingBranch+ ( AddSegToSibBranch (AddSib (Proxy @C) pa $ NilSib nol)+ >>> AddSegToSibBranch (AddSib (Proxy @C) pb $ NilSib nol)+ $ NilSibBranch+ )+ >>> NextAncestor acn+ ) )+ c+-- _ .c > .a + .b+c_dir_a_dirSib_b :: OrClass+ '[ [ '(AutoClean, '[], '[], '[])+ , '(JustNow, '[C "c"], '[], '[ '[ '(JustNow, '[C "a"])]]) ] ] "b"+c_dir_a_dirSib_b =+ AddAncestorBranch+ ( CssOrphan jn+ & ( AddSubSegConstraint (Proxy @C) pc+ >>> AddSiblingBranch (AddSegToSibBranch (AddSib (Proxy @C) pa $ NilSib jn) NilSibBranch)+ >>> NextAncestor acn) )+ b+-- _ | .c > .a + .b _ .d+c_dir_a_dirSib_b_spc_d :: OrClass+ '[ [ '(AutoClean, '[], '[], '[])+ , '(NowOrLater, '[C "b"], '[], '[])+ , '(JustNow, '[C "c"], '[], '[ '[ '(JustNow, '[C "a"])]])+ ] ] "d"+c_dir_a_dirSib_b_spc_d =+ AddAncestorBranch+ ( CssOrphan jn+ & ( AddSubSegConstraint (Proxy @C) pc+ >>> AddSiblingBranch (AddSegToSibBranch (AddSib (Proxy @C) pa $ NilSib jn) NilSibBranch)+ >>> NextAncestor nol+ >>> AddSubSegConstraint (Proxy @C) pb+ >>> NextAncestor acn) )+ d+-- .a.b > .c+a_with_b_dir_c :: OrClass+ '[ [ '(AutoClean, '[], '[], '[])+ , '(JustNow, [C "b", C "a"], '[], '[])+ ] ] "c"+a_with_b_dir_c =+ AddAncestorBranch+ ( CssOrphan jn+ & ( AddSubSegConstraint (Proxy @C) pa+ >>> AddSubSegConstraint (Proxy @C) pb+ >>> NextAncestor acn) )+ c+-- .a.b + .c+a_with_b_dirSib_c :: OrClass+ '[ [ '(AutoClean, '[], '[], '[])+ , '(JustNow, '[], '[], '[ '[ '(JustNow, [C "b", C "a"])]]) ] ] "c"+a_with_b_dirSib_c =+ AddAncestorBranch+ ( AddSiblingBranch (AddSegToSibBranch (AddSib (Proxy @C) pb $ AddSib (Proxy @C) pa $ NilSib jn) NilSibBranch)+ >>> NextAncestor acn+ $ CssOrphan jn ) -- or nol - does not matter+ c++pspan :: Proxy "span"+pspan = Proxy @"span"+pp :: Proxy "p"+pp = Proxy @"p"++-- _ | p ~ span > .a+p_genSib_span_dir_a =+ AddAncestorBranch+ ( CssOrphan jn -- >+ & ( AddSiblingBranch+ ( AddSegToSibBranch (AddSib (Proxy @T) pp $ NilSib nol)+ NilSibBranch )+ >>> NextAncestor jn -- siblings+ >>> AddSubSegConstraint (Proxy @T) pspan+ >>> NextAncestor acn+ ) )+ a++-- _ | div + p ~ span > .a+div_dirSib_p_genSib_span_dir_a =+ AddAncestorBranch+ ( CssOrphan jn -- >+ & ( AddSiblingBranch+ ( AddSegToSibBranch (AddSib (Proxy @T) pdiv $ NilSib jn)+ >>> AddSegToSibBranch (AddSib (Proxy @T) pp $ NilSib nol)+ $ NilSibBranch )+ >>> NextAncestor jn -- siblings+ >>> AddSubSegConstraint (Proxy @T) pspan+ >>> NextAncestor acn) )+ a++-- _ | div + p ~ span > .a + .b+div_dirSib_p_genSib_span_dir_a_dirSib_b :: OrClass+ '[ [ '(AutoClean, '[], '[], '[])+ , '(JustNow, '[T "span"], '[], '[ '[ '(JustNow, '[C "a"])]])+ , '(JustNow, '[], '[], '[['(NowOrLater, '[T "p"]), '(JustNow, '[T "div"])]])+ ] ] "b"+div_dirSib_p_genSib_span_dir_a_dirSib_b =+ AddAncestorBranch+ ( CssOrphan jn -- >+ & ( AddSiblingBranch+ ( AddSegToSibBranch (AddSib (Proxy @T) pdiv $ NilSib jn)+ >>> AddSegToSibBranch (AddSib (Proxy @T) pp $ NilSib nol)+ $ NilSibBranch )+ >>> NextAncestor jn -- siblings+ >>> AddSubSegConstraint (Proxy @T) pspan+ >>> AddSiblingBranch (AddSegToSibBranch (AddSib (Proxy @C) pa $ NilSib jn) NilSibBranch)+ >>> NextAncestor acn) )+ b++-- _ | div ~ p + span > .a + .b+div_genSib_p_dirSib_span_dir_a_dirSib_b :: OrClass+ '[ [ '(AutoClean, '[], '[], '[])+ , '(JustNow, '[T "span"], '[], '[ '[ '(JustNow, '[C "a"])]])+ , '(JustNow, '[], '[], '[['(JustNow, '[T "p"]), '(NowOrLater, '[T "div"])]])+ ] ] "b"+div_genSib_p_dirSib_span_dir_a_dirSib_b =+ AddAncestorBranch+ ( CssOrphan jn -- >+ & ( AddSiblingBranch+ ( NilSibBranch+ & ( AddSegToSibBranch (AddSib (Proxy @T) pdiv $ NilSib nol)+ >>> AddSegToSibBranch (AddSib (Proxy @T) pp $ NilSib jn) )+ )+ >>> NextAncestor jn -- siblings+ >>> AddSubSegConstraint (Proxy @T) pspan+ >>> AddSiblingBranch (AddSegToSibBranch (AddSib (Proxy @C) pa $ NilSib jn) NilSibBranch)+ >>> NextAncestor acn) )+ b++-- .a + .b > .c+a_dirSib_b_dir_c :: OrClass+ '[ [ '(AutoClean, '[], '[], '[])+ , '(JustNow, '[C "b"], '[], '[])+ , '(JustNow, '[], '[], '[ '[ '(JustNow, '[C "a"]) ] ])+ ] ] "c"+a_dirSib_b_dir_c =+ AddAncestorBranch+ ( CssOrphan jn -- >+ & ( AddSiblingBranch (AddSegToSibBranch (AddSib (Proxy @C) pa $ NilSib jn) NilSibBranch)+ >>> NextAncestor jn -- always jn for + or ~+ >>> AddSubSegConstraint (Proxy @C) pb+ >>> NextAncestor acn) )+ c++-- .a ~ .b+a_genSib_b :: OrClass+ '[ [ '(AutoClean, '[], '[], '[])+ , '(JustNow, '[], '[], '[ '[ '(NowOrLater, '[C "a"]) ]])+ ] ] "b"+a_genSib_b =+ AddAncestorBranch+ ( CssOrphan jn -- nol is the same here+ & ( AddSiblingBranch (AddSegToSibBranch (AddSib (Proxy @C) pa $ NilSib nol) NilSibBranch)+ >>> NextAncestor acn) )+ b++-- .a ~ .b _ .c+a_genSib_b_spc_c :: OrClass+ '[ [ '(AutoClean, '[], '[], '[])+ , '(NowOrLater, '[C "b"], '[], '[])+ , '(NowOrLater, '[], '[], '[ '[ '(NowOrLater, '[C "a"])]])+ ] ] "c"+a_genSib_b_spc_c =+ AddAncestorBranch+ ( CssOrphan nol+ & ( AddSiblingBranch (AddSegToSibBranch (AddSib (Proxy @C) pa $ NilSib nol) NilSibBranch)+ >>> NextAncestor nol -- always nol for ~+ >>> AddSubSegConstraint (Proxy @C) pb+ >>> NextAncestor acn) )+ c++root_b :: OrClass '[ '[ '(NowOrLater, '[R], '[], '[])]] "b"+root_b =+ AddAncestorBranch+ (AddRoot $ CssOrphan nol)+ b+-- :root > body > .a > .b+root_dir_body_dir_a_dir_b :: OrClass+ '[ [ '(AutoClean, '[], '[], '[])+ , '(JustNow, '[C "a"], '[], '[])+ , '(JustNow, '[T BODY], '[], '[])+ , '(JustNow, '[R], '[], '[])+ ]+ ] "b"+root_dir_body_dir_a_dir_b =+ AddAncestorBranch+ ( CssOrphan jn+ & ( AddRoot+ >>> NextAncestor jn+ >>> AddSubSegConstraint (Proxy @T) (Proxy @BODY)+ >>> NextAncestor jn+ >>> AddSubSegConstraint (Proxy @C) pa+ >>> NextAncestor acn) )+ b
+ test/Miso/Css/Test/Th/AmoreBmoreC.hs view
@@ -0,0 +1,9 @@+module Miso.Css.Test.Th.AmoreBmoreC where++import Miso.Css.Test.StyleMock hiding (a, b, c)++[css|.a > .b > .c {}|]++test_t =+ go """<div class="a"><div class="b"><div class="c"></div></div></div>"""+ $ div_ =. a </ (div_ =. b </ div_ =. c)
+ test/Miso/Css/Test/Th/AplusBplusC.hs view
@@ -0,0 +1,9 @@+module Miso.Css.Test.Th.AplusBplusC where++import Miso.Css.Test.StyleMock hiding (a, b, c)++[css|.a + .b + .c {} |]++test_t =+ go """<div><div class="a"></div><div class="b"></div><div class="c"></div></div>"""+ $ div_ </ div_ =. a </ div_ =. b </ div_ =. c
+ test/Miso/Css/Test/Th/DivPlusPtildeSpanMoreAplusB.hs view
@@ -0,0 +1,26 @@+-- {-# OPTIONS_GHC -ddump-splices #-}+module Miso.Css.Test.Th.DivPlusPtildeSpanMoreAplusB where++import Miso.Css.Test.StyleMock hiding (a, b)++[css|div + p ~ span > .a + .b {}|]++test_t = testGroup cssAsLiteralText+ [ """<div><div></div><p></p><span><div class="a"></div><div class="b"></div><div></div></span></div>"""+ `go`+ (div_+ </ div_+ </ p_+ </ (span_+ </ div_ =. a+ </ div_ =. b+ </ div_))+ , """<div><div></div><p></p><span><div class="a"></div><div class="b"></div></span></div>"""+ `go`+ (div_+ </ div_+ </ p_+ </ (span_+ </ div_ =. a+ </ div_ =. b))+ ]
+ test/Miso/Css/Test/Th/DotAdotB.hs view
@@ -0,0 +1,7 @@+module Miso.Css.Test.Th.DotAdotB where++import Miso.Css.Test.StyleMock hiding (a, b)++[css|.a.b {}|]++test_t = """<div class="a b"></div>""" `go` div_ =. a =. b
+ test/Miso/Css/Test/Th/ForkBranchOnJnMatchAfterNol.hs view
@@ -0,0 +1,54 @@+-- {-# OPTIONS_GHC -ddump-splices #-}+module Miso.Css.Test.Th.ForkBranchOnJnMatchAfterNol where++import Miso.Css.Test.StyleMock hiding (a, b, c, d)+++[css|/* ForkBranchOnJn */+.a > .b {}+.x > .y .z {}+p > b .e {}+|]++renameCssTextConst "withNonLeafRules"+enableRulesForNonLeafClasses+[css|.xx > .yy .zz {}|]+test_t = testGroup cssAsLiteralText+ [ """<div class="a"><div class="b"></div></div>"""+ `go` page (div_ =. a </ div_ =. b)+ , doNotTcNoBr [] [[[(JustNow, [B], [C "a"], [])]]]+ $ div_ =. a </ (div_ =. b </ div_ =. b)+ , """<div class="x"><div class="y"><div class="z"></div></div></div>"""+ `go` div_ =. x </ (div_ =. y </ div_ =. z)+ , """<div class="x"><div class="y"><div class="y"><div class="z"></div></div></div></div>"""+ `go` div_ =. x </ (div_ =. y </ (div_ =. y </ div_ =. z))+ , """<div class="x"><div class="y"><div class="y"><div class="y"><div class="z"></div></div></div></div></div>"""+ `go` div_ =. x </ (div_ =. y </ (div_ =. y </ (div_ =. y </ div_ =. z)))+ , """<div class="x"><div class="y"><div class="a"><div class="y"><div class="z"></div></div></div></div></div>"""+ `go` div_ =. x </ (div_ =. y </ (div_ =. a </ (div_ =. y </ div_ =. z)))+ , doNotTcNoBr []+ [[ [ (NowOrLater, [C "y"], [], [])+ , (JustNow, [C "x"], [], [])+ ]+ , [(JustNow, [B], [C "x"], [])]+ , [(JustNow, [B], [C "x"], [])]+ ]]+ $ div_ =. x </ (div_ =. a </ (div_ =. y </ (div_ =. y </ div_ =. z)))+ , doNotTcNoBr []+ [[ [ (NowOrLater, [C "y"], [], [])+ , (JustNow, [C "x"], [], [])+ ]+ , [ (JustNow, [B, C "x"], [], [])]+ , [ (JustNow, [B, C "x"], [], [])]+ , [ (JustNow, [B, C "x"], [], [])]+ ]]+ $ div_ =. y </ (div_ =. y </ (div_ =. y </ div_ =. z))+ , """<p><b><b><div class="e"></div></b></b></p>"""+ `go` p_ </ (b_ </ (b_ </ div_ =. e))+ , testGroup withNonLeafRules+ [ """<div class="xx"><div class="yy"><div class="zz"></div></div></div>"""+ `go` div_ =. xx </ (div_ =. yy </ div_ =. zz)+ , doNotTcNoBr [] [[[(JustNow, [B], [C "xx"], [])]]] $+ div_ =. xx </ (div_ =. yy </ (div_ =. yy </ div_ =. zz))+ ]+ ]
+ test/Miso/Css/Test/Th/ForkBranchSibling.hs view
@@ -0,0 +1,14 @@+-- {-# OPTIONS_GHC -ddump-splices #-}+module Miso.Css.Test.Th.ForkBranchSibling where++import Miso.Css.Test.StyleMock+++[css|span + p ~ .t {}|]++test_t = testGroup cssAsLiteralText+ [ """<div><span></span><p></p><div class="t"></div></div>"""+ `go` div_ </ span_ </ p_ </ div_ =. t+ , """<div><span></span><p></p><p></p><div class="t"></div></div>"""+ `go` div_ </ span_ </ p_ </ p_ </ div_ =. t+ ]
+ test/Miso/Css/Test/Th/PmoreXplusYplusZmoreAspaceBmoreC.hs view
@@ -0,0 +1,27 @@+-- {-# OPTIONS_GHC -ddump-splices #-}+module Miso.Css.Test.Th.PmoreXplusYplusZmoreAspaceBmoreC where++import Miso.Css.Test.StyleMock hiding (a, b, c)++[css|+div > ul + p + a > li b > .p {}+p > .x + .y + .z > .a .b > .c {}+|]++test_t = testGroup cssAsLiteralText+ [ """<div><ul></ul><p></p><a><li><b><span class="p"></span></b></li></a></div>"""+ `go`+ div_+ </ ul_+ </ p_+ </ (a_ </ (li_ </ (b_ </ span_ =. p)))+ , """<p><div class="x"></div><div class="y"></div><div class="z"><div class="a"><div class="b"><div class="c"></div></div></div></div></p>"""+ `go`+ p_+ </ div_ =. x+ </ div_ =. y+ </ (div_ =. z+ </ (div_ =. a+ </ (div_ =. b+ </ (div_ =. c))))+ ]
+ test/Miso/Css/Test/Th/RootMoreA.hs view
@@ -0,0 +1,22 @@+-- {-# OPTIONS_GHC -ddump-splices #-}+module Miso.Css.Test.Th.RootMoreA where++import Miso.Css.Test.StyleMock hiding (a, b, c, d)++[css|:root > .a {}+:root > div > .b {}+:root > body > div .c {}+:root > * > div .d {}+|]++test_t = testGroup cssAsLiteralText+ [ """<div class="a"></div>""" `go` page (div_ =. a)+ , doNotTcNoBr [] [[[(JustNow, [B], [R], [])]]] $ page (div_ </ div_ =. a)+ , """<div><div class="b"></div></div>""" `go` html_ (div_ </ div_ =. b)+ , doNotTcNoBr [] [[[(JustNow, [B], [R], [])]]] $+ html_ (div_ </ (div_ =. b </ div_ =. b))+ , """<div><b class="c"></b></div>""" `go` page (div_ </ b_ =. c)+ , """<div><div><b class="c"></b></div></div>""" `go` page (div_ </ (div_ </ b_ =. c))+ , """<div><b class="d"></b></div>""" `go` page (div_ </ b_ =. d)+ , """<div><b class="c"></b></div>""" `go` html_ (body_ (div_ </ b_ =. c))+ ]
+ test/style.css view
@@ -0,0 +1,3 @@+.foo > .bar {+ color: #f212ff;+}