{-# OPTIONS_GHC -fno-warn-orphans #-}

{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ScopedTypeVariables  #-}
{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE TypeApplications     #-}
{-# LANGUAGE FlexibleContexts     #-}
{-# LANGUAGE ConstraintKinds      #-}
{-# LANGUAGE TypeOperators        #-}
{-# LANGUAGE DataKinds            #-}
{-# LANGUAGE PolyKinds            #-}

module Html
  ( module Html.Type
  , module Html.Convert
  , renderString
  , renderText
  , renderByteString
  , renderBuilder
  , compactHTML
  , renderCompactString
  , renderCompactText
  , renderCompactByteString
  , renderCompactBuilder
  , Put(..)
  , V(..)
  ) where

import Html.Reify
import Html.Convert
import Html.Type
import Html.Type.Internal

import Control.Arrow
import GHC.Exts
import Data.Either
import Data.List
import Data.ByteString.Builder
import Data.Maybe

import qualified Data.ByteString               as B
import qualified Data.ByteString.Lazy          as BL
import qualified Data.ByteString.Builder.Extra as BE
import qualified Data.Text.Lazy                as T
import qualified Data.Text.Lazy.Encoding       as T

-- | Render a html document to a Builder.
renderBuilder :: Document a => a -> Builder
renderBuilder :: a -> Builder
renderBuilder = Converted -> Builder
unConv (Converted -> Builder) -> (a -> Converted) -> a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (u :: Bool) a. R u a => a -> RenderOutput u
forall a. R 'False a => a -> RenderOutput 'False
render @'False (T (ToList a) a -> Converted)
-> (a -> T (ToList a) a) -> a -> Converted
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> T (ToList a) a
forall k (proxies :: k) target. target -> T proxies target
T :: a -> T (ToList a) a))

-- | Render a html document to a String.
renderString :: Document a => a -> String
renderString :: a -> String
renderString = Text -> String
T.unpack (Text -> String) -> (a -> Text) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Text
forall a. Document a => a -> Text
renderText

-- | Render a html document to a lazy Text.
renderText :: Document a => a -> T.Text
renderText :: a -> Text
renderText = ByteString -> Text
T.decodeUtf8 (ByteString -> Text) -> (a -> ByteString) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ByteString
forall a. Document a => a -> ByteString
renderByteString

-- | Render a html document to a lazy ByteString.
renderByteString :: Document a => a -> BL.ByteString
renderByteString :: a -> ByteString
renderByteString = AllocationStrategy -> ByteString -> Builder -> ByteString
BE.toLazyByteStringWith
  ( Int -> Int -> AllocationStrategy
BE.untrimmedStrategy
    Int
1024
    Int
BE.smallChunkSize
  ) ByteString
BL.empty (Builder -> ByteString) -> (a -> Builder) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Builder
forall a. Document a => a -> Builder
renderBuilder

renderCompactHTML :: Retrievable a => (Builder -> f) -> CompactHTML a -> Retrieve f a
renderCompactHTML :: (Builder -> f) -> CompactHTML a -> Retrieve f a
renderCompactHTML = ([Builder] -> [Builder])
-> (Builder -> f) -> CompactHTML a -> Retrieve f a
forall (a :: [Symbol]) f.
Retrievable a =>
([Builder] -> [Builder])
-> (Builder -> f) -> CompactHTML a -> Retrieve f a
retrieve [Builder] -> [Builder]
forall a. a -> a
id

-- | Render a compacted html document to a Builder.
renderCompactBuilder :: Retrievable a => CompactHTML a -> Retrieve Builder a
renderCompactBuilder :: CompactHTML a -> Retrieve Builder a
renderCompactBuilder = (Builder -> Builder) -> CompactHTML a -> Retrieve Builder a
forall (a :: [Symbol]) f.
Retrievable a =>
(Builder -> f) -> CompactHTML a -> Retrieve f a
renderCompactHTML Builder -> Builder
forall a. a -> a
id

-- | Render a compacted html document to a lazy ByteString.
renderCompactByteString :: Retrievable a => CompactHTML a -> Retrieve BL.ByteString a
renderCompactByteString :: CompactHTML a -> Retrieve ByteString a
renderCompactByteString = (Builder -> ByteString) -> CompactHTML a -> Retrieve ByteString a
forall (a :: [Symbol]) f.
Retrievable a =>
(Builder -> f) -> CompactHTML a -> Retrieve f a
renderCompactHTML Builder -> ByteString
toLazyBS

-- | Render a compacted html document to a lazy Text.
renderCompactText :: Retrievable a => CompactHTML a -> Retrieve T.Text a
renderCompactText :: CompactHTML a -> Retrieve Text a
renderCompactText = (Builder -> Text) -> CompactHTML a -> Retrieve Text a
forall (a :: [Symbol]) f.
Retrievable a =>
(Builder -> f) -> CompactHTML a -> Retrieve f a
renderCompactHTML (ByteString -> Text
T.decodeUtf8 (ByteString -> Text) -> (Builder -> ByteString) -> Builder -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
toLazyBS)

-- | Render a compacted html document to a String.
renderCompactString :: Retrievable a => CompactHTML a -> Retrieve String a
renderCompactString :: CompactHTML a -> Retrieve String a
renderCompactString = (Builder -> String) -> CompactHTML a -> Retrieve String a
forall (a :: [Symbol]) f.
Retrievable a =>
(Builder -> f) -> CompactHTML a -> Retrieve f a
renderCompactHTML (Text -> String
T.unpack (Text -> String) -> (Builder -> Text) -> Builder -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
T.decodeUtf8 (ByteString -> Text) -> (Builder -> ByteString) -> Builder -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
toLazyBS)

toLazyBS :: Builder -> BL.ByteString
toLazyBS :: Builder -> ByteString
toLazyBS = AllocationStrategy -> ByteString -> Builder -> ByteString
BE.toLazyByteStringWith (Int -> Int -> AllocationStrategy
BE.untrimmedStrategy Int
1024 Int
BE.smallChunkSize) ByteString
BL.empty

-- | Compact a html document.
compactHTML :: Compactable a => a -> CompactHTML (Variables a)
compactHTML :: a -> CompactHTML (Variables a)
compactHTML a
html
  = (ByteString -> [(Int, ByteString)] -> CompactHTML (Variables a))
-> (ByteString, [(Int, ByteString)]) -> CompactHTML (Variables a)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ByteString -> [(Int, ByteString)] -> CompactHTML (Variables a)
forall (a :: [Symbol]).
ByteString -> [(Int, ByteString)] -> CompactHTML a
MkCompactHTML
  ((ByteString, [(Int, ByteString)]) -> CompactHTML (Variables a))
-> (T (ToList a) a -> (ByteString, [(Int, ByteString)]))
-> T (ToList a) a
-> CompactHTML (Variables a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Either Converted String] -> (ByteString, [(Int, ByteString)])
concatEithers
  ([Either Converted String] -> (ByteString, [(Int, ByteString)]))
-> (T (ToList a) a -> [Either Converted String])
-> T (ToList a) a
-> (ByteString, [(Int, ByteString)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq (Either Converted String) -> [Either Converted String]
forall l. IsList l => l -> [Item l]
toList
  (Seq (Either Converted String) -> [Either Converted String])
-> (T (ToList a) a -> Seq (Either Converted String))
-> T (ToList a) a
-> [Either Converted String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (u :: Bool) a. R u a => a -> RenderOutput u
forall a. R 'True a => a -> RenderOutput 'True
render @'True
  (T (ToList a) a -> CompactHTML (Variables a))
-> T (ToList a) a -> CompactHTML (Variables a)
forall a b. (a -> b) -> a -> b
$ (forall a. a -> T (ToList a) a
forall k (proxies :: k) target. target -> T proxies target
T :: a -> T (ToList a) a) a
html
  where
    concatEithers :: [Either Converted String] -> (B.ByteString, [(Int, B.ByteString)])
    concatEithers :: [Either Converted String] -> (ByteString, [(Int, ByteString)])
concatEithers = ([Either Converted String] -> ByteString
forall b. [Either Converted b] -> ByteString
f ([Either Converted String] -> ByteString)
-> ([Either Converted String] -> [(Int, ByteString)])
-> ([Either Converted String], [Either Converted String])
-> (ByteString, [(Int, ByteString)])
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** [Either Converted String] -> [(Int, ByteString)]
go) (([Either Converted String], [Either Converted String])
 -> (ByteString, [(Int, ByteString)]))
-> ([Either Converted String]
    -> ([Either Converted String], [Either Converted String]))
-> [Either Converted String]
-> (ByteString, [(Int, ByteString)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either Converted String -> Bool)
-> [Either Converted String]
-> ([Either Converted String], [Either Converted String])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Either Converted String -> Bool
forall a b. Either a b -> Bool
isLeft
      where go :: [Either Converted String] -> [(Int, ByteString)]
go (Right String
r1:[Either Converted String]
xs) = let ([Either Converted String]
ls,[Either Converted String]
rs) = (Either Converted String -> Bool)
-> [Either Converted String]
-> ([Either Converted String], [Either Converted String])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Either Converted String -> Bool
forall a b. Either a b -> Bool
isLeft [Either Converted String]
xs
                               in (a -> String -> Int
forall a. Compactable a => a -> String -> Int
indexVar a
html String
r1, [Either Converted String] -> ByteString
forall b. [Either Converted b] -> ByteString
f [Either Converted String]
ls) (Int, ByteString) -> [(Int, ByteString)] -> [(Int, ByteString)]
forall a. a -> [a] -> [a]
: [Either Converted String] -> [(Int, ByteString)]
go [Either Converted String]
rs
            go [Either Converted String]
_ = []
            f :: [Either Converted b] -> ByteString
f = ByteString -> ByteString
BL.toStrict (ByteString -> ByteString)
-> ([Either Converted b] -> ByteString)
-> [Either Converted b]
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
toLazyByteString (Builder -> ByteString)
-> ([Either Converted b] -> Builder)
-> [Either Converted b]
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Converted -> Builder
unConv (Converted -> Builder)
-> ([Either Converted b] -> Converted)
-> [Either Converted b]
-> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Converted] -> Converted
forall a. Monoid a => [a] -> a
mconcat ([Converted] -> Converted)
-> ([Either Converted b] -> [Converted])
-> [Either Converted b]
-> Converted
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Either Converted b] -> [Converted]
forall a b. [Either a b] -> [a]
lefts
    indexVar :: forall a. Compactable a => a -> String -> Int
    indexVar :: a -> String -> Int
indexVar a
_ String
s = Maybe Int -> Int
forall a. HasCallStack => Maybe a -> a
fromJust (String -> [String] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex String
s (ShowTypeList (Variables a) => [String]
forall k (a :: k). ShowTypeList a => [String]
showTypeList @(Variables a)))

-- | Show instances to faciliate ghci development.
instance Document (a := b) => Show (a := b) where show :: (a := b) -> String
show = (a := b) -> String
forall a. Document a => a -> String
renderString
instance Document (a # b) => Show (a # b) where show :: (a # b) -> String
show = (a # b) -> String
forall a. Document a => a -> String
renderString

instance Document (a :@ b) => Show (a :@ b) where show :: (a :@ b) -> String
show = (a :@ b) -> String
forall a. Document a => a -> String
renderString
instance Document (a :> b) => Show (a :> b) where show :: (a :> b) -> String
show = (a :> b) -> String
forall a. Document a => a -> String
renderString
instance Document (Attribute a global boolean) => Show (Attribute a global boolean) where show :: Attribute a global boolean -> String
show = Attribute a global boolean -> String
forall a. Document a => a -> String
renderString
instance Document (Element name categories contentModel contentAttributes) => Show (Element name categories contentModel contentAttributes) where show :: Element name categories contentModel contentAttributes -> String
show = Element name categories contentModel contentAttributes -> String
forall a. Document a => a -> String
renderString