module Text.HTML.Tagchup.PositionTag where

import qualified Text.HTML.Tagchup.Character as Chr
import qualified Text.HTML.Tagchup.Tag as Tag
import qualified Text.XML.Basic.Name as Name
import qualified Text.XML.Basic.Position as Position

import Data.Tuple.HT (mapFst, )
import Data.Monoid (Monoid, mempty, mappend, )

import qualified Data.Accessor.Basic as Accessor
import qualified Control.Applicative as App

import Data.Foldable (Foldable(foldMap), )
import Data.Traversable (Traversable(sequenceA), )
import Control.Applicative (Applicative, )


data T name string =
   Cons {
      forall name string. T name string -> T
position_ :: Position.T,
      forall name string. T name string -> T name string
tag_ :: Tag.T name string
   }

instance (Name.Attribute name, Show string, Show name) =>
   Show (T name string) where
  showsPrec :: Int -> T name string -> ShowS
showsPrec Int
p (Cons T
pos T name string
t) =
     Bool -> ShowS -> ShowS
showParen (Int
p forall a. Ord a => a -> a -> Bool
> Int
10)
        (String -> ShowS
showString String
"PosTag.cons " forall b c a. (b -> c) -> (a -> b) -> a -> c
.
         forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 T
pos forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" " forall b c a. (b -> c) -> (a -> b) -> a -> c
.
         forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 T name string
t)

{-
> cons (Position.new "bla" 0 0) (Tag.Close $ Name.fromString "bla" :: Tag.T Text.XML.Basic.Name.LowerCase.T String)
-}
cons :: Position.T -> Tag.T name string -> T name string
cons :: forall name string. T -> T name string -> T name string
cons = forall name string. T -> T name string -> T name string
Cons

position :: Accessor.T (T name string) Position.T
position :: forall name string. T (T name string) T
position = forall a r. (a -> r -> r) -> (r -> a) -> T r a
Accessor.fromSetGet (\T
n T name string
p -> T name string
p{position_ :: T
position_ = T
n}) forall name string. T name string -> T
position_

tag :: Accessor.T (T name string) (Tag.T name string)
tag :: forall name string. T (T name string) (T name string)
tag = forall a r. (a -> r -> r) -> (r -> a) -> T r a
Accessor.fromSetGet (\T name string
n T name string
p -> T name string
p{tag_ :: T name string
tag_ = T name string
n}) forall name string. T name string -> T name string
tag_

lift ::
   (Tag.T name0 string0 -> Tag.T name1 string1) ->
   (T name0 string0 -> T name1 string1)
lift :: forall name0 string0 name1 string1.
(T name0 string0 -> T name1 string1)
-> T name0 string0 -> T name1 string1
lift T name0 string0 -> T name1 string1
f (Cons T
p T name0 string0
t) = forall name string. T -> T name string -> T name string
Cons T
p (T name0 string0 -> T name1 string1
f T name0 string0
t)

liftA ::
   Applicative f =>
   (Tag.T name0 string0 -> f (Tag.T name1 string1)) ->
   (T name0 string0 -> f (T name1 string1))
liftA :: forall (f :: * -> *) name0 string0 name1 string1.
Applicative f =>
(T name0 string0 -> f (T name1 string1))
-> T name0 string0 -> f (T name1 string1)
liftA T name0 string0 -> f (T name1 string1)
f (Cons T
p T name0 string0
t) = forall (f :: * -> *) a b. Applicative f => (a -> b) -> f a -> f b
App.liftA (forall name string. T -> T name string -> T name string
Cons T
p) (T name0 string0 -> f (T name1 string1)
f T name0 string0
t)


instance Functor (T name) where
   fmap :: forall a b. (a -> b) -> T name a -> T name b
fmap a -> b
f = forall name0 string0 name1 string1.
(T name0 string0 -> T name1 string1)
-> T name0 string0 -> T name1 string1
lift (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f)

instance Foldable (T name) where
   foldMap :: forall m a. Monoid m => (a -> m) -> T name a -> m
foldMap a -> m
f = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall name string. T name string -> T name string
tag_

instance Traversable (T name) where
   sequenceA :: forall (f :: * -> *) a.
Applicative f =>
T name (f a) -> f (T name a)
sequenceA (Cons T
p T name (f a)
t) = forall (f :: * -> *) a b. Applicative f => (a -> b) -> f a -> f b
App.liftA (forall name string. T -> T name string -> T name string
Cons T
p) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA T name (f a)
t


textFromCData ::
   (Name.Tag name, Chr.C char) =>
   T name [char] -> T name [char]
textFromCData :: forall name char.
(Tag name, C char) =>
T name [char] -> T name [char]
textFromCData = forall name0 string0 name1 string1.
(T name0 string0 -> T name1 string1)
-> T name0 string0 -> T name1 string1
lift forall name char.
(Tag name, C char) =>
T name [char] -> T name [char]
Tag.textFromCData


{- |
Merge adjacent Text sections.
-}
concatTexts ::
   Monoid string =>
   [T name string] -> [T name string]
concatTexts :: forall string name.
Monoid string =>
[T name string] -> [T name string]
concatTexts =
   forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
      (\T name string
t [T name string]
ts ->
         case T name string
t of
            Cons T
pos (Tag.Text string
str0) ->
               forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (:) forall a b. (a -> b) -> a -> b
$
               forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst (forall name string. T -> T name string -> T name string
cons T
pos forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall name string. string -> T name string
Tag.Text forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => a -> a -> a
mappend string
str0) forall a b. (a -> b) -> a -> b
$
               case [T name string]
ts of
                  Cons T
_ (Tag.Text string
str1) : [T name string]
rest -> (string
str1,[T name string]
rest)
                  [T name string]
_ -> (forall a. Monoid a => a
mempty,[T name string]
ts)
            T name string
_ -> T name string
tforall a. a -> [a] -> [a]
:[T name string]
ts)
      []