{-# LANGUAGE
NoMonomorphismRestriction
,FlexibleInstances
,MultiParamTypeClasses
,UndecidableInstances
,GeneralizedNewtypeDeriving
,RankNTypes
,CPP
 #-}
#if MIN_VERSION_blaze_markup(0,7,1)
#define PRE_BUILDER
#endif
module Text.BlazeT
  (
    -- * reexports from Text.Blaze
      Markup
    , B.Tag
    , B.Attribute
    , B.AttributeValue

      -- * Creating attributes.
    , B.dataAttribute
    , B.customAttribute

      -- * Converting values to Markup.
    , ToMarkup (..)
    , text
    , preEscapedText
    , lazyText
    , preEscapedLazyText
    , string
    , preEscapedString
    , unsafeByteString
    , unsafeLazyByteString

      -- * Comments
    , B.textComment
    , B.lazyTextComment
    , B.stringComment
    , B.unsafeByteStringComment
    , B.unsafeLazyByteStringComment

      -- * Creating tags.
    , B.textTag
    , B.stringTag

      -- * Converting values to attribute values.
    , B.ToValue (..)
    , B.textValue
    , B.preEscapedTextValue
    , B.lazyTextValue
    , B.preEscapedLazyTextValue
    , B.stringValue
    , B.preEscapedStringValue
    , B.unsafeByteStringValue
    , B.unsafeLazyByteStringValue

      -- * Setting attributes
    , (B.!)
    , (B.!?)

      -- * Modifiying Markup trees
    , contents


  -- * reexports from  Text.Blaze.Html
    , Html
    , toHtml
    , preEscapedToHtml

  -- * reexports from Text.Blaze.Internal
      -- * Important types.
    , MarkupM

      -- * Creating custom tags and attributes.
    , customParent
    , customLeaf

      -- * Converting values to Markup.
    , textBuilder
    , preEscapedTextBuilder

      -- * Setting attributes
    , B.Attributable

      -- * Modifying Markup elements
    , external

      -- * Querying Markup elements
    , null

  -- * BlazeT new stuff
  ,HtmlM
  ,HtmlT
  ,Markup2
  ,mapMarkupT
  ,MarkupT
  ,runMarkup
  ,runMarkupT
  ,execMarkup
  ,execMarkupT
  ,wrapMarkup
  ,wrapMarkupT
  ,wrapMarkup2
  ,wrapMarkupT2
  ) where

-- import           Control.Monad.Trans.Writer
-- import           Data.Functor.Identity
import           Control.Monad.Trans.Class
import           Control.Monad.Identity
import           Control.Monad.Writer.Strict
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BL
import           Data.String
import qualified Data.Text as T
import qualified Data.Text.Lazy as LT
import qualified Data.Text.Lazy.Builder as LTB
import qualified Text.Blaze as B
import qualified Text.Blaze.Internal as B

newtype MarkupT m a= MarkupT { fromMarkupT :: WriterT B.Markup m a }
                     deriving (Functor
#if MIN_VERSION_base(4,8,0)
                              ,Applicative
#endif
                              ,Monad
                              ,MonadWriter B.Markup
                              ,MonadTrans
                              )

-- | Map both the return value and markup of a computation using the
-- given function
mapMarkupT :: (m (a,B.Markup) -> n (b,B.Markup)) -> MarkupT m a -> MarkupT n b
mapMarkupT f = MarkupT . mapWriterT f . fromMarkupT

type MarkupM = MarkupT Identity
type Markup = forall m . Monad m => MarkupT m ()
type Markup2 = forall m . Monad m => MarkupT m () -> MarkupT m ()

type HtmlT = MarkupT
type HtmlM = MarkupM
type Html = Markup


runMarkupT :: MarkupT m a -> m (a,B.Markup)
runMarkupT = runWriterT . fromMarkupT

execMarkupT :: Monad m => MarkupT m a -> m B.Markup
execMarkupT = liftM snd . runMarkupT

runMarkup :: MarkupM a -> (a,B.Markup)
runMarkup = runIdentity . runMarkupT

execMarkup :: MarkupM a -> B.Markup
execMarkup = snd . runMarkup

-- instance MonadTrans MarkupT where


instance (Monad m,Monoid a) => Monoid (MarkupT m a) where
  mempty = return mempty
  a `mappend` b = do {a' <- a; b >>= return . (mappend a')}
  {-# INLINE mappend #-}


instance Monad m => B.Attributable (MarkupT m a) where
  h ! a = wrapMarkupT2 (B.! a) h

instance Monad m => B.Attributable (a -> MarkupT m b) where
  h ! a = \x -> wrapMarkupT2 (B.! a) $ h x

instance Monad m => IsString (MarkupT m ()) where
  fromString = wrapMarkup . fromString

class ToMarkup a where
  toMarkup :: a -> Markup
  preEscapedToMarkup :: a -> Markup

-- test :: (ToMarkup a, Monad m) => a -> MarkupT m ()
-- test = toMarkup

instance B.ToMarkup a => ToMarkup a where
  toMarkup = wrapMarkup . B.toMarkup
  {-# INLINE toMarkup #-}
  preEscapedToMarkup = wrapMarkup . B.preEscapedToMarkup
  {-# INLINE preEscapedToMarkup #-}

toHtml ::(ToMarkup a) => a -> Html
toHtml = toMarkup

preEscapedToHtml ::(ToMarkup a) => a -> Html
preEscapedToHtml = preEscapedToMarkup

wrapMarkupT :: Monad m => B.Markup -> MarkupT m ()
wrapMarkupT = tell

wrapMarkup :: B.Markup -> Markup
wrapMarkup = wrapMarkupT

wrapMarkupT2 ::  Monad m => (B.Markup -> B.Markup)
                 -> MarkupT m a -> MarkupT m a
wrapMarkupT2 x = censor x

wrapMarkup2 :: (B.Markup -> B.Markup) -> Markup2
wrapMarkup2 = wrapMarkupT2

unsafeByteString :: BS.ByteString -> Markup
unsafeByteString = wrapMarkup . B.unsafeByteString
{-# INLINE unsafeByteString #-}

-- | Insert a lazy 'BL.ByteString'. See 'unsafeByteString' for reasons why this
-- is an unsafe operation.
--
unsafeLazyByteString :: BL.ByteString  -- ^ Value to insert
                     -> Markup         -- ^ Resulting HTML fragment
unsafeLazyByteString = wrapMarkup . B.unsafeLazyByteString

external :: Monad m => MarkupT m a -> MarkupT m a
external = wrapMarkupT2  B.external

contents :: Monad m => MarkupT m a -> MarkupT m a
contents = wrapMarkupT2  B.contents

customParent ::B.Tag -> Markup2
customParent = wrapMarkup2 . B.customParent

customLeaf :: B.Tag -> Bool -> Markup
customLeaf = fmap wrapMarkup . B.customLeaf

preEscapedText :: T.Text -> Markup
preEscapedText = wrapMarkup . B.preEscapedText

preEscapedLazyText :: LT.Text -> Markup
preEscapedLazyText = wrapMarkup . B.preEscapedLazyText

preEscapedTextBuilder :: LTB.Builder -> Markup
textBuilder :: LTB.Builder -> Markup

#ifdef PRE_BUILDER
preEscapedTextBuilder = wrapMarkup . B.preEscapedTextBuilder
textBuilder = wrapMarkup . B.textBuilder
#else
preEscapedTextBuilder = error "This function needs blaze-markup 0.7.1.0"
textBuilder = error "This function needs blaze-markup 0.7.1.0"
#endif

preEscapedString :: String -> Markup
preEscapedString = wrapMarkup . B.preEscapedString

string :: String -> Markup
string = wrapMarkup . B.string

text :: T.Text -> Markup
text = wrapMarkup . B.text

lazyText :: LT.Text -> Markup
lazyText = wrapMarkup . B.lazyText