{-# LANGUAGE
FlexibleContexts
, FlexibleInstances
, MonoLocalBinds
, OverloadedStrings
, UndecidableInstances
, ExtendedDefaultRules
, MultiParamTypeClasses
#-}
module Data.Markup.Library where
import Data.Markup.Class (Deploy (deploy))
import Data.Markup.Types (Inline (..), Remote (..), Locally (..))
import Data.Url (MonadUrl (locUrl, absDirUrl, absFileUrl), GroundedUrlT, AbsoluteUrlT)
import Data.URI (printURI)
import Path (Path, Abs, Dir, File)
import Path.Extended (Location)
import qualified Lucid as L
import qualified Text.Blaze.Html5 as H
import qualified Text.Blaze.Html5.Attributes as A
import qualified Text.Blaze.Internal as HI
import qualified Clay as C
import qualified Data.Text as T
import qualified Data.Text.Lazy as LT
import Control.Monad.Trans (MonadTrans (lift))
data Image = Image deriving (Show, Eq)
data JavaScript = JavaScript deriving (Show, Eq)
data Css = Css deriving (Show, Eq)
data WebComponent = WebComponent deriving (Show, Eq)
linkedImageLucid :: Monad m => T.Text -> L.HtmlT m ()
linkedImageLucid link =
L.img_ [L.src_ link]
instance ( Monad m
) => Deploy Image Remote T.Text (L.HtmlT m) where
deploy Image Remote = linkedImageLucid
instance ( Monad m
, MonadUrl (AbsoluteUrlT m)
) => Deploy Image Remote (Path Abs File) (L.HtmlT (AbsoluteUrlT m)) where
deploy Image Remote i = do
link <- lift (absFileUrl i)
linkedImageLucid (printURI link)
instance ( Monad m
, MonadUrl (AbsoluteUrlT m)
) => Deploy Image Remote (Path Abs Dir) (L.HtmlT (AbsoluteUrlT m)) where
deploy Image Remote i = do
link <- lift (absDirUrl i)
linkedImageLucid (printURI link)
instance ( Monad m
, MonadUrl (AbsoluteUrlT m)
) => Deploy Image Remote Location (L.HtmlT (AbsoluteUrlT m)) where
deploy Image Remote i = do
link <- lift (locUrl i)
linkedImageLucid (printURI link)
instance ( Monad m
) => Deploy Image Locally T.Text (L.HtmlT m) where
deploy Image Locally = linkedImageLucid
instance ( Monad m
, MonadUrl (GroundedUrlT m)
) => Deploy Image Locally (Path Abs File) (L.HtmlT (GroundedUrlT m)) where
deploy Image Locally i = do
link <- lift (absFileUrl i)
linkedImageLucid (printURI link)
instance ( Monad m
, MonadUrl (GroundedUrlT m)
) => Deploy Image Locally (Path Abs Dir) (L.HtmlT (GroundedUrlT m)) where
deploy Image Locally i = do
link <- lift (absDirUrl i)
linkedImageLucid (printURI link)
instance ( Monad m
, MonadUrl (GroundedUrlT m)
) => Deploy Image Locally Location (L.HtmlT (GroundedUrlT m)) where
deploy Image Locally i = do
link <- lift (locUrl i)
linkedImageLucid (printURI link)
linkedImageBlaze :: T.Text -> HI.MarkupM ()
linkedImageBlaze link =
H.img H.! A.src (H.toValue link)
instance Deploy Image Remote T.Text HI.MarkupM where
deploy Image Remote = linkedImageBlaze
instance ( MonadUrl (AbsoluteUrlT HI.MarkupM)
) => Deploy Image Remote (Path Abs File) (AbsoluteUrlT HI.MarkupM) where
deploy Image Remote i = do
link <- absFileUrl i
lift (linkedImageBlaze (printURI link))
instance ( MonadUrl (AbsoluteUrlT HI.MarkupM)
) => Deploy Image Remote (Path Abs Dir) (AbsoluteUrlT HI.MarkupM) where
deploy Image Remote i = do
link <- absDirUrl i
lift (linkedImageBlaze (printURI link))
instance ( MonadUrl (AbsoluteUrlT HI.MarkupM)
) => Deploy Image Remote Location (AbsoluteUrlT HI.MarkupM) where
deploy Image Remote i = do
link <- locUrl i
lift (linkedImageBlaze (printURI link))
instance Deploy Image Locally T.Text HI.MarkupM where
deploy Image Locally = linkedImageBlaze
instance ( MonadUrl (GroundedUrlT HI.MarkupM)
) => Deploy Image Locally (Path Abs File) (GroundedUrlT HI.MarkupM) where
deploy Image Locally i = do
link <- absFileUrl i
lift (linkedImageBlaze (printURI link))
instance ( MonadUrl (GroundedUrlT HI.MarkupM)
) => Deploy Image Locally (Path Abs Dir) (GroundedUrlT HI.MarkupM) where
deploy Image Locally i = do
link <- absDirUrl i
lift (linkedImageBlaze (printURI link))
instance ( MonadUrl (GroundedUrlT HI.MarkupM)
) => Deploy Image Locally Location (GroundedUrlT HI.MarkupM) where
deploy Image Locally i = do
link <- locUrl i
lift (linkedImageBlaze (printURI link))
linkedJavaScriptLucid :: Monad m => T.Text -> L.HtmlT m ()
linkedJavaScriptLucid link =
L.script_ [L.src_ link] ("" :: T.Text)
instance ( Monad m
) => Deploy JavaScript Remote T.Text (L.HtmlT m) where
deploy JavaScript Remote = linkedJavaScriptLucid
instance ( Monad m
, MonadUrl (AbsoluteUrlT m)
) => Deploy JavaScript Remote (Path Abs File) (L.HtmlT (AbsoluteUrlT m)) where
deploy JavaScript Remote i = do
link <- lift (absFileUrl i)
linkedJavaScriptLucid (printURI link)
instance ( Monad m
, MonadUrl (AbsoluteUrlT m)
) => Deploy JavaScript Remote (Path Abs Dir) (L.HtmlT (AbsoluteUrlT m)) where
deploy JavaScript Remote i = do
link <- lift (absDirUrl i)
linkedJavaScriptLucid (printURI link)
instance ( Monad m
, MonadUrl (AbsoluteUrlT m)
) => Deploy JavaScript Remote Location (L.HtmlT (AbsoluteUrlT m)) where
deploy JavaScript Remote i = do
link <- lift (locUrl i)
linkedJavaScriptLucid (printURI link)
instance ( Monad m
) => Deploy JavaScript Locally T.Text (L.HtmlT m) where
deploy JavaScript Locally = linkedJavaScriptLucid
instance ( Monad m
, MonadUrl (GroundedUrlT m)
) => Deploy JavaScript Locally (Path Abs File) (L.HtmlT (GroundedUrlT m)) where
deploy JavaScript Locally i = do
link <- lift (absFileUrl i)
linkedJavaScriptLucid (printURI link)
instance ( Monad m
, MonadUrl (GroundedUrlT m)
) => Deploy JavaScript Locally (Path Abs Dir) (L.HtmlT (GroundedUrlT m)) where
deploy JavaScript Locally i = do
link <- lift (absDirUrl i)
linkedJavaScriptLucid (printURI link)
instance ( Monad m
, MonadUrl (GroundedUrlT m)
) => Deploy JavaScript Locally Location (L.HtmlT (GroundedUrlT m)) where
deploy JavaScript Locally i = do
link <- lift (locUrl i)
linkedJavaScriptLucid (printURI link)
instance ( Monad m
) => Deploy JavaScript Inline T.Text (L.HtmlT m) where
deploy JavaScript Inline =
L.script_ []
instance ( Monad m
) => Deploy JavaScript Inline LT.Text (L.HtmlT m) where
deploy JavaScript Inline =
L.script_ []
linkedJavaScriptBlaze :: T.Text -> HI.MarkupM ()
linkedJavaScriptBlaze link =
H.script (H.toHtml ("" :: T.Text)) H.! A.src (H.toValue link)
instance Deploy JavaScript Remote T.Text HI.MarkupM where
deploy JavaScript Remote = linkedJavaScriptBlaze
instance ( MonadUrl (AbsoluteUrlT HI.MarkupM)
) => Deploy JavaScript Remote (Path Abs File) (AbsoluteUrlT HI.MarkupM) where
deploy JavaScript Remote i = do
link <- absFileUrl i
lift (linkedJavaScriptBlaze (printURI link))
instance ( MonadUrl (AbsoluteUrlT HI.MarkupM)
) => Deploy JavaScript Remote (Path Abs Dir) (AbsoluteUrlT HI.MarkupM) where
deploy JavaScript Remote i = do
link <- absDirUrl i
lift (linkedJavaScriptBlaze (printURI link))
instance ( MonadUrl (AbsoluteUrlT HI.MarkupM)
) => Deploy JavaScript Remote Location (AbsoluteUrlT HI.MarkupM) where
deploy JavaScript Remote i = do
link <- locUrl i
lift (linkedJavaScriptBlaze (printURI link))
instance Deploy JavaScript Locally T.Text HI.MarkupM where
deploy JavaScript Locally = linkedJavaScriptBlaze
instance ( MonadUrl (GroundedUrlT HI.MarkupM)
) => Deploy JavaScript Locally (Path Abs File) (GroundedUrlT HI.MarkupM) where
deploy JavaScript Locally i = do
link <- absFileUrl i
lift (linkedJavaScriptBlaze (printURI link))
instance ( MonadUrl (GroundedUrlT HI.MarkupM)
) => Deploy JavaScript Locally (Path Abs Dir) (GroundedUrlT HI.MarkupM) where
deploy JavaScript Locally i = do
link <- absDirUrl i
lift (linkedJavaScriptBlaze (printURI link))
instance ( MonadUrl (GroundedUrlT HI.MarkupM)
) => Deploy JavaScript Locally Location (GroundedUrlT HI.MarkupM) where
deploy JavaScript Locally i = do
link <- locUrl i
lift (linkedJavaScriptBlaze (printURI link))
instance Deploy JavaScript Inline T.Text HI.MarkupM where
deploy JavaScript Inline i =
H.script (H.toHtml i)
instance Deploy JavaScript Inline LT.Text HI.MarkupM where
deploy JavaScript Inline i =
H.script (H.toHtml i)
linkedCssLucid :: Monad m => T.Text -> L.HtmlT m ()
linkedCssLucid link =
L.link_ [ L.rel_ "stylesheet"
, L.type_ "text/css"
, L.href_ link
]
instance ( Monad m
) => Deploy Css Remote T.Text (L.HtmlT m) where
deploy Css Remote = linkedCssLucid
instance ( Monad m
, MonadUrl (AbsoluteUrlT m)
) => Deploy Css Remote (Path Abs File) (L.HtmlT (AbsoluteUrlT m)) where
deploy Css Remote i = do
link <- lift (absFileUrl i)
linkedCssLucid (printURI link)
instance ( Monad m
, MonadUrl (AbsoluteUrlT m)
) => Deploy Css Remote (Path Abs Dir) (L.HtmlT (AbsoluteUrlT m)) where
deploy Css Remote i = do
link <- lift (absDirUrl i)
linkedCssLucid (printURI link)
instance ( Monad m
, MonadUrl (AbsoluteUrlT m)
) => Deploy Css Remote Location (L.HtmlT (AbsoluteUrlT m)) where
deploy Css Remote i = do
link <- lift (locUrl i)
linkedCssLucid (printURI link)
instance ( Monad m
) => Deploy Css Locally T.Text (L.HtmlT m) where
deploy Css Locally = linkedCssLucid
instance ( Monad m
, MonadUrl (GroundedUrlT m)
) => Deploy Css Locally (Path Abs File) (L.HtmlT (GroundedUrlT m)) where
deploy Css Locally i = do
link <- lift (absFileUrl i)
linkedCssLucid (printURI link)
instance ( Monad m
, MonadUrl (GroundedUrlT m)
) => Deploy Css Locally (Path Abs Dir) (L.HtmlT (GroundedUrlT m)) where
deploy Css Locally i = do
link <- lift (absDirUrl i)
linkedCssLucid (printURI link)
instance ( Monad m
, MonadUrl (GroundedUrlT m)
) => Deploy Css Locally Location (L.HtmlT (GroundedUrlT m)) where
deploy Css Locally i = do
link <- lift (locUrl i)
linkedCssLucid (printURI link)
instance ( Monad m
) => Deploy Css Inline T.Text (L.HtmlT m) where
deploy Css Inline =
L.style_ []
instance ( Monad m
) => Deploy Css Inline LT.Text (L.HtmlT m) where
deploy Css Inline =
L.style_ []
instance ( Monad m
) => Deploy Css Inline C.Css (L.HtmlT m) where
deploy Css Inline i =
L.style_ [] (C.render i)
linkedCssBlaze :: T.Text -> HI.MarkupM ()
linkedCssBlaze link =
H.link H.! A.rel "stylesheet"
H.! A.type_ "text/css"
H.! A.href (H.toValue link)
instance Deploy Css Remote T.Text HI.MarkupM where
deploy Css Remote = linkedCssBlaze
instance ( MonadUrl (AbsoluteUrlT HI.MarkupM)
) => Deploy Css Remote (Path Abs File) (AbsoluteUrlT HI.MarkupM) where
deploy Css Remote i = do
link <- absFileUrl i
lift (linkedCssBlaze (printURI link))
instance ( MonadUrl (AbsoluteUrlT HI.MarkupM)
) => Deploy Css Remote (Path Abs Dir) (AbsoluteUrlT HI.MarkupM) where
deploy Css Remote i = do
link <- absDirUrl i
lift (linkedCssBlaze (printURI link))
instance ( MonadUrl (AbsoluteUrlT HI.MarkupM)
) => Deploy Css Remote Location (AbsoluteUrlT HI.MarkupM) where
deploy Css Remote i = do
link <- locUrl i
lift (linkedCssBlaze (printURI link))
instance Deploy Css Locally T.Text HI.MarkupM where
deploy Css Locally = linkedCssBlaze
instance ( MonadUrl (GroundedUrlT HI.MarkupM)
) => Deploy Css Locally (Path Abs File) (GroundedUrlT HI.MarkupM) where
deploy Css Locally i = do
link <- absFileUrl i
lift (linkedCssBlaze (printURI link))
instance ( MonadUrl (GroundedUrlT HI.MarkupM)
) => Deploy Css Locally (Path Abs Dir) (GroundedUrlT HI.MarkupM) where
deploy Css Locally i = do
link <- absDirUrl i
lift (linkedCssBlaze (printURI link))
instance ( MonadUrl (GroundedUrlT HI.MarkupM)
) => Deploy Css Locally Location (GroundedUrlT HI.MarkupM) where
deploy Css Locally i = do
link <- locUrl i
lift (linkedCssBlaze (printURI link))
instance Deploy Css Inline T.Text HI.MarkupM where
deploy Css Inline i =
H.style (H.toHtml i)
instance Deploy Css Inline LT.Text HI.MarkupM where
deploy Css Inline i =
H.style (H.toHtml i)
instance Deploy Css Inline C.Css HI.MarkupM where
deploy Css Inline i =
H.style (H.toHtml (C.render i))
linkedWebComponentLucid :: Monad m => T.Text -> L.HtmlT m ()
linkedWebComponentLucid link =
L.link_ [ L.rel_ "import"
, L.href_ link
]
instance ( Monad m
) => Deploy WebComponent Remote T.Text (L.HtmlT m) where
deploy WebComponent Remote = linkedWebComponentLucid
instance ( Monad m
, MonadUrl (AbsoluteUrlT m)
) => Deploy WebComponent Remote (Path Abs File) (L.HtmlT (AbsoluteUrlT m)) where
deploy WebComponent Remote i = do
link <- lift (absFileUrl i)
linkedWebComponentLucid (printURI link)
instance ( Monad m
, MonadUrl (AbsoluteUrlT m)
) => Deploy WebComponent Remote (Path Abs Dir) (L.HtmlT (AbsoluteUrlT m)) where
deploy WebComponent Remote i = do
link <- lift (absDirUrl i)
linkedWebComponentLucid (printURI link)
instance ( Monad m
, MonadUrl (AbsoluteUrlT m)
) => Deploy WebComponent Remote Location (L.HtmlT (AbsoluteUrlT m)) where
deploy WebComponent Remote i = do
link <- lift (locUrl i)
linkedWebComponentLucid (printURI link)
instance ( Monad m
) => Deploy WebComponent Locally T.Text (L.HtmlT m) where
deploy WebComponent Locally = linkedWebComponentLucid
instance ( Monad m
, MonadUrl (GroundedUrlT m)
) => Deploy WebComponent Locally (Path Abs File) (L.HtmlT (GroundedUrlT m)) where
deploy WebComponent Locally i = do
link <- lift (absFileUrl i)
linkedWebComponentLucid (printURI link)
instance ( Monad m
, MonadUrl (GroundedUrlT m)
) => Deploy WebComponent Locally (Path Abs Dir) (L.HtmlT (GroundedUrlT m)) where
deploy WebComponent Locally i = do
link <- lift (absDirUrl i)
linkedWebComponentLucid (printURI link)
instance ( Monad m
, MonadUrl (GroundedUrlT m)
) => Deploy WebComponent Locally Location (L.HtmlT (GroundedUrlT m)) where
deploy WebComponent Locally i = do
link <- lift (locUrl i)
linkedWebComponentLucid (printURI link)
linkedWebComponentBlaze :: T.Text -> HI.MarkupM ()
linkedWebComponentBlaze link =
H.link H.! A.rel "import"
H.! A.href (H.toValue link)
instance Deploy WebComponent Remote T.Text HI.MarkupM where
deploy WebComponent Remote = linkedWebComponentBlaze
instance ( MonadUrl (AbsoluteUrlT HI.MarkupM)
) => Deploy WebComponent Remote (Path Abs File) (AbsoluteUrlT HI.MarkupM) where
deploy WebComponent Remote i = do
link <- absFileUrl i
lift (linkedWebComponentBlaze (printURI link))
instance ( MonadUrl (AbsoluteUrlT HI.MarkupM)
) => Deploy WebComponent Remote (Path Abs Dir) (AbsoluteUrlT HI.MarkupM) where
deploy WebComponent Remote i = do
link <- absDirUrl i
lift (linkedWebComponentBlaze (printURI link))
instance ( MonadUrl (AbsoluteUrlT HI.MarkupM)
) => Deploy WebComponent Remote Location (AbsoluteUrlT HI.MarkupM) where
deploy WebComponent Remote i = do
link <- locUrl i
lift (linkedWebComponentBlaze (printURI link))
instance Deploy WebComponent Locally T.Text HI.MarkupM where
deploy WebComponent Locally = linkedWebComponentBlaze
instance ( MonadUrl (GroundedUrlT HI.MarkupM)
) => Deploy WebComponent Locally (Path Abs File) (GroundedUrlT HI.MarkupM) where
deploy WebComponent Locally i = do
link <- absFileUrl i
lift (linkedWebComponentBlaze (printURI link))
instance ( MonadUrl (GroundedUrlT HI.MarkupM)
) => Deploy WebComponent Locally (Path Abs Dir) (GroundedUrlT HI.MarkupM) where
deploy WebComponent Locally i = do
link <- absDirUrl i
lift (linkedWebComponentBlaze (printURI link))
instance ( MonadUrl (GroundedUrlT HI.MarkupM)
) => Deploy WebComponent Locally Location (GroundedUrlT HI.MarkupM) where
deploy WebComponent Locally i = do
link <- locUrl i
lift (linkedWebComponentBlaze (printURI link))