{-|
Convert a tag soup to its text representation
respecting various conventions for merging open and close tags.
-}
module Text.HTML.Tagchup.Format (
   xml, xmlCondensed, html, xhtml, htmlOrXhtml,
   ) where

import qualified Text.HTML.Tagchup.Tag as Tag
import qualified Text.HTML.Basic.Tag      as TagH
import qualified Text.XML.Basic.Name      as Name
import qualified Text.XML.Basic.Format    as Fmt

import Data.List.HT (viewL, )
import Data.Maybe (fromMaybe, )
import Control.Monad (guard, )


{-
*Text.HTML.Tagchup.Format> flip xml "" $ (Text.HTML.TagSoup.HT.Parser.runSoup "<?xml version=1.0 ?>" :: [Tag.T Text.XML.Basic.Name.LowerCase.T String])
-}


{- |
All tags are formatted as they are.
-}
xml :: (Name.Tag name, Name.Attribute name, Fmt.C string) =>
   [Tag.T name string] -> ShowS
xml :: forall name string.
(Tag name, Attribute name, C string) =>
[T name string] -> ShowS
xml = forall a. (a -> ShowS) -> [a] -> ShowS
Fmt.many forall object. C object => object -> ShowS
Fmt.run


{- |
Adjacent corresponding open and close tags are merged to a self-closing tag.
E.g. @\<a\>\<\/a\>@ becomes @\<a\/\>@.
-}
xmlCondensed :: (Name.Tag name, Name.Attribute name, Fmt.C string) =>
   [Tag.T name string] -> ShowS
xmlCondensed :: forall name string.
(Tag name, Attribute name, C string) =>
[T name string] -> ShowS
xmlCondensed = forall name string.
(Tag name, Attribute name, C string) =>
(Name name -> Name name -> Bool) -> [T name string] -> ShowS
xmlCondensedGen forall a. Eq a => a -> a -> Bool
(==)

{- |
All tags that are defined being self-closing by the HTML standard
are formatted only as open tag.
E.g. @\<br\>@.
-}
html :: (Name.Tag name, Name.Attribute name, Fmt.C string) =>
   [Tag.T name string] -> ShowS
html :: forall name string.
(Tag name, Attribute name, C string) =>
[T name string] -> ShowS
html =
   forall a. (a -> ShowS) -> [a] -> ShowS
Fmt.many forall object. C object => object -> ShowS
Fmt.run forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   forall a. (a -> Bool) -> [a] -> [a]
filter (forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall name. Tag name => Name name -> Bool
TagH.isEmpty) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall name string. T name string -> Maybe (Name name)
Tag.maybeClose)

{- |
All tags that are defined being self-closing by the XHTML standard
are formatted as self-closing open tag.
E.g. @\<br\/\>@.
-}
xhtml :: (Name.Tag name, Name.Attribute name, Fmt.C string) =>
   [Tag.T name string] -> ShowS
xhtml :: forall name string.
(Tag name, Attribute name, C string) =>
[T name string] -> ShowS
xhtml =
   forall name string.
(Tag name, Attribute name, C string) =>
(Name name -> Name name -> Bool) -> [T name string] -> ShowS
xmlCondensedGen
      -- e.g. <div></div> must not be merged to <div/>
      (\Name name
nameOpen Name name
nameClose ->
          Name name
nameOpenforall a. Eq a => a -> a -> Bool
==Name name
nameClose Bool -> Bool -> Bool
&& forall name. Tag name => Name name -> Bool
TagH.isEmpty Name name
nameOpen)

{- |
If the first tag is @\<?xml ...?\>@ then format in XHTML style,
else in HTML style.
-}
htmlOrXhtml :: (Name.Tag name, Name.Attribute name, Fmt.C string) =>
   [Tag.T name string] -> ShowS
htmlOrXhtml :: forall name string.
(Tag name, Attribute name, C string) =>
[T name string] -> ShowS
htmlOrXhtml [T name string]
tags =
   forall a. a -> Maybe a -> a
fromMaybe (forall name string.
(Tag name, Attribute name, C string) =>
[T name string] -> ShowS
html [T name string]
tags) forall a b. (a -> b) -> a -> b
$
      do (T name string
tag,[T name string]
_) <- forall a. [a] -> Maybe (a, [a])
viewL [T name string]
tags
         (Name name
name,T name string
_) <- forall name string.
T name string -> Maybe (Name name, T name string)
Tag.maybeProcessing T name string
tag
         forall (f :: * -> *). Alternative f => Bool -> f ()
guard (forall name. C name => String -> name -> Bool
Name.match String
"xml" Name name
name)
         forall (m :: * -> *) a. Monad m => a -> m a
return (forall name string.
(Tag name, Attribute name, C string) =>
[T name string] -> ShowS
xhtml [T name string]
tags)


xmlCondensedGen :: (Name.Tag name, Name.Attribute name, Fmt.C string) =>
   (Tag.Name name -> Tag.Name name -> Bool) ->
   [Tag.T name string] -> ShowS
xmlCondensedGen :: forall name string.
(Tag name, Attribute name, C string) =>
(Name name -> Name name -> Bool) -> [T name string] -> ShowS
xmlCondensedGen Name name -> Name name -> Bool
check =
   let recourse :: [T name string] -> ShowS
recourse (Tag.Open Name name
nameOpen [T name string]
attrs : Tag.Close Name name
nameClose : [T name string]
ts) =
          (if Name name -> Name name -> Bool
check Name name
nameOpen Name name
nameClose
             then forall name string.
(Tag name, Attribute name, C string) =>
Bool -> Name name -> [T name string] -> ShowS
Tag.formatOpen Bool
True  Name name
nameOpen [T name string]
attrs
             else forall name string.
(Tag name, Attribute name, C string) =>
Bool -> Name name -> [T name string] -> ShowS
Tag.formatOpen Bool
False Name name
nameOpen [T name string]
attrs forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  forall name. Tag name => Name name -> ShowS
Tag.formatClose Name name
nameClose)
          forall b c a. (b -> c) -> (a -> b) -> a -> c
. [T name string] -> ShowS
recourse [T name string]
ts
       recourse (T name string
t : [T name string]
ts) = forall object. C object => object -> ShowS
Fmt.run T name string
t forall b c a. (b -> c) -> (a -> b) -> a -> c
. [T name string] -> ShowS
recourse [T name string]
ts
       recourse [] = forall a. a -> a
id
   in  forall {string}. C string => [T name string] -> ShowS
recourse