{-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-}

{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE TypeOperators        #-}
{-# LANGUAGE TypeFamilies         #-}
{-# LANGUAGE DataKinds            #-}
{-# LANGUAGE PolyKinds            #-}
{-# LANGUAGE GADTs                #-}

module Html.Type.Internal where

import GHC.TypeLits
import GHC.Exts
import Data.Proxy
import Data.Type.Bool

{-# DEPRECATED

  Acronym   ,
  Applet    ,
  Basefont  ,
  Big       ,
  Blink     ,
  Center    ,
  Command   ,
  Content   ,
  Dir       ,
  Font      ,
  Frame     ,
  Frameset  ,
  Isindex   ,
  Keygen    ,
  Listing   ,
  Marquee   ,
  Multicol  ,
  Noembed   ,
  Plaintext ,
  Shadow    ,
  Spacer    ,
  Strike    ,
  Tt        ,
  Xmp       ,
  Nextid

 "This is an obsolete html element and should not be used." #-}

-- | The data type of all html elements and the kind of elements.
data Element
  = DOCTYPE

  | A
  | Abbr
  | Acronym
  | Address
  | Applet
  | Area
  | Article
  | Aside
  | Audio
  | B
  | Base
  | Basefont
  | Bdi
  | Bdo
  | Bgsound
  | Big
  | Blink
  | Blockquote
  | Body
  | Br
  | Button
  | Canvas
  | Caption
  | Center
  | Cite
  | Code
  | Col
  | Colgroup
  | Command
  | Content
  | Data
  | Datalist
  | Dd
  | Del
  | Details
  | Dfn
  | Dialog
  | Dir
  | Div
  | Dl
  | Dt
  | Element
  | Em
  | Embed
  | Fieldset
  | Figcaption
  | Figure
  | Font
  | Footer
  | Form
  | Frame
  | Frameset
  | H1
  | H2
  | H3
  | H4
  | H5
  | H6
  | Head
  | Header
  | Hgroup
  | Hr
  | Html
  | I
  | Iframe
  | Image
  | Img
  | Input
  | Ins
  | Isindex
  | Kbd
  | Keygen
  | Label
  | Legend
  | Li
  | Link
  | Listing
  | Main
  | Map
  | Mark
  | Marquee
  | Math
  | Menu
  | Menuitem
  | Meta
  | Meter
  | Multicol
  | Nav
  | Nextid
  | Nobr
  | Noembed
  | Noframes
  | Noscript
  | Object
  | Ol
  | Optgroup
  | Option
  | Output
  | P
  | Param
  | Picture
  | Plaintext
  | Pre
  | Progress
  | Q
  | Rp
  | Rt
  | Rtc
  | Ruby
  | S
  | Samp
  | Script
  | Section
  | Select
  | Shadow
  | Slot
  | Small
  | Source
  | Spacer
  | Span
  | Strike
  | Strong
  | Style
  | Sub
  | Summary
  | Sup
  | Svg
  | Table
  | Tbody
  | Td
  | Template
  | Textarea
  | Tfoot
  | Th
  | Thead
  | Time
  | Title
  | Tr
  | Track
  | Tt
  | U
  | Ul
  | Var
  | Video
  | Wbr
  | Xmp

data Attribute
  = AcceptA
  | AcceptCharsetA
  | AccesskeyA
  | ActionA
  | AlignA
  | AltA
  | AsyncA
  | AutocompleteA
  | AutofocusA
  | AutoplayA
  | AutosaveA
  | BgcolorA
  | BorderA
  | BufferedA
  | ChallengeA
  | CharsetA
  | CheckedA
  | CiteA
  | ClassA
  | CodeA
  | CodebaseA
  | ColorA
  | ColsA
  | ColspanA
  | ContentA
  | ContenteditableA
  | ContextmenuA
  | ControlsA
  | CoordsA
  | CrossoriginA
  | DataA
  | DatetimeA
  | DefaultA
  | DeferA
  | DirA
  | DirnameA
  | DisabledA
  | DownloadA
  | DraggableA
  | DropzoneA
  | EnctypeA
  | ForA
  | FormA
  | FormactionA
  | HeadersA
  | HeightA
  | HiddenA
  | HighA
  | HrefA
  | HreflangA
  | HttpEquivA
  | IconA
  | IdA
  | IntegrityA
  | IsmapA
  | ItempropA
  | KeytypeA
  | KindA
  | LabelA
  | LangA
  | LanguageA
  | ListA
  | LoopA
  | LowA
  | ManifestA
  | MaxA
  | MaxlengthA
  | MinlengthA
  | MediaA
  | MethodA
  | MinA
  | MultipleA
  | MutedA
  | NameA
  | NovalidateA
  | OpenA
  | OptimumA
  | PatternA
  | PingA
  | PlaceholderA
  | PosterA
  | PreloadA
  | RadiogroupA
  | ReadonlyA
  | RelA
  | RequiredA
  | ReversedA
  | RowsA
  | RowspanA
  | SandboxA
  | ScopeA
  | ScopedA
  | SeamlessA
  | SelectedA
  | ShapeA
  | SizeA
  | SizesA
  | SlotA
  | SpanA
  | SpellcheckA
  | SrcA
  | SrcdocA
  | SrclangA
  | SrcsetA
  | StartA
  | StepA
  | StyleA
  | SummaryA
  | TabindexA
  | TargetA
  | TitleA
  | TypeA
  | UsemapA
  | ValueA
  | WidthA
  | WrapA

newtype (:=) (a :: Attribute) b = AT b

-- | Check whether `b` is a valid child of `a`.  You'll propably never
-- need to call this directly.  Through a GADT, it is enforced that
-- every child is lawful.
type family (a :: Element) ?> b :: Constraint where
  a ?> (b # c)         = (a ?> b, a ?> c)
  a ?> (b :@: _) _     = MaybeTypeError a b (TestPaternity (SingleElement b) (GetInfo a) (GetInfo b))
  a ?> Maybe b         = a ?> b
  a ?> Either b c      = (a ?> b, a ?> c)
  a ?> f ((b :@: c) d) = a ?> (b :@: c) d
  a ?> f (b # c)       = a ?> (b # c)
  a ?> ()              = ()
  a ?> (b -> c)        = TypeError (Text "Html elements can't contain functions")
  a ?> b               = CheckString a b

type family (a :: Element) ??> b :: Constraint where
  a ??> () = ()
  a ??> (b # c)  = (a ??> b, a ??> c)
  a ??> (b := _) = If (Elem a (GetAttributeInfo b) || Null (GetAttributeInfo b))
                   (() :: Constraint)
                   (TypeError (ShowType b :<>: Text " is not a valid attribute of " :<>: ShowType a))
  a ??> b        = TypeError (ShowType b :<>: Text " is not an attribute.")

-- | Combine two elements or attributes sequentially.
--
-- >>> i_ () # div_ ()
-- <i></i><div></div>
--
-- >>> i_A (A.id_ "a" # A.class_ "b") "c"
-- <i id="a" class="b">c</i>
data (#) a b = (:#:) a b
{-# INLINE (#) #-}
(#) :: a -> b -> a # b
(#) = (:#:)
infixr 5 #

-- | Type synonym for elements without attributes.
type (>) a b = (:@:) a () b

-- | Decorate an element with attributes and descend to a valid child.
-- It is recommended to use the predefined elements.
--
-- >>> WithAttributes (A.class_ "bar") "a" :: ('Div :@: ('ClassA := String)) String
-- <div class="bar">a</div>
--
-- >>> div_A (A.class_ "bar") "a"
-- <div class="bar">a</div>
--
-- >>> div_ "a"
-- <div>a</div>
data (:@:) (a :: Element) b c where
  WithAttributes :: (a ??> b, a ?> c) => b -> c -> (a :@: b) c
infixr 8 :@:

-- | Wrapper for types which won't be escaped.
newtype Raw a = Raw a

  -------------------
  -- internal code --
  -------------------

type family Null xs where
  Null '[] = True
  Null _ = False

type family ShowElement e where
  ShowElement DOCTYPE    = "!DOCTYPE html"
  ShowElement A          = "a"
  ShowElement Abbr       = "abbr"
  ShowElement Acronym    = "acronym"
  ShowElement Address    = "address"
  ShowElement Applet     = "applet"
  ShowElement Area       = "area"
  ShowElement Article    = "article"
  ShowElement Aside      = "aside"
  ShowElement Audio      = "audio"
  ShowElement B          = "b"
  ShowElement Base       = "base"
  ShowElement Basefont   = "basefont"
  ShowElement Bdi        = "bdi"
  ShowElement Bdo        = "bdo"
  ShowElement Bgsound    = "bgsound"
  ShowElement Big        = "big"
  ShowElement Blink      = "blink"
  ShowElement Blockquote = "blockquote"
  ShowElement Body       = "body"
  ShowElement Br         = "br"
  ShowElement Button     = "button"
  ShowElement Canvas     = "canvas"
  ShowElement Caption    = "caption"
  ShowElement Center     = "center"
  ShowElement Cite       = "cite"
  ShowElement Code       = "code"
  ShowElement Col        = "col"
  ShowElement Colgroup   = "colgroup"
  ShowElement Command    = "command"
  ShowElement Content    = "content"
  ShowElement Data       = "data"
  ShowElement Datalist   = "datalist"
  ShowElement Dd         = "dd"
  ShowElement Del        = "del"
  ShowElement Details    = "details"
  ShowElement Dfn        = "dfn"
  ShowElement Dialog     = "dialog"
  ShowElement Dir        = "dir"
  ShowElement Div        = "div"
  ShowElement Dl         = "dl"
  ShowElement Dt         = "dt"
  ShowElement 'Element   = "element"
  ShowElement Em         = "em"
  ShowElement Embed      = "embed"
  ShowElement Fieldset   = "fieldset"
  ShowElement Figcaption = "figcaption"
  ShowElement Figure     = "figure"
  ShowElement Font       = "font"
  ShowElement Footer     = "footer"
  ShowElement Form       = "form"
  ShowElement Frame      = "frame"
  ShowElement Frameset   = "frameset"
  ShowElement H1         = "h1"
  ShowElement H2         = "h2"
  ShowElement H3         = "h3"
  ShowElement H4         = "h4"
  ShowElement H5         = "h5"
  ShowElement H6         = "h6"
  ShowElement Head       = "head"
  ShowElement Header     = "header"
  ShowElement Hgroup     = "hgroup"
  ShowElement Hr         = "hr"
  ShowElement Html       = "html"
  ShowElement I          = "i"
  ShowElement Iframe     = "iframe"
  ShowElement Image      = "image"
  ShowElement Img        = "img"
  ShowElement Input      = "input"
  ShowElement Ins        = "ins"
  ShowElement Isindex    = "isindex"
  ShowElement Kbd        = "kbd"
  ShowElement Keygen     = "keygen"
  ShowElement Label      = "label"
  ShowElement Legend     = "legend"
  ShowElement Li         = "li"
  ShowElement Link       = "link"
  ShowElement Listing    = "listing"
  ShowElement Main       = "main"
  ShowElement Map        = "map"
  ShowElement Mark       = "mark"
  ShowElement Marquee    = "marquee"
  ShowElement Math       = "math"
  ShowElement Menu       = "menu"
  ShowElement Menuitem   = "menuitem"
  ShowElement Meta       = "meta"
  ShowElement Meter      = "meter"
  ShowElement Multicol   = "multicol"
  ShowElement Nav        = "nav"
  ShowElement Nextid     = "nextid"
  ShowElement Nobr       = "nobr"
  ShowElement Noembed    = "noembed"
  ShowElement Noframes   = "noframes"
  ShowElement Noscript   = "noscript"
  ShowElement Object     = "object"
  ShowElement Ol         = "ol"
  ShowElement Optgroup   = "optgroup"
  ShowElement Option     = "option"
  ShowElement Output     = "output"
  ShowElement P          = "p"
  ShowElement Param      = "param"
  ShowElement Picture    = "picture"
  ShowElement Plaintext  = "plaintext"
  ShowElement Pre        = "pre"
  ShowElement Progress   = "progress"
  ShowElement Q          = "q"
  ShowElement Rp         = "rp"
  ShowElement Rt         = "rt"
  ShowElement Rtc        = "rtc"
  ShowElement Ruby       = "ruby"
  ShowElement S          = "s"
  ShowElement Samp       = "samp"
  ShowElement Script     = "script"
  ShowElement Section    = "section"
  ShowElement Select     = "select"
  ShowElement Shadow     = "shadow"
  ShowElement Slot       = "slot"
  ShowElement Small      = "small"
  ShowElement Source     = "source"
  ShowElement Spacer     = "spacer"
  ShowElement Span       = "span"
  ShowElement Strike     = "strike"
  ShowElement Strong     = "strong"
  ShowElement Style      = "style"
  ShowElement Sub        = "sub"
  ShowElement Summary    = "summary"
  ShowElement Sup        = "sup"
  ShowElement Svg        = "svg"
  ShowElement Table      = "table"
  ShowElement Tbody      = "tbody"
  ShowElement Td         = "td"
  ShowElement Template   = "template"
  ShowElement Textarea   = "textarea"
  ShowElement Tfoot      = "tfoot"
  ShowElement Th         = "th"
  ShowElement Thead      = "thead"
  ShowElement Time       = "time"
  ShowElement Title      = "title"
  ShowElement Tr         = "tr"
  ShowElement Track      = "track"
  ShowElement Tt         = "tt"
  ShowElement U          = "u"
  ShowElement Ul         = "ul"
  ShowElement Var        = "var"
  ShowElement Video      = "video"
  ShowElement Wbr        = "wbr"
  ShowElement Xmp        = "xmp"

type family ShowAttribute (x :: Attribute) where
  ShowAttribute AcceptA          = " accept=\""
  ShowAttribute AcceptCharsetA   = " accept-charset=\""
  ShowAttribute AccesskeyA       = " accesskey=\""
  ShowAttribute ActionA          = " action=\""
  ShowAttribute AlignA           = " align=\""
  ShowAttribute AltA             = " alt=\""
  ShowAttribute AsyncA           = " async=\""
  ShowAttribute AutocompleteA    = " autocomplete=\""
  ShowAttribute AutofocusA       = " autofocus=\""
  ShowAttribute AutoplayA        = " autoplay=\""
  ShowAttribute AutosaveA        = " autosave=\""
  ShowAttribute BgcolorA         = " bgcolor=\""
  ShowAttribute BorderA          = " border=\""
  ShowAttribute BufferedA        = " buffered=\""
  ShowAttribute ChallengeA       = " challenge=\""
  ShowAttribute CharsetA         = " charset=\""
  ShowAttribute CheckedA         = " checked=\""
  ShowAttribute CiteA            = " cite=\""
  ShowAttribute ClassA           = " class=\""
  ShowAttribute CodeA            = " code=\""
  ShowAttribute CodebaseA        = " codebase=\""
  ShowAttribute ColorA           = " color=\""
  ShowAttribute ColsA            = " cols=\""
  ShowAttribute ColspanA         = " colspan=\""
  ShowAttribute ContentA         = " content=\""
  ShowAttribute ContenteditableA = " contenteditable=\""
  ShowAttribute ContextmenuA     = " contextmenu=\""
  ShowAttribute ControlsA        = " controls=\""
  ShowAttribute CoordsA          = " coords=\""
  ShowAttribute CrossoriginA     = " crossorigin=\""
  ShowAttribute DataA            = " data=\""
  ShowAttribute DatetimeA        = " datetime=\""
  ShowAttribute DefaultA         = " default=\""
  ShowAttribute DeferA           = " defer=\""
  ShowAttribute DirA             = " dir=\""
  ShowAttribute DirnameA         = " dirname=\""
  ShowAttribute DisabledA        = " disabled=\""
  ShowAttribute DownloadA        = " download=\""
  ShowAttribute DraggableA       = " draggable=\""
  ShowAttribute DropzoneA        = " dropzone=\""
  ShowAttribute EnctypeA         = " enctype=\""
  ShowAttribute ForA             = " for=\""
  ShowAttribute FormA            = " form=\""
  ShowAttribute FormactionA      = " formaction=\""
  ShowAttribute HeadersA         = " headers=\""
  ShowAttribute HeightA          = " height=\""
  ShowAttribute HiddenA          = " hidden=\""
  ShowAttribute HighA            = " high=\""
  ShowAttribute HrefA            = " href=\""
  ShowAttribute HreflangA        = " hreflang=\""
  ShowAttribute HttpEquivA       = " httpequiv=\""
  ShowAttribute IconA            = " icon=\""
  ShowAttribute IdA              = " id=\""
  ShowAttribute IntegrityA       = " integrity=\""
  ShowAttribute IsmapA           = " ismap=\""
  ShowAttribute ItempropA        = " itemprop=\""
  ShowAttribute KeytypeA         = " keytype=\""
  ShowAttribute KindA            = " kind=\""
  ShowAttribute LabelA           = " label=\""
  ShowAttribute LangA            = " lang=\""
  ShowAttribute LanguageA        = " language=\""
  ShowAttribute ListA            = " list=\""
  ShowAttribute LoopA            = " loop=\""
  ShowAttribute LowA             = " low=\""
  ShowAttribute ManifestA        = " manifest=\""
  ShowAttribute MaxA             = " max=\""
  ShowAttribute MaxlengthA       = " maxlength=\""
  ShowAttribute MinlengthA       = " minlength=\""
  ShowAttribute MediaA           = " media=\""
  ShowAttribute MethodA          = " method=\""
  ShowAttribute MinA             = " min=\""
  ShowAttribute MultipleA        = " multiple=\""
  ShowAttribute MutedA           = " muted=\""
  ShowAttribute NameA            = " name=\""
  ShowAttribute NovalidateA      = " novalidate=\""
  ShowAttribute OpenA            = " open=\""
  ShowAttribute OptimumA         = " optimum=\""
  ShowAttribute PatternA         = " pattern=\""
  ShowAttribute PingA            = " ping=\""
  ShowAttribute PlaceholderA     = " placeholder=\""
  ShowAttribute PosterA          = " poster=\""
  ShowAttribute PreloadA         = " preload=\""
  ShowAttribute RadiogroupA      = " radiogroup=\""
  ShowAttribute ReadonlyA        = " readonly=\""
  ShowAttribute RelA             = " rel=\""
  ShowAttribute RequiredA        = " required=\""
  ShowAttribute ReversedA        = " reversed=\""
  ShowAttribute RowsA            = " rows=\""
  ShowAttribute RowspanA         = " rowspan=\""
  ShowAttribute SandboxA         = " sandbox=\""
  ShowAttribute ScopeA           = " scope=\""
  ShowAttribute ScopedA          = " scoped=\""
  ShowAttribute SeamlessA        = " seamless=\""
  ShowAttribute SelectedA        = " selected=\""
  ShowAttribute ShapeA           = " shape=\""
  ShowAttribute SizeA            = " size=\""
  ShowAttribute SizesA           = " sizes=\""
  ShowAttribute SlotA            = " slot=\""
  ShowAttribute SpanA            = " span=\""
  ShowAttribute SpellcheckA      = " spellcheck=\""
  ShowAttribute SrcA             = " src=\""
  ShowAttribute SrcdocA          = " srcdoc=\""
  ShowAttribute SrclangA         = " srclang=\""
  ShowAttribute SrcsetA          = " srcset=\""
  ShowAttribute StartA           = " start=\""
  ShowAttribute StepA            = " step=\""
  ShowAttribute StyleA           = " style=\""
  ShowAttribute SummaryA         = " summary=\""
  ShowAttribute TabindexA        = " tabindex=\""
  ShowAttribute TargetA          = " target=\""
  ShowAttribute TitleA           = " title=\""
  ShowAttribute TypeA            = " type=\""
  ShowAttribute UsemapA          = " usemap=\""
  ShowAttribute ValueA           = " value=\""
  ShowAttribute WidthA           = " width=\""
  ShowAttribute WrapA            = " wrap=\""

type family CountContent c where
  CountContent (a # b)       = CountContent a + CountContent b
  CountContent ((_ :@: b) c) = CountContent b + CountContent c
  CountContent (_ := b)      = CountContent b
  CountContent ()            = 0
  CountContent (Proxy _)     = 0
  CountContent _             = 1

-- | Check whether an element may have content.
type family HasContent a where
  HasContent (ElementInfo _ NoContent) = False
  HasContent _                         = True

-- | Append two type lists.
--
-- Note that this definition is that ugly to reduce compiletimes.
-- Please check whether the context reduction stack or compiletimes of
-- a big html page get bigger if you try to refactor.
type family Append xs ys :: [k] where

  Append (x1 ': x2 ': x3 ': x4 ': x5 ': x6 ': x7 ': x8 ': x9 ': x10 ': x11 ': x12 ': x13 ': x14 ': x15 ': x16 ': x17 ': x18 ': x19 ': x20 ': x21 ': x22 ': x23 ': x24 ': x25 ': x26 ': x27 ': x28 ': x29 ': x30 ': x31 ': x32 ': x33 ': x34 ': x35 ': x36 ': x37 ': x38 ': x39 ': x40 ': x41 ': x42 ': x43 ': x44 ': x45 ': x46 ': x47 ': x48 ': x49 ': x50 ': x51 ': x52 ': x53 ': x54 ': x55 ': x56 ': x57 ': x58 ': x59 ': x60 ': x61 ': x62 ': x63 ': x64 ': xs) ys
        = x1 ': x2 ': x3 ': x4 ': x5 ': x6 ': x7 ': x8 ': x9 ': x10 ': x11 ': x12 ': x13 ': x14 ': x15 ': x16 ': x17 ': x18 ': x19 ': x20 ': x21 ': x22 ': x23 ': x24 ': x25 ': x26 ': x27 ': x28 ': x29 ': x30 ': x31 ': x32 ': x33 ': x34 ': x35 ': x36 ': x37 ': x38 ': x39 ': x40 ': x41 ': x42 ': x43 ': x44 ': x45 ': x46 ': x47 ': x48 ': x49 ': x50 ': x51 ': x52 ': x53 ': x54 ': x55 ': x56 ': x57 ': x58 ': x59 ': x60 ': x61 ': x62 ': x63 ': x64 ': Append xs ys

  Append (x1 ': x2 ': x3 ': x4 ': x5 ': x6 ': x7 ': x8 ': x9 ': x10 ': x11 ': x12 ': x13 ': x14 ': x15 ': x16 ': x17 ': x18 ': x19 ': x20 ': x21 ': x22 ': x23 ': x24 ': x25 ': x26 ': x27 ': x28 ': x29 ': x30 ': x31 ': x32 ': xs) ys
        = x1 ': x2 ': x3 ': x4 ': x5 ': x6 ': x7 ': x8 ': x9 ': x10 ': x11 ': x12 ': x13 ': x14 ': x15 ': x16 ': x17 ': x18 ': x19 ': x20 ': x21 ': x22 ': x23 ': x24 ': x25 ': x26 ': x27 ': x28 ': x29 ': x30 ': x31 ': x32 ': Append xs ys

  Append (x1 ': x2 ': x3 ': x4 ': x5 ': x6 ': x7 ': x8 ': x9 ': x10 ': x11 ': x12 ': x13 ': x14 ': x15 ': x16 ': xs) ys
        = x1 ': x2 ': x3 ': x4 ': x5 ': x6 ': x7 ': x8 ': x9 ': x10 ': x11 ': x12 ': x13 ': x14 ': x15 ': x16 ': Append xs ys

  Append (x1 ': x2 ': x3 ': x4 ': x5 ': x6 ': x7 ': x8 ': xs) ys
        = x1 ': x2 ': x3 ': x4 ': x5 ': x6 ': x7 ': x8 ': Append xs ys

  Append (x1 ': x2 ': x3 ': x4 ': xs) ys
        = x1 ': x2 ': x3 ': x4 ': Append xs ys

  Append (x1 ': x2 ': xs) ys
        = x1 ': x2 ': Append xs ys

  Append (x1 ': xs) ys
        = x1 ': Append xs ys

  Append '[] ys
        = ys

-- | Type level drop.
--
-- Note that this definition is that ugly to reduce compiletimes.
-- Please check whether the context reduction stack or compiletimes of
-- a big html page get bigger if you try to refactor.
type family Drop n xs :: [k] where
  Drop 0 xs = xs
  Drop 1 (_ ': xs) = xs
  Drop 2 (_ ': _ ': xs) = xs
  Drop 3 (_ ': _ ': _ ': xs) = xs
  Drop 4 (_ ': _ ': _ ': _ ': xs) = xs
  Drop n (_ ': _ ': _ ': _ ': _ ': xs) = Drop (n-5) xs

-- | Type level take.
--
-- Note that this definition is that ugly to reduce compiletimes.
-- Please check whether the context reduction stack or compiletimes of
-- a big html page get bigger if you try to refactor.
type family Take n xs :: [k] where
  Take 0 _ = '[]
  Take 1 (x1 ': _) = '[x1]
  Take 2 (x1 ': x2 ': _) = '[x1, x2]
  Take 3 (x1 ': x2 ': x3 ': _) = '[x1, x2, x3]
  Take 4 (x1 ': x2 ': x3 ': x4 ': _) = '[x1, x2, x3, x4]
  Take n (x1 ': x2 ': x3 ': x4 ': x5 ': xs) = x1 ': x2 ': x3 ': x4 ': x5 ': Take (n-5) xs

-- | Type of type level information about tags.
data ElementInfo
  (contentCategories :: [ContentCategory])
  (permittedContent  :: ContentCategory)

type family TestPaternity a b c :: Bool where
  TestPaternity a (ElementInfo _ ps) (ElementInfo cs _) = CheckContentCategory ps (a ': cs)

type family CheckContentCategory (a :: ContentCategory) (b :: [ContentCategory]) :: Bool where
  CheckContentCategory (a :|: b) c = CheckContentCategory a c || CheckContentCategory b c
  CheckContentCategory (a :&: b) c = CheckContentCategory a c && CheckContentCategory b c
  CheckContentCategory (NOT a) c   = Not (CheckContentCategory a c)
  CheckContentCategory a c         = Elem a c

-- | Check whether a given element may contain a string.
type family CheckString (a :: Element) b where
  CheckString a b = If (TestPaternity OnlyText (GetInfo a) (ElementInfo '[FlowContent, PhrasingContent] NoContent))
                       (() :: Constraint)
                       (TypeError (ShowType a :<>: Text " can't contain a " :<>: ShowType b))

-- | Content categories according to the html spec.
data ContentCategory
  = MetadataContent
  | FlowContent
  | SectioningContent
  | HeadingContent
  | PhrasingContent
  | (:|:) ContentCategory ContentCategory
  | (:&:) ContentCategory ContentCategory
  | NOT ContentCategory
  | NoContent
  | OnlyText
  | SingleElement Element

infixr 2 :|:
infixr 3 :&:

type family MaybeTypeError (a :: Element) (b :: Element) c where
  MaybeTypeError a b c = If c (() :: Constraint)
   (TypeError (ShowType b :<>: Text " is not a valid child of " :<>: ShowType a))

type family Elem (a :: k) (xs :: [k]) where
  Elem a (a : xs) = True
  Elem a (_ : xs) = Elem a xs
  Elem a '[]      = False

newtype Tagged (proxies :: k) target = Tagged target

-- | Get type list of valid elements for a given attribute.  An empty list signifies global attribute.
type family GetAttributeInfo a where
  GetAttributeInfo AcceptA          = '[Form, Input]
  GetAttributeInfo AcceptCharsetA   = '[Form]
  GetAttributeInfo AccesskeyA       = '[]
  GetAttributeInfo ActionA          = '[Form]
  GetAttributeInfo AlignA           = '[Applet, Caption, Col, Colgroup, Hr, Iframe, Img, Table, Tbody, Td, Tfoot, Th, Thead, Tr]
  GetAttributeInfo AltA             = '[Applet, Area, Img, Input]
  GetAttributeInfo AsyncA           = '[Script]
  GetAttributeInfo AutocompleteA    = '[Form, Input]
  GetAttributeInfo AutofocusA       = '[Button, Input, Keygen, Select, Textarea]
  GetAttributeInfo AutoplayA        = '[Audio, Video]
  GetAttributeInfo AutosaveA        = '[Input]
  GetAttributeInfo BgcolorA         = '[Body, Col, Colgroup, Marquee, Table, Tbody, Tfoot, Td, Th, Tr]
  GetAttributeInfo BorderA          = '[Img, Object, Table]
  GetAttributeInfo BufferedA        = '[Audio, Video]
  GetAttributeInfo ChallengeA       = '[Keygen]
  GetAttributeInfo CharsetA         = '[Meta, Script]
  GetAttributeInfo CheckedA         = '[Command, Input]
  GetAttributeInfo CiteA            = '[Blockquote, Del, Ins, Q]
  GetAttributeInfo ClassA           = '[]
  GetAttributeInfo CodeA            = '[Applet]
  GetAttributeInfo CodebaseA        = '[Applet]
  GetAttributeInfo ColorA           = '[Basefont, Font, Hr]
  GetAttributeInfo ColsA            = '[Textarea]
  GetAttributeInfo ColspanA         = '[Td, Th]
  GetAttributeInfo ContentA         = '[Meta]
  GetAttributeInfo ContenteditableA = '[]
  GetAttributeInfo ContextmenuA     = '[]
  GetAttributeInfo ControlsA        = '[Audio, Video]
  GetAttributeInfo CoordsA          = '[Area]
  GetAttributeInfo CrossoriginA     = '[Audio, Img, Link, Script, Video]
  GetAttributeInfo DataA            = '[Object]
  GetAttributeInfo DatetimeA        = '[Del, Ins, Time]
  GetAttributeInfo DefaultA         = '[Track]
  GetAttributeInfo DeferA           = '[Script]
  GetAttributeInfo DirA             = '[]
  GetAttributeInfo DirnameA         = '[Input, Textarea]
  GetAttributeInfo DisabledA        = '[Button, Command, Fieldset, Input, Keygen, Optgroup, Option, Select, Textarea]
  GetAttributeInfo DownloadA        = '[A, Area]
  GetAttributeInfo DraggableA       = '[]
  GetAttributeInfo DropzoneA        = '[]
  GetAttributeInfo EnctypeA         = '[Form]
  GetAttributeInfo ForA             = '[Label, Output]
  GetAttributeInfo FormA            = '[Button, Fieldset, Input, Keygen, Label, Meter, Object, Output, Progress, Select, Textarea]
  GetAttributeInfo FormactionA      = '[Input, Button]
  GetAttributeInfo HeadersA         = '[Td, Th]
  GetAttributeInfo HeightA          = '[Canvas, Embed, Iframe, Img, Input, Object, Video]
  GetAttributeInfo HiddenA          = '[]
  GetAttributeInfo HighA            = '[Meter]
  GetAttributeInfo HrefA            = '[A, Area, Base, Link]
  GetAttributeInfo HreflangA        = '[A, Area, Link]
  GetAttributeInfo HttpEquivA       = '[Meta]
  GetAttributeInfo IconA            = '[Command]
  GetAttributeInfo IdA              = '[]
  GetAttributeInfo IntegrityA       = '[Link, Script]
  GetAttributeInfo IsmapA           = '[Img]
  GetAttributeInfo ItempropA        = '[]
  GetAttributeInfo KeytypeA         = '[Keygen]
  GetAttributeInfo KindA            = '[Track]
  GetAttributeInfo LabelA           = '[Track]
  GetAttributeInfo LangA            = '[]
  GetAttributeInfo LanguageA        = '[Script]
  GetAttributeInfo ListA            = '[Input]
  GetAttributeInfo LoopA            = '[Audio, Bgsound, Marquee, Video]
  GetAttributeInfo LowA             = '[Meter]
  GetAttributeInfo ManifestA        = '[Html]
  GetAttributeInfo MaxA             = '[Input, Meter, Progress]
  GetAttributeInfo MaxlengthA       = '[Input, Textarea]
  GetAttributeInfo MinlengthA       = '[Input, Textarea]
  GetAttributeInfo MediaA           = '[A, Area, Link, Source, Style]
  GetAttributeInfo MethodA          = '[Form]
  GetAttributeInfo MinA             = '[Input, Meter]
  GetAttributeInfo MultipleA        = '[Input, Select]
  GetAttributeInfo MutedA           = '[Video]
  GetAttributeInfo NameA            = '[Button, Form, Fieldset, Iframe, Input, Keygen, Object, Output, Select, Textarea, Map, Meta, Param]
  GetAttributeInfo NovalidateA      = '[Form]
  GetAttributeInfo OpenA            = '[Details]
  GetAttributeInfo OptimumA         = '[Meter]
  GetAttributeInfo PatternA         = '[Input]
  GetAttributeInfo PingA            = '[A, Area]
  GetAttributeInfo PlaceholderA     = '[Input, Textarea]
  GetAttributeInfo PosterA          = '[Video]
  GetAttributeInfo PreloadA         = '[Audio, Video]
  GetAttributeInfo RadiogroupA      = '[Command]
  GetAttributeInfo ReadonlyA        = '[Input, Textarea]
  GetAttributeInfo RelA             = '[A, Area, Link]
  GetAttributeInfo RequiredA        = '[Input, Select, Textarea]
  GetAttributeInfo ReversedA        = '[Ol]
  GetAttributeInfo RowsA            = '[Textarea]
  GetAttributeInfo RowspanA         = '[Td, Th]
  GetAttributeInfo SandboxA         = '[Iframe]
  GetAttributeInfo ScopeA           = '[Th]
  GetAttributeInfo ScopedA          = '[Style]
  GetAttributeInfo SeamlessA        = '[Iframe]
  GetAttributeInfo SelectedA        = '[Option]
  GetAttributeInfo ShapeA           = '[A, Area]
  GetAttributeInfo SizeA            = '[Input, Select]
  GetAttributeInfo SizesA           = '[Link, Img, Source]
  GetAttributeInfo SlotA            = '[]
  GetAttributeInfo SpanA            = '[Col, Colgroup]
  GetAttributeInfo SpellcheckA      = '[]
  GetAttributeInfo SrcA             = '[Audio, Embed, Iframe, Img, Input, Script, Source, Track, Video]
  GetAttributeInfo SrcdocA          = '[Iframe]
  GetAttributeInfo SrclangA         = '[Track]
  GetAttributeInfo SrcsetA          = '[Img]
  GetAttributeInfo StartA           = '[Ol]
  GetAttributeInfo StepA            = '[Input]
  GetAttributeInfo StyleA           = '[]
  GetAttributeInfo SummaryA         = '[Table]
  GetAttributeInfo TabindexA        = '[]
  GetAttributeInfo TargetA          = '[A, Area, Base, Form]
  GetAttributeInfo TitleA           = '[]
  GetAttributeInfo TypeA            = '[Button, Input, Command, Embed, Object, Script, Source, Style, Menu]
  GetAttributeInfo UsemapA          = '[Img, Input, Object]
  GetAttributeInfo ValueA           = '[Button, Option, Input, Li, Meter, Progress, Param]
  GetAttributeInfo WidthA           = '[Canvas, Embed, Iframe, Img, Input, Object, Video]
  GetAttributeInfo WrapA            = '[Textarea]

-- | Retrieve type level meta data about elements.
type family GetInfo a where

  GetInfo DOCTYPE = ElementInfo
    '[]
    NoContent

  GetInfo A = ElementInfo
    '[ FlowContent, PhrasingContent ]
    (FlowContent :&: NOT (SingleElement Details) :|: PhrasingContent)

  GetInfo Abbr = ElementInfo
    '[ FlowContent, PhrasingContent ]
    PhrasingContent

  GetInfo Address = ElementInfo
    '[ FlowContent ]
    (FlowContent :&: NOT (HeadingContent :|: SectioningContent :|: SingleElement Address :|: SingleElement Header :|: SingleElement Footer))

  GetInfo Area = ElementInfo
    '[ FlowContent, PhrasingContent ]
    NoContent

  GetInfo Article = ElementInfo
    '[ FlowContent, SectioningContent ]
    FlowContent

  GetInfo Aside = ElementInfo
    '[ FlowContent, SectioningContent ]
    FlowContent

  GetInfo Audio = ElementInfo
    '[ FlowContent, PhrasingContent ]
    (SingleElement Source :|: SingleElement Track)

  GetInfo B = ElementInfo
    '[ FlowContent, PhrasingContent ]
    PhrasingContent

  GetInfo Base = ElementInfo
    '[ MetadataContent ]
    NoContent

  GetInfo Bdi = ElementInfo
    '[ FlowContent, PhrasingContent ]
    PhrasingContent

  GetInfo Bdo = ElementInfo
    '[ FlowContent, PhrasingContent ]
    PhrasingContent

  GetInfo Blockquote = ElementInfo
    '[ FlowContent ]
    FlowContent

  GetInfo Body = ElementInfo
    '[]
    FlowContent

  GetInfo Br = ElementInfo
    '[ FlowContent, PhrasingContent ]
    NoContent

  GetInfo Button = ElementInfo
    '[ FlowContent, PhrasingContent ]
    PhrasingContent

  GetInfo Canvas = ElementInfo
    '[ FlowContent, PhrasingContent ]
    (SingleElement A :|: SingleElement Button :|: SingleElement Input)

  GetInfo Caption = ElementInfo
    '[]
    FlowContent

  GetInfo Cite = ElementInfo
    '[ FlowContent, PhrasingContent ]
    PhrasingContent

  GetInfo Code = ElementInfo
    '[ FlowContent, PhrasingContent ]
    PhrasingContent

  GetInfo Col = ElementInfo
    '[]
    NoContent

  GetInfo Colgroup = ElementInfo
    '[]
    (SingleElement Col)

  GetInfo Data = ElementInfo
    '[ FlowContent, PhrasingContent ]
    PhrasingContent

  GetInfo Datalist = ElementInfo
    '[ FlowContent, PhrasingContent ]
    (PhrasingContent :|: SingleElement Option)

  GetInfo Dd = ElementInfo
    '[]
    FlowContent

  GetInfo Del = ElementInfo
    '[ FlowContent, PhrasingContent ]
    OnlyText

  GetInfo Details = ElementInfo
    '[ FlowContent ]
    ( FlowContent :|: SingleElement Summary)

  GetInfo Dfn = ElementInfo
    '[ FlowContent, PhrasingContent ]
    (PhrasingContent :&: NOT (SingleElement Dfn))

  GetInfo Dialog = ElementInfo
    '[ FlowContent ]
    FlowContent

  GetInfo Div = ElementInfo
    '[ FlowContent ]
    (FlowContent :|: SingleElement Dt :|: SingleElement Dd :|: SingleElement Script :|: SingleElement Template)

  GetInfo Dl = ElementInfo
    '[ FlowContent ]
    (SingleElement Dt :|: SingleElement Dd :|: SingleElement Script :|: SingleElement Template :|: SingleElement Div)

  GetInfo Dt = ElementInfo
    '[]
    (FlowContent :&: NOT (SingleElement Header :|: SingleElement Footer :|: SectioningContent :|: HeadingContent))

  GetInfo Em = ElementInfo
    '[ FlowContent, PhrasingContent ]
    PhrasingContent

  GetInfo Embed = ElementInfo
    '[ FlowContent, PhrasingContent ]
    NoContent

  GetInfo Fieldset = ElementInfo
    '[ FlowContent ]
    (FlowContent :|: SingleElement Legend)

  GetInfo Figcaption = ElementInfo
    '[]
    FlowContent

  GetInfo Figure = ElementInfo
    '[ FlowContent ]
    (FlowContent :|: SingleElement Figcaption)

  GetInfo Footer = ElementInfo
    '[ FlowContent ]
    (FlowContent :&: NOT (SingleElement Footer :|: SingleElement Header))

  GetInfo Form = ElementInfo
    '[ FlowContent ]
    (FlowContent :&: NOT (SingleElement Form))

  GetInfo H1 = ElementInfo
    '[ FlowContent, HeadingContent ]
    PhrasingContent

  GetInfo H2 = ElementInfo
    '[ FlowContent, HeadingContent ]
    PhrasingContent

  GetInfo H3 = ElementInfo
    '[ FlowContent, HeadingContent ]
    PhrasingContent

  GetInfo H4 = ElementInfo
    '[ FlowContent, HeadingContent ]
    PhrasingContent

  GetInfo H5 = ElementInfo
    '[ FlowContent, HeadingContent ]
    PhrasingContent

  GetInfo H6 = ElementInfo
    '[ FlowContent, HeadingContent ]
    PhrasingContent

  GetInfo Head = ElementInfo
    '[]
    MetadataContent

  GetInfo Header = ElementInfo
    '[ FlowContent ]
    (FlowContent :&: NOT (SingleElement Header :|: SingleElement Footer))

  GetInfo Hgroup = ElementInfo
    '[ FlowContent, HeadingContent ]
    (SingleElement H1 :|: SingleElement H2 :|: SingleElement H3 :|: SingleElement H4 :|: SingleElement H5 :|: SingleElement H6)

  GetInfo Hr = ElementInfo
    '[ FlowContent ]
    NoContent

  GetInfo Html = ElementInfo
    '[]
    (SingleElement Head :|: SingleElement Body)

  GetInfo I = ElementInfo
    '[ FlowContent, PhrasingContent ]
    PhrasingContent

  GetInfo Iframe = ElementInfo
    '[ FlowContent, PhrasingContent ]
    NoContent

  GetInfo Img = ElementInfo
    '[ FlowContent, PhrasingContent ]
    NoContent

  GetInfo Ins = ElementInfo
    '[ FlowContent, PhrasingContent ]
    OnlyText

  GetInfo Kbd = ElementInfo
    '[ FlowContent, PhrasingContent ]
    PhrasingContent

  GetInfo Label = ElementInfo
    '[ FlowContent, PhrasingContent ]
    (PhrasingContent :&: NOT (SingleElement Label))

  GetInfo Legend = ElementInfo
    '[]
    PhrasingContent

  GetInfo Li = ElementInfo
    '[]
    FlowContent

  GetInfo Link = ElementInfo
    '[ FlowContent, PhrasingContent, MetadataContent ]
    NoContent

  GetInfo Main = ElementInfo
    '[ FlowContent ]
    FlowContent

  GetInfo Map = ElementInfo
    '[ FlowContent, PhrasingContent ]
    OnlyText

  GetInfo Mark = ElementInfo
    '[ FlowContent, PhrasingContent ]
    PhrasingContent

  GetInfo Menu = ElementInfo
    '[ FlowContent ]
    (FlowContent :|: SingleElement Li :|: SingleElement Script :|: SingleElement Template :|: SingleElement Menu :|: SingleElement Menuitem :|: SingleElement Hr)

  GetInfo Menuitem = ElementInfo
    '[]
    NoContent

  GetInfo Meta = ElementInfo
    '[ FlowContent, MetadataContent, PhrasingContent ]
    NoContent

  GetInfo Meter = ElementInfo
    '[ FlowContent, PhrasingContent ]
    (PhrasingContent :&: NOT (SingleElement Meter))

  GetInfo Nav = ElementInfo
    '[ FlowContent, SectioningContent ]
    FlowContent

  GetInfo Noscript = ElementInfo
    '[ FlowContent, MetadataContent, PhrasingContent ]
    (FlowContent :|: PhrasingContent :|: SingleElement Link :|: SingleElement Style :|: SingleElement Meta)

  GetInfo Object = ElementInfo
    '[ FlowContent, PhrasingContent ]
    (SingleElement Param)

  GetInfo Ol = ElementInfo
    '[ FlowContent ]
    (SingleElement Li)

  GetInfo Optgroup = ElementInfo
    '[]
    (SingleElement Option)

  GetInfo Option = ElementInfo
    '[]
    OnlyText

  GetInfo Output = ElementInfo
    '[ FlowContent, PhrasingContent ]
    PhrasingContent

  GetInfo P = ElementInfo
    '[ FlowContent ]
    PhrasingContent

  GetInfo Param = ElementInfo
    '[]
    NoContent

  GetInfo Picture = ElementInfo
    '[ FlowContent, PhrasingContent ]
    (SingleElement Source :|: SingleElement Img)

  GetInfo Pre = ElementInfo
    '[ FlowContent ]
    PhrasingContent

  GetInfo Progress = ElementInfo
    '[ FlowContent, PhrasingContent ]
    (PhrasingContent :&: NOT (SingleElement Progress))

  GetInfo Q = ElementInfo
    '[ FlowContent, PhrasingContent ]
    PhrasingContent

  GetInfo Rp = ElementInfo
    '[]
    OnlyText

  GetInfo Rt = ElementInfo
    '[]
    PhrasingContent

  GetInfo Rtc = ElementInfo
    '[]
    (PhrasingContent :|: SingleElement Rt)

  GetInfo Ruby = ElementInfo
    '[ FlowContent, PhrasingContent ]
    PhrasingContent

  GetInfo S = ElementInfo
    '[ FlowContent, PhrasingContent ]
    PhrasingContent

  GetInfo Samp = ElementInfo
    '[ FlowContent, PhrasingContent ]
    PhrasingContent

  GetInfo Script = ElementInfo
    '[ FlowContent, MetadataContent, PhrasingContent ]
    OnlyText

  GetInfo Section = ElementInfo
    '[ FlowContent, SectioningContent ]
    FlowContent

  GetInfo Select = ElementInfo
    '[ FlowContent, PhrasingContent ]
    (SingleElement Option :|: SingleElement Optgroup)

  GetInfo Slot = ElementInfo
    '[ FlowContent, PhrasingContent ]
    OnlyText

  GetInfo Small = ElementInfo
    '[ FlowContent, PhrasingContent ]
    PhrasingContent

  GetInfo Source = ElementInfo
    '[]
    NoContent

  GetInfo Span = ElementInfo
    '[ FlowContent, PhrasingContent ]
    PhrasingContent

  GetInfo Strong = ElementInfo
    '[ FlowContent, PhrasingContent ]
    PhrasingContent

  GetInfo Style = ElementInfo
    '[ FlowContent, MetadataContent ]
    OnlyText

  GetInfo Sub = ElementInfo
    '[ FlowContent, PhrasingContent ]
    PhrasingContent

  GetInfo Summary = ElementInfo
    '[]
    (PhrasingContent :|: HeadingContent)

  GetInfo Sup = ElementInfo
    '[ FlowContent, PhrasingContent ]
    PhrasingContent

  GetInfo Table = ElementInfo
    '[FlowContent]
    (SingleElement Caption :|: SingleElement Colgroup :|: SingleElement Thead :|: SingleElement Tbody :|: SingleElement Tr :|: SingleElement Tfoot)

  GetInfo Tbody = ElementInfo
    '[]
    (SingleElement Tr)

  GetInfo Td = ElementInfo
    '[]
    FlowContent

  GetInfo Template = ElementInfo
    '[ FlowContent, MetadataContent, PhrasingContent ]
    (FlowContent :|: MetadataContent)

  GetInfo Textarea = ElementInfo
    '[ FlowContent, PhrasingContent ]
    OnlyText

  GetInfo Tfoot = ElementInfo
    '[]
    (SingleElement Tr)

  GetInfo Th = ElementInfo
    '[]
    (FlowContent :&: NOT (SingleElement Header :|: SingleElement Footer :|: SectioningContent :|: HeadingContent))

  GetInfo Thead = ElementInfo
    '[]
    (SingleElement Tr)

  GetInfo Time = ElementInfo
    '[ FlowContent, PhrasingContent ]
    PhrasingContent

  GetInfo Title = ElementInfo
    '[ MetadataContent ]
    OnlyText

  GetInfo Tr = ElementInfo
    '[]
    (SingleElement Td :|: SingleElement Th)

  GetInfo Track = ElementInfo
    '[]
    NoContent

  GetInfo U = ElementInfo
    '[ FlowContent, PhrasingContent ]
    PhrasingContent

  GetInfo Ul = ElementInfo
    '[ FlowContent ]
    (SingleElement Li)

  GetInfo Var = ElementInfo
    '[ FlowContent, PhrasingContent ]
    PhrasingContent

  GetInfo Video = ElementInfo
    '[ FlowContent, PhrasingContent ]
    (SingleElement Track :|: SingleElement Source)

  GetInfo Wbr = ElementInfo
    '[ FlowContent, PhrasingContent ]
    NoContent

  GetInfo _ = ElementInfo
    '[ FlowContent, PhrasingContent ]
    (FlowContent :|: PhrasingContent)