{-# LANGUAGE QuasiQuotes #-}

module Web.Hyperbole.Document where

import Data.ByteString.Lazy qualified as BL
import Data.String.Interpolate (i)
import Web.Hyperbole.View


data Document = Document


{- | 'liveApp' requires a function which turns an html fragment into an entire html document. Use this to import javascript, css, etc. Use 'quickStartDocument' to get going quickly

> app :: Application
> app = liveApp (document documentHead) (routeRequest router)
-}
document :: View DocumentHead () -> BL.ByteString -> BL.ByteString
document :: View DocumentHead () -> ByteString -> ByteString
document View DocumentHead ()
docHead ByteString
cnt =
  [i|<html>
  <head>
    #{renderLazyByteString $ addContext DocumentHead docHead}
  </head>
  <body>
    #{cnt}
  </body>
</html>|]


{- | Create a custom \<head\> to use with 'document'. Remember to include at least `scriptEmbed`!

> import Web.Hyperbole (scriptEmbed, cssEmbed)
>
> documentHead :: View DocumentHead ()
> documentHead = do
>   title "My Website"
>   script' scriptEmbed
>   style cssEmbed
>   script "custom.js"
>
> app :: Application
> app = liveApp (document documentHead) (routeRequest router)
-}
data DocumentHead = DocumentHead


{- | A simple mobile-friendly document with all required embeds and live reload

@
'liveApp' quickStartDocument ('routeRequest' router)
@
-}
quickStartDocument :: BL.ByteString -> BL.ByteString
quickStartDocument :: ByteString -> ByteString
quickStartDocument = View DocumentHead () -> ByteString -> ByteString
document (View DocumentHead ()
mobileFriendly View DocumentHead ()
-> View DocumentHead () -> View DocumentHead ()
forall a b.
View DocumentHead a -> View DocumentHead b -> View DocumentHead b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> View DocumentHead ()
quickStart)


-- | A simple mobile-friendly header with all required embeds and live reload
quickStart :: View DocumentHead ()
quickStart :: View DocumentHead ()
quickStart = do
  View DocumentHead ()
mobileFriendly
  ByteString -> View DocumentHead ()
forall c. ByteString -> View c ()
style ByteString
cssEmbed
  ByteString -> View DocumentHead ()
forall c. ByteString -> View c ()
script' ByteString
scriptEmbed
  ByteString -> View DocumentHead ()
forall c. ByteString -> View c ()
script' ByteString
scriptLiveReload


-- | Set the viewport to handle mobile zoom
mobileFriendly :: View DocumentHead ()
mobileFriendly :: View DocumentHead ()
mobileFriendly = do
  View DocumentHead ()
forall c. View c ()
meta View DocumentHead ()
-> (Attributes (View DocumentHead ())
    -> Attributes (View DocumentHead ()))
-> View DocumentHead ()
forall h.
Attributable h =>
h -> (Attributes h -> Attributes h) -> h
@ Text
-> Attributes (View DocumentHead ())
-> Attributes (View DocumentHead ())
forall h. Attributable h => Text -> Attributes h -> Attributes h
httpEquiv Text
"Content-Type" (Attributes (View DocumentHead ())
 -> Attributes (View DocumentHead ()))
-> (Attributes (View DocumentHead ())
    -> Attributes (View DocumentHead ()))
-> Attributes (View DocumentHead ())
-> Attributes (View DocumentHead ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text
-> Attributes (View DocumentHead ())
-> Attributes (View DocumentHead ())
forall h. Attributable h => Text -> Attributes h -> Attributes h
content Text
"text/html" (Attributes (View DocumentHead ())
 -> Attributes (View DocumentHead ()))
-> (Attributes (View DocumentHead ())
    -> Attributes (View DocumentHead ()))
-> Attributes (View DocumentHead ())
-> Attributes (View DocumentHead ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text
-> Attributes (View DocumentHead ())
-> Attributes (View DocumentHead ())
forall h. Attributable h => Text -> Attributes h -> Attributes h
charset Text
"UTF-8"
  View DocumentHead ()
forall c. View c ()
meta View DocumentHead ()
-> (Attributes (View DocumentHead ())
    -> Attributes (View DocumentHead ()))
-> View DocumentHead ()
forall h.
Attributable h =>
h -> (Attributes h -> Attributes h) -> h
@ Text
-> Attributes (View DocumentHead ())
-> Attributes (View DocumentHead ())
forall h. Attributable h => Text -> Attributes h -> Attributes h
name Text
"viewport" (Attributes (View DocumentHead ())
 -> Attributes (View DocumentHead ()))
-> (Attributes (View DocumentHead ())
    -> Attributes (View DocumentHead ()))
-> Attributes (View DocumentHead ())
-> Attributes (View DocumentHead ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text
-> Attributes (View DocumentHead ())
-> Attributes (View DocumentHead ())
forall h. Attributable h => Text -> Attributes h -> Attributes h
content Text
"width=device-width, initial-scale=1.0"