markup 1.1.0 → 2.0.0
raw patch · 5 files changed
+530/−470 lines, 5 filesdep +path-extradep −hspecdep −transformersdep ~basedep ~urlpath
Dependencies added: path-extra
Dependencies removed: hspec, transformers
Dependency ranges changed: base, urlpath
Files
- markup.cabal +7/−35
- src/Data/Markup/Class.hs +5/−3
- src/Data/Markup/Library.hs +478/−357
- src/Data/Markup/Types.hs +40/−74
- test/Spec.hs +0/−1
markup.cabal view
@@ -1,5 +1,5 @@ Name: markup-Version: 1.1.0+Version: 2.0.0 Author: Athan Clark <athan.clark@gmail.com> Maintainer: Athan Clark <athan.clark@gmail.com> License: MIT@@ -19,24 +19,6 @@ slapped between markup tags), /hosted/ (entirely external - uses raw text as a url), and /local/ (which uses the <hackage.haskell.org/package/urlpath urlpath> library to realize what kind of link to create).- .- As an example, here is remotely hosted image:- .- > image = deploy Image "foo.png" :: HostedMarkupM (Html ())- >- > λ> renderMarkup image- >- > <img src="foo.png">- .- Here is the same example, going relative instead:- .- > image :: LocalMarkupM (HtmlT AbsoluteUrl ())- > image = deploy Image $ "foo.png" <?> ("some","getparam")- >- > λ> (runUrlReader $ renderTextT $ renderMarkup image $- > ) "example.com"- >- > "<img src=\"example.com/foo.png?some=getparam\">" Cabal-Version: >= 1.10 Build-Type: Simple@@ -49,25 +31,15 @@ Data.Markup.Types Data.Markup.Class Data.Markup.Library- Build-Depends: base >= 4 && < 5- , transformers- , mtl- , lucid >= 2.5+ Build-Depends: base >= 4.8 && < 5 , blaze-html , blaze-markup- , text- , urlpath >= 2 , comonad--Test-Suite spec- Type: exitcode-stdio-1.0- Default-Language: Haskell2010- Hs-Source-Dirs: src- , test- Ghc-Options: -Wall- Main-Is: Spec.hs- Build-Depends: base- , hspec+ , lucid >= 2.5+ , mtl+ , path-extra >= 0.0.1+ , text+ , urlpath >= 3.1.0 Source-Repository head Type: git
src/Data/Markup/Class.hs view
@@ -8,9 +8,9 @@ module Data.Markup.Class where -import Data.Markup.Types-import Control.Comonad+import Control.Comonad + -- | Overload assets and their markup library, over some deployment class Deploy symbol input markup (m :: * -> *) where deploy :: symbol -> input -> m markup@@ -20,6 +20,8 @@ renderMarkup :: m a -> a toMarkup :: a -> m a -instance (Monad m, Comonad m) => Markup m where+instance ( Monad m+ , Comonad m+ ) => Markup m where renderMarkup = extract toMarkup = return
src/Data/Markup/Library.hs view
@@ -1,9 +1,10 @@ {-# LANGUAGE- ExtendedDefaultRules- , FlexibleContexts+ FlexibleContexts , FlexibleInstances- , MultiParamTypeClasses , OverloadedStrings+ , UndecidableInstances+ , ExtendedDefaultRules+ , MultiParamTypeClasses #-} module Data.Markup.Library where@@ -13,6 +14,8 @@ import Data.Url +import Path.Extended+ import qualified Lucid as L import qualified Lucid.Base as LBase @@ -23,446 +26,564 @@ import qualified Data.Text as T import qualified Data.Text.Lazy as LT -import Control.Monad.Trans -data Image = Image deriving (Show, Eq)-data JavaScript = JavaScript deriving (Show, Eq)-data Css = Css deriving (Show, Eq)+data Image = Image deriving (Show, Eq)+data JavaScript = JavaScript deriving (Show, Eq)+data Css = Css deriving (Show, Eq) data WebComponent = WebComponent deriving (Show, Eq) --- Lucid instances --- Images only have local and hosted instances - inline can only be done with--- js... TODO?+-- Images -instance Monad m =>- Deploy Image T.Text (LBase.HtmlT m ()) HostedMarkupM where- deploy Image i = return $- L.img_ [L.src_ i]+instance ( Monad m+ ) => Deploy Image T.Text (LBase.HtmlT m ()) (HostedMarkupT m) where+ deploy Image i =+ return $ L.img_ [L.src_ i] instance ( Monad m- , Url T.Text m ) =>- Deploy Image T.Text (LBase.HtmlT m ()) LocalMarkupM where- deploy Image i = return $ do- link <- lift $ plainUrl i- L.img_ [L.src_ link]+ , MonadUrl b m+ ) => Deploy Image (Path b t) (LBase.HtmlT m ()) (HostedMarkupT m) where+ deploy Image i = do+ link <- pathUrl i+ return $ L.img_ [L.src_ (T.pack link)] -instance Url T.Text m =>- Deploy Image (QueryString T.Text) (LBase.HtmlT m ()) LocalMarkupM where- deploy Image i = return $ do- link <- lift $ queryUrl i- L.img_ [L.src_ link]+instance ( Monad m+ , MonadUrl b m+ ) => Deploy Image (Location b t) (LBase.HtmlT m ()) (HostedMarkupT m) where+ deploy Image i = do+ link <- locUrl i+ return $ L.img_ [L.src_ (T.pack link)] instance ( Monad m- , Monad m' ) =>- Deploy Image T.Text (LBase.HtmlT m ()) (HostedMarkupT m') where- deploy Image i = return $- L.img_ [L.src_ i]+ , MonadUrl b m+ , ToLocation s b t+ ) => Deploy Image s (LBase.HtmlT m ()) (HostedMarkupT m) where+ deploy Image i = do+ link <- symbolUrl i+ return $ L.img_ [L.src_ (T.pack link)] instance ( Monad m- , Monad m'- , Url T.Text m ) =>- Deploy Image T.Text (LBase.HtmlT m ()) (LocalMarkupT m') where- deploy Image i = return $ do- link <- lift $ plainUrl i- L.img_ [L.src_ link]+ ) => Deploy Image T.Text (LBase.HtmlT m ()) (LocalMarkupT m) where+ deploy Image i =+ return $ L.img_ [L.src_ i] -instance ( Url T.Text m- , Monad m' ) =>- Deploy Image (QueryString T.Text) (LBase.HtmlT m ()) (LocalMarkupT m') where- deploy Image i = return $ do- link <- lift $ queryUrl i- L.img_ [L.src_ link]+instance ( Monad m+ , MonadUrl b m+ ) => Deploy Image (Path b t) (LBase.HtmlT m ()) (LocalMarkupT m) where+ deploy Image i = do+ link <- pathUrl i+ return $ L.img_ [L.src_ (T.pack link)] --- JS instances+instance ( Monad m+ , MonadUrl b m+ ) => Deploy Image (Location b t) (LBase.HtmlT m ()) (LocalMarkupT m) where+ deploy Image i = do+ link <- locUrl i+ return $ L.img_ [L.src_ (T.pack link)] -instance Monad m =>- Deploy JavaScript T.Text (LBase.HtmlT m ()) InlineMarkupM where- deploy JavaScript i = return $- L.script_ [] i+instance ( Monad m+ , MonadUrl b m+ , ToLocation s b t+ ) => Deploy Image s (LBase.HtmlT m ()) (LocalMarkupT m) where+ deploy Image i = do+ link <- symbolUrl i+ return $ L.img_ [L.src_ (T.pack link)] -instance Monad m =>- Deploy JavaScript LT.Text (LBase.HtmlT m ()) InlineMarkupM where- deploy JavaScript i = return $- L.script_ [] i -instance Monad m =>- Deploy JavaScript T.Text (LBase.HtmlT m ()) HostedMarkupM where- deploy JavaScript i = return $- L.script_ [L.src_ i] ("" :: T.Text)+-- Blaze -instance Url T.Text m =>- Deploy JavaScript (QueryString T.Text) (LBase.HtmlT m ()) LocalMarkupM where- deploy JavaScript i = return $ do- link <- lift $ queryUrl i- L.script_ [L.src_ link] ("" :: T.Text)+instance ( Monad m+ ) => Deploy Image T.Text (HI.MarkupM ()) (HostedMarkupT m) where+ deploy Image link =+ return $ H.img H.! A.src (H.toValue link) -instance Url T.Text m =>- Deploy JavaScript T.Text (LBase.HtmlT m ()) LocalMarkupM where- deploy JavaScript i = return $ do- link <- lift $ plainUrl i- L.script_ [L.src_ link] ("" :: T.Text)+instance ( Monad m+ , MonadUrl b m+ ) => Deploy Image (Path b t) (HI.MarkupM ()) (HostedMarkupT m) where+ deploy Image i = do+ link <- pathUrl i+ return $ H.img H.! A.src (H.toValue link) instance ( Monad m- , Monad m' ) =>- Deploy JavaScript T.Text (LBase.HtmlT m ()) (InlineMarkupT m') where- deploy JavaScript i = return $- L.script_ [] i+ , MonadUrl b m+ ) => Deploy Image (Location b t) (HI.MarkupM ()) (HostedMarkupT m) where+ deploy Image i = do+ link <- locUrl i+ return $ H.img H.! A.src (H.toValue link) instance ( Monad m- , Monad m' ) =>- Deploy JavaScript LT.Text (LBase.HtmlT m ()) (InlineMarkupT m') where- deploy JavaScript i = return $- L.script_ [] i+ , MonadUrl b m+ , ToLocation s b t+ ) => Deploy Image s (HI.MarkupM ()) (HostedMarkupT m) where+ deploy Image i = do+ link <- symbolUrl i+ return $ H.img H.! A.src (H.toValue link) instance ( Monad m- , Monad m' ) =>- Deploy JavaScript T.Text (LBase.HtmlT m ()) (HostedMarkupT m') where- deploy JavaScript i = return $- L.script_ [L.src_ i] ("" :: T.Text)+ ) => Deploy Image T.Text (HI.MarkupM ()) (LocalMarkupT m) where+ deploy Image link =+ return $ H.img H.! A.src (H.toValue link) -instance ( Url T.Text m- , Monad m' ) =>- Deploy JavaScript T.Text (LBase.HtmlT m ()) (LocalMarkupT m') where- deploy JavaScript i = return $ do- link <- lift $ plainUrl i- L.script_ [L.src_ link] ("" :: T.Text)+instance ( Monad m+ , MonadUrl b m+ ) => Deploy Image (Path b t) (HI.MarkupM ()) (LocalMarkupT m) where+ deploy Image i = do+ link <- pathUrl i+ return $ H.img H.! A.src (H.toValue link) -instance ( Url T.Text m- , Monad m' ) =>- Deploy JavaScript (QueryString T.Text) (LBase.HtmlT m ()) (LocalMarkupT m') where- deploy JavaScript i = return $ do- link <- lift $ queryUrl i- L.script_ [L.src_ link] ("" :: T.Text)+instance ( Monad m+ , MonadUrl b m+ ) => Deploy Image (Location b t) (HI.MarkupM ()) (LocalMarkupT m) where+ deploy Image i = do+ link <- locUrl i+ return $ H.img H.! A.src (H.toValue link) --- Css instances+instance ( Monad m+ , MonadUrl b m+ , ToLocation s b t+ ) => Deploy Image s (HI.MarkupM ()) (LocalMarkupT m) where+ deploy Image i = do+ link <- symbolUrl i+ return $ H.img H.! A.src (H.toValue link) -instance Monad m =>- Deploy Css T.Text (LBase.HtmlT m ()) InlineMarkupM where- deploy Css i = return $- L.style_ [] i -instance Monad m =>- Deploy Css LT.Text (LBase.HtmlT m ()) InlineMarkupM where- deploy Css i = return $- L.style_ [] i+-- JavaScript -instance Monad m =>- Deploy Css T.Text (LBase.HtmlT m ()) HostedMarkupM where- deploy Css i = return $- L.link_ [ L.rel_ "stylesheet"- , L.type_ "text/css"- , L.href_ i- ]+instance ( Monad m+ ) => Deploy JavaScript T.Text (LBase.HtmlT m ()) (InlineMarkupT m) where+ deploy JavaScript i =+ return $ L.script_ [] i -instance Url T.Text m =>- Deploy Css T.Text (LBase.HtmlT m ()) LocalMarkupM where- deploy Css i = return $ do- link <- lift $ plainUrl i- L.link_ [ L.rel_ "stylesheet"- , L.type_ "text/css"- , L.href_ link- ]+instance ( Monad m+ ) => Deploy JavaScript LT.Text (LBase.HtmlT m ()) (InlineMarkupT m) where+ deploy JavaScript i =+ return $ L.script_ [] i -instance Url T.Text m =>- Deploy Css (QueryString T.Text) (LBase.HtmlT m ()) LocalMarkupM where- deploy Css i = return $ do- link <- lift $ queryUrl i- L.link_ [ L.rel_ "stylesheet"- , L.type_ "text/css"- , L.href_ link- ]+instance ( Monad m+ ) => Deploy JavaScript T.Text (LBase.HtmlT m ()) (HostedMarkupT m) where+ deploy JavaScript link =+ return $ L.script_ [L.src_ link] ("" :: T.Text) instance ( Monad m- , Monad m' ) =>- Deploy Css T.Text (LBase.HtmlT m ()) (InlineMarkupT m') where- deploy Css i = return $- L.style_ [] i+ , MonadUrl b m+ ) => Deploy JavaScript (Path b t) (LBase.HtmlT m ()) (HostedMarkupT m) where+ deploy JavaScript i = do+ link <- pathUrl i+ return $ L.script_ [L.src_ (T.pack link)] ("" :: T.Text) instance ( Monad m- , Monad m' ) =>- Deploy Css LT.Text (LBase.HtmlT m ()) (InlineMarkupT m') where- deploy Css i = return $- L.style_ [] i+ , MonadUrl b m+ ) => Deploy JavaScript (Location b t) (LBase.HtmlT m ()) (HostedMarkupT m) where+ deploy JavaScript i = do+ link <- locUrl i+ return $ L.script_ [L.src_ (T.pack link)] ("" :: T.Text) instance ( Monad m- , Monad m' ) =>- Deploy Css T.Text (LBase.HtmlT m ()) (HostedMarkupT m') where- deploy Css i = return $- L.link_ [ L.rel_ "stylesheet"- , L.type_ "text/css"- , L.href_ i- ]+ , MonadUrl b m+ , ToLocation s b t+ ) => Deploy JavaScript s (LBase.HtmlT m ()) (HostedMarkupT m) where+ deploy JavaScript i = do+ link <- symbolUrl i+ return $ L.script_ [L.src_ (T.pack link)] ("" :: T.Text) -instance ( Url T.Text m- , Monad m' ) =>- Deploy Css T.Text (LBase.HtmlT m ()) (LocalMarkupT m') where- deploy Css i = return $ do- link <- lift $ plainUrl i- L.link_ [ L.rel_ "stylesheet"- , L.type_ "text/css"- , L.href_ link- ]+instance ( Monad m+ ) => Deploy JavaScript T.Text (LBase.HtmlT m ()) (LocalMarkupT m) where+ deploy JavaScript link =+ return $ L.script_ [L.src_ link] ("" :: T.Text) -instance ( Url T.Text m- , Monad m' ) =>- Deploy Css (QueryString T.Text) (LBase.HtmlT m ()) (LocalMarkupT m') where- deploy Css i = return $ do- link <- lift $ queryUrl i- L.link_ [ L.rel_ "stylesheet"- , L.type_ "text/css"- , L.href_ link- ]+instance ( Monad m+ , MonadUrl b m+ ) => Deploy JavaScript (Path b t) (LBase.HtmlT m ()) (LocalMarkupT m) where+ deploy JavaScript i = do+ link <- pathUrl i+ return $ L.script_ [L.src_ (T.pack link)] ("" :: T.Text) --- WebComponent instances+instance ( Monad m+ , MonadUrl b m+ ) => Deploy JavaScript (Location b t) (LBase.HtmlT m ()) (LocalMarkupT m) where+ deploy JavaScript i = do+ link <- locUrl i+ return $ L.script_ [L.src_ (T.pack link)] ("" :: T.Text) -instance Monad m =>- Deploy WebComponent T.Text (LBase.HtmlT m ()) HostedMarkupM where- deploy WebComponent i = return $- L.link_ [ L.rel_ "import"- , L.href_ i- ]+instance ( Monad m+ , MonadUrl b m+ , ToLocation s b t+ ) => Deploy JavaScript s (LBase.HtmlT m ()) (LocalMarkupT m) where+ deploy JavaScript i = do+ link <- symbolUrl i+ return $ L.script_ [L.src_ (T.pack link)] ("" :: T.Text) +-- Blaze+ instance ( Monad m- , Url T.Text m ) =>- Deploy WebComponent T.Text (LBase.HtmlT m ()) LocalMarkupM where- deploy WebComponent i = return $ do- link <- lift $ plainUrl i- L.link_ [ L.rel_ "import"- , L.href_ link- ]+ ) => Deploy JavaScript T.Text (HI.MarkupM ()) (InlineMarkupT m) where+ deploy JavaScript i =+ return $ H.script (H.toMarkup i) instance ( Monad m- , Url T.Text m ) =>- Deploy WebComponent (QueryString T.Text) (LBase.HtmlT m ()) LocalMarkupM where- deploy WebComponent i = return $ do- link <- lift $ queryUrl i- L.link_ [ L.rel_ "import"- , L.href_ link- ]+ ) => Deploy JavaScript LT.Text (HI.MarkupM ()) (InlineMarkupT m) where+ deploy JavaScript i =+ return $ H.script (H.toMarkup i) instance ( Monad m- , Monad m' ) =>- Deploy WebComponent T.Text (LBase.HtmlT m ()) (HostedMarkupT m') where- deploy WebComponent i = return $- L.link_ [ L.rel_ "import"- , L.href_ i- ]+ ) => Deploy JavaScript T.Text (HI.MarkupM ()) (HostedMarkupT m) where+ deploy JavaScript i =+ return $ (H.script H.! A.src (H.toValue i)) HI.Empty instance ( Monad m- , Monad m'- , Url T.Text m ) =>- Deploy WebComponent T.Text (LBase.HtmlT m ()) (LocalMarkupT m') where- deploy WebComponent i = return $ do- link <- lift $ plainUrl i- L.link_ [ L.rel_ "import"- , L.href_ link- ]+ , MonadUrl b m+ ) => Deploy JavaScript (Path b t) (HI.MarkupM ()) (HostedMarkupT m) where+ deploy JavaScript i = do+ link <- pathUrl i+ return $ (H.script H.! A.src (H.toValue link)) HI.Empty instance ( Monad m- , Monad m'- , Url T.Text m ) =>- Deploy WebComponent (QueryString T.Text) (LBase.HtmlT m ()) (LocalMarkupT m') where- deploy WebComponent i = return $ do- link <- lift $ queryUrl i- L.link_ [ L.rel_ "import"- , L.href_ link- ]+ , MonadUrl b m+ ) => Deploy JavaScript (Location b t) (HI.MarkupM ()) (HostedMarkupT m) where+ deploy JavaScript i = do+ link <- locUrl i+ return $ (H.script H.! A.src (H.toValue link)) HI.Empty --- Blaze-html instances+instance ( Monad m+ , MonadUrl b m+ , ToLocation s b t+ ) => Deploy JavaScript s (HI.MarkupM ()) (HostedMarkupT m) where+ deploy JavaScript i = do+ link <- symbolUrl i+ return $ (H.script H.! A.src (H.toValue link)) HI.Empty +instance ( Monad m+ ) => Deploy JavaScript T.Text (HI.MarkupM ()) (LocalMarkupT m) where+ deploy JavaScript i =+ return $ (H.script H.! A.src (H.toValue i)) HI.Empty -instance H.ToValue input =>- Deploy Image input (HI.MarkupM ()) HostedMarkupM where- deploy Image i = return $- H.img H.! A.src (H.toValue i)+instance ( Monad m+ , MonadUrl b m+ ) => Deploy JavaScript (Path b t) (HI.MarkupM ()) (LocalMarkupT m) where+ deploy JavaScript i = do+ link <- pathUrl i+ return $ (H.script H.! A.src (H.toValue link)) HI.Empty -instance Url T.Text HI.MarkupM =>- Deploy Image T.Text (HI.MarkupM ()) LocalMarkupM where- deploy Image i = return $ do- link <- plainUrl i- H.img H.! A.src (H.toValue link)+instance ( Monad m+ , MonadUrl b m+ ) => Deploy JavaScript (Location b t) (HI.MarkupM ()) (LocalMarkupT m) where+ deploy JavaScript i = do+ link <- locUrl i+ return $ (H.script H.! A.src (H.toValue link)) HI.Empty -instance Url T.Text HI.MarkupM =>- Deploy Image (QueryString T.Text) (HI.MarkupM ()) LocalMarkupM where- deploy Image i = return $ do- link <- queryUrl i- H.img H.! A.src (H.toValue link)+instance ( Monad m+ , MonadUrl b m+ , ToLocation s b t+ ) => Deploy JavaScript s (HI.MarkupM ()) (LocalMarkupT m) where+ deploy JavaScript i = do+ link <- symbolUrl i+ return $ (H.script H.! A.src (H.toValue link)) HI.Empty -instance ( H.ToValue input- , Monad m ) =>- Deploy Image input (HI.MarkupM ()) (HostedMarkupT m) where- deploy Image i = return $- H.img H.! A.src (H.toValue i) -instance ( Url T.Text HI.MarkupM- , Monad m ) =>- Deploy Image T.Text (HI.MarkupM ()) (LocalMarkupT m) where- deploy Image i = return $ do- link <- plainUrl i- H.img H.! A.src (H.toValue link)--instance ( Url T.Text HI.MarkupM- , Monad m ) =>- Deploy Image (QueryString T.Text) (HI.MarkupM ()) (LocalMarkupT m) where- deploy Image i = return $ do- link <- queryUrl i- H.img H.! A.src (H.toValue link)-+-- Css instances +instance ( Monad m+ ) => Deploy Css T.Text (LBase.HtmlT m ()) (InlineMarkupT m) where+ deploy Css link =+ return $ L.style_ [] link -instance H.ToMarkup input =>- Deploy JavaScript input (HI.MarkupM ()) InlineMarkupM where- deploy JavaScript i = return $- H.script (H.toMarkup i)+instance ( Monad m+ ) => Deploy Css LT.Text (LBase.HtmlT m ()) (InlineMarkupT m) where+ deploy Css link =+ return $ L.style_ [] link -instance H.ToValue input =>- Deploy JavaScript input (HI.MarkupM ()) HostedMarkupM where- deploy JavaScript i = return $- (H.script H.! A.src (H.toValue i)) HI.Empty+instance ( Monad m+ ) => Deploy Css T.Text (LBase.HtmlT m ()) (HostedMarkupT m) where+ deploy Css link =+ return $ L.link_ [ L.rel_ "stylesheet"+ , L.type_ "text/css"+ , L.href_ link+ ] -instance Url T.Text HI.MarkupM =>- Deploy JavaScript T.Text (HI.MarkupM ()) LocalMarkupM where- deploy JavaScript i = return $ do- link <- plainUrl i- (H.script H.! A.src (H.toValue link)) HI.Empty+instance ( Monad m+ , MonadUrl b m+ ) => Deploy Css (Path b t) (LBase.HtmlT m ()) (HostedMarkupT m) where+ deploy Css i = do+ link <- pathUrl i+ return $ L.link_ [ L.rel_ "stylesheet"+ , L.type_ "text/css"+ , L.href_ (T.pack link)+ ] -instance Url T.Text HI.MarkupM =>- Deploy JavaScript (QueryString T.Text) (HI.MarkupM ()) LocalMarkupM where- deploy JavaScript i = return $ do- link <- queryUrl i- (H.script H.! A.src (H.toValue link)) HI.Empty+instance ( Monad m+ , MonadUrl b m+ ) => Deploy Css (Location b t) (LBase.HtmlT m ()) (HostedMarkupT m) where+ deploy Css i = do+ link <- locUrl i+ return $ L.link_ [ L.rel_ "stylesheet"+ , L.type_ "text/css"+ , L.href_ (T.pack link)+ ] -instance ( H.ToMarkup input- , Monad m ) =>- Deploy JavaScript input (HI.MarkupM ()) (InlineMarkupT m) where- deploy JavaScript i = return $- H.script (H.toMarkup i)+instance ( Monad m+ , MonadUrl b m+ , ToLocation s b t+ ) => Deploy Css s (LBase.HtmlT m ()) (HostedMarkupT m) where+ deploy Css i = do+ link <- symbolUrl i+ return $ L.link_ [ L.rel_ "stylesheet"+ , L.type_ "text/css"+ , L.href_ (T.pack link)+ ] -instance ( H.ToValue input- , Monad m ) =>- Deploy JavaScript input (HI.MarkupM ()) (HostedMarkupT m) where- deploy JavaScript i = return $- (H.script H.! A.src (H.toValue i)) HI.Empty+instance ( Monad m+ ) => Deploy Css T.Text (LBase.HtmlT m ()) (LocalMarkupT m) where+ deploy Css link =+ return $ L.link_ [ L.rel_ "stylesheet"+ , L.type_ "text/css"+ , L.href_ link+ ] -instance ( Url T.Text HI.MarkupM- , Monad m ) =>- Deploy JavaScript T.Text (HI.MarkupM ()) (LocalMarkupT m) where- deploy JavaScript i = return $ do- link <- plainUrl i- (H.script H.! A.src (H.toValue link)) HI.Empty+instance ( Monad m+ , MonadUrl b m+ ) => Deploy Css (Path b t) (LBase.HtmlT m ()) (LocalMarkupT m) where+ deploy Css i = do+ link <- pathUrl i+ return $ L.link_ [ L.rel_ "stylesheet"+ , L.type_ "text/css"+ , L.href_ (T.pack link)+ ] -instance ( Url T.Text HI.MarkupM- , Monad m ) =>- Deploy JavaScript (QueryString T.Text) (HI.MarkupM ()) (LocalMarkupT m) where- deploy JavaScript i = return $ do- link <- queryUrl i- (H.script H.! A.src (H.toValue link)) HI.Empty+instance ( Monad m+ , MonadUrl b m+ ) => Deploy Css (Location b t) (LBase.HtmlT m ()) (LocalMarkupT m) where+ deploy Css i = do+ link <- locUrl i+ return $ L.link_ [ L.rel_ "stylesheet"+ , L.type_ "text/css"+ , L.href_ (T.pack link)+ ] +instance ( Monad m+ , MonadUrl b m+ , ToLocation s b t+ ) => Deploy Css s (LBase.HtmlT m ()) (LocalMarkupT m) where+ deploy Css i = do+ link <- symbolUrl i+ return $ L.link_ [ L.rel_ "stylesheet"+ , L.type_ "text/css"+ , L.href_ (T.pack link)+ ] +instance ( Monad m+ ) => Deploy Css T.Text (HI.MarkupM ()) (InlineMarkupT m) where+ deploy Css i =+ return $ H.style (H.toMarkup i) -instance H.ToMarkup input =>- Deploy Css input (HI.MarkupM ()) InlineMarkupM where- deploy Css i = return $- H.style (H.toMarkup i)+instance ( Monad m+ ) => Deploy Css LT.Text (HI.MarkupM ()) (InlineMarkupT m) where+ deploy Css i =+ return $ H.style (H.toMarkup i) -instance H.ToValue input =>- Deploy Css input (HI.MarkupM ()) HostedMarkupM where+instance ( Monad m+ ) => Deploy Css T.Text (HI.MarkupM ()) (HostedMarkupT m) where deploy Css i = return $ H.link H.! A.rel "stylesheet"- H.! A.type_ "text/css"- H.! A.href (H.toValue i)+ H.! A.type_ "text/css"+ H.! A.href (H.toValue i) -instance Url T.Text HI.MarkupM =>- Deploy Css T.Text (HI.MarkupM ()) LocalMarkupM where- deploy Css i = return $ do- link <- plainUrl i- H.link H.! A.rel "stylesheet"- H.! A.type_ "text/css"- H.! A.href (H.toValue link)+instance ( Monad m+ , MonadUrl b m+ ) => Deploy Css (Path b t) (HI.MarkupM ()) (HostedMarkupT m) where+ deploy Css i = do+ link <- pathUrl i+ return $ H.link H.! A.rel "stylesheet"+ H.! A.type_ "text/css"+ H.! A.href (H.toValue link) -instance Url T.Text HI.MarkupM =>- Deploy Css (QueryString T.Text) (HI.MarkupM ()) LocalMarkupM where- deploy Css i = return $ do- link <- queryUrl i- H.link H.! A.rel "stylesheet"- H.! A.type_ "text/css"- H.! A.href (H.toValue link)+instance ( Monad m+ , MonadUrl b m+ ) => Deploy Css (Location b t) (HI.MarkupM ()) (HostedMarkupT m) where+ deploy Css i = do+ link <- locUrl i+ return $ H.link H.! A.rel "stylesheet"+ H.! A.type_ "text/css"+ H.! A.href (H.toValue link) -instance ( H.ToMarkup input- , Monad m ) =>- Deploy Css input (HI.MarkupM ()) (InlineMarkupT m) where- deploy Css i = return $- H.style (H.toMarkup i)+instance ( Monad m+ , MonadUrl b m+ , ToLocation s b t+ ) => Deploy Css s (HI.MarkupM ()) (HostedMarkupT m) where+ deploy Css i = do+ link <- symbolUrl i+ return $ H.link H.! A.rel "stylesheet"+ H.! A.type_ "text/css"+ H.! A.href (H.toValue link) -instance ( H.ToValue input- , Monad m ) =>- Deploy Css input (HI.MarkupM ()) (HostedMarkupT m) where+instance ( Monad m+ ) => Deploy Css T.Text (HI.MarkupM ()) (LocalMarkupT m) where deploy Css i = return $ H.link H.! A.rel "stylesheet"- H.! A.type_ "text/css"- H.! A.href (H.toValue i)+ H.! A.type_ "text/css"+ H.! A.href (H.toValue i) -instance ( Url T.Text HI.MarkupM- , Monad m ) =>- Deploy Css T.Text (HI.MarkupM ()) (LocalMarkupT m) where- deploy Css i = return $ do- link <- plainUrl i- H.link H.! A.rel "stylesheet"- H.! A.type_ "text/css"- H.! A.href (H.toValue link)+instance ( Monad m+ , MonadUrl b m+ ) => Deploy Css (Path b t) (HI.MarkupM ()) (LocalMarkupT m) where+ deploy Css i = do+ link <- pathUrl i+ return $ H.link H.! A.rel "stylesheet"+ H.! A.type_ "text/css"+ H.! A.href (H.toValue link) -instance ( Url T.Text HI.MarkupM- , Monad m ) =>- Deploy Css (QueryString T.Text) (HI.MarkupM ()) (LocalMarkupT m) where- deploy Css i = return $ do- link <- queryUrl i- H.link H.! A.rel "stylesheet"- H.! A.type_ "text/css"- H.! A.href (H.toValue link)+instance ( Monad m+ , MonadUrl b m+ ) => Deploy Css (Location b t) (HI.MarkupM ()) (LocalMarkupT m) where+ deploy Css i = do+ link <- locUrl i+ return $ H.link H.! A.rel "stylesheet"+ H.! A.type_ "text/css"+ H.! A.href (H.toValue link) -instance H.ToValue input =>- Deploy WebComponent input (HI.MarkupM ()) HostedMarkupM where- deploy WebComponent i = return $- H.link H.! A.rel "import"- H.! A.href (H.toValue i)+instance ( Monad m+ , MonadUrl b m+ , ToLocation s b t+ ) => Deploy Css s (HI.MarkupM ()) (LocalMarkupT m) where+ deploy Css i = do+ link <- symbolUrl i+ return $ H.link H.! A.rel "stylesheet"+ H.! A.type_ "text/css"+ H.! A.href (H.toValue link) -instance Url T.Text HI.MarkupM =>- Deploy WebComponent T.Text (HI.MarkupM ()) LocalMarkupM where- deploy WebComponent i = return $ do- link <- plainUrl i- H.link H.! A.rel "import"- H.! A.href (H.toValue link) -instance Url T.Text HI.MarkupM =>- Deploy WebComponent (QueryString T.Text) (HI.MarkupM ()) LocalMarkupM where- deploy WebComponent i = return $ do- link <- queryUrl i- H.link H.! A.rel "import"- H.! A.href (H.toValue link)+-- WebComponent instances -instance ( H.ToValue input- , Monad m'- ) =>- Deploy WebComponent input (HI.MarkupM ()) (HostedMarkupT m') where- deploy WebComponent i = return $- H.link H.! A.rel "import"- H.! A.href (H.toValue i)+instance ( Monad m+ ) => Deploy WebComponent T.Text (LBase.HtmlT m ()) (HostedMarkupT m) where+ deploy WebComponent link =+ return $ L.link_ [ L.rel_ "import"+ , L.href_ link+ ] -instance ( Monad m'- , Url T.Text HI.MarkupM- ) =>- Deploy WebComponent T.Text (HI.MarkupM ()) (LocalMarkupT m') where- deploy WebComponent i = return $ do- link <- plainUrl i- H.link H.! A.rel "import"- H.! A.href (H.toValue link)+instance ( Monad m+ , MonadUrl b m+ ) => Deploy WebComponent (Path b t) (LBase.HtmlT m ()) (HostedMarkupT m) where+ deploy WebComponent i = do+ link <- pathUrl i+ return $ L.link_ [ L.rel_ "import"+ , L.href_ (T.pack link)+ ] -instance ( Monad m'- , Url T.Text HI.MarkupM- ) =>- Deploy WebComponent (QueryString T.Text) (HI.MarkupM ()) (LocalMarkupT m') where- deploy WebComponent i = return $ do- link <- queryUrl i- H.link H.! A.rel "import"- H.! A.href (H.toValue link)+instance ( Monad m+ , MonadUrl b m+ ) => Deploy WebComponent (Location b t) (LBase.HtmlT m ()) (HostedMarkupT m) where+ deploy WebComponent i = do+ link <- locUrl i+ return $ L.link_ [ L.rel_ "import"+ , L.href_ (T.pack link)+ ]++instance ( Monad m+ , MonadUrl b m+ , ToLocation s b t+ ) => Deploy WebComponent s (LBase.HtmlT m ()) (HostedMarkupT m) where+ deploy WebComponent i = do+ link <- symbolUrl i+ return $ L.link_ [ L.rel_ "import"+ , L.href_ (T.pack link)+ ]++instance ( Monad m+ ) => Deploy WebComponent T.Text (LBase.HtmlT m ()) (LocalMarkupT m) where+ deploy WebComponent link =+ return $ L.link_ [ L.rel_ "import"+ , L.href_ link+ ]++instance ( Monad m+ , MonadUrl b m+ ) => Deploy WebComponent (Path b t) (LBase.HtmlT m ()) (LocalMarkupT m) where+ deploy WebComponent i = do+ link <- pathUrl i+ return $ do L.link_ [ L.rel_ "import"+ , L.href_ (T.pack link)+ ]++instance ( Monad m+ , MonadUrl b m+ ) => Deploy WebComponent (Location b t) (LBase.HtmlT m ()) (LocalMarkupT m) where+ deploy WebComponent i = do+ link <- locUrl i+ return $ do L.link_ [ L.rel_ "import"+ , L.href_ (T.pack link)+ ]++instance ( Monad m+ , MonadUrl b m+ , ToLocation s b t+ ) => Deploy WebComponent s (LBase.HtmlT m ()) (LocalMarkupT m) where+ deploy WebComponent i = do+ link <- symbolUrl i+ return $ do L.link_ [ L.rel_ "import"+ , L.href_ (T.pack link)+ ]+++-- Blaze++instance ( Monad m+ ) => Deploy WebComponent T.Text (HI.MarkupM ()) (HostedMarkupT m) where+ deploy WebComponent i =+ return $ H.link H.! A.rel "import"+ H.! A.href (H.toValue i)++instance ( Monad m+ , MonadUrl b m+ ) => Deploy WebComponent (Path b t) (HI.MarkupM ()) (HostedMarkupT m) where+ deploy WebComponent i = do+ link <- pathUrl i+ return $ H.link H.! A.rel "import"+ H.! A.href (H.toValue link)++instance ( Monad m+ , MonadUrl b m+ ) => Deploy WebComponent (Location b t) (HI.MarkupM ()) (HostedMarkupT m) where+ deploy WebComponent i = do+ link <- locUrl i+ return $ H.link H.! A.rel "import"+ H.! A.href (H.toValue link)++instance ( Monad m+ , MonadUrl b m+ , ToLocation s b t+ ) => Deploy WebComponent s (HI.MarkupM ()) (HostedMarkupT m) where+ deploy WebComponent i = do+ link <- symbolUrl i+ return $ H.link H.! A.rel "import"+ H.! A.href (H.toValue link)++instance ( Monad m+ ) => Deploy WebComponent T.Text (HI.MarkupM ()) (LocalMarkupT m) where+ deploy WebComponent i =+ return $ H.link H.! A.rel "import"+ H.! A.href (H.toValue i)++instance ( Monad m+ , MonadUrl b m+ ) => Deploy WebComponent (Path b t) (HI.MarkupM ()) (LocalMarkupT m) where+ deploy WebComponent i = do+ link <- pathUrl i+ return $ H.link H.! A.rel "import"+ H.! A.href (H.toValue link)++instance ( Monad m+ , MonadUrl b m+ ) => Deploy WebComponent (Location b t) (HI.MarkupM ()) (LocalMarkupT m) where+ deploy WebComponent i = do+ link <- locUrl i+ return $ H.link H.! A.rel "import"+ H.! A.href (H.toValue link)++instance ( Monad m+ , MonadUrl b m+ , ToLocation s b t+ ) => Deploy WebComponent s (HI.MarkupM ()) (LocalMarkupT m) where+ deploy WebComponent i = do+ link <- symbolUrl i+ return $ H.link H.! A.rel "import"+ H.! A.href (H.toValue link)
src/Data/Markup/Types.hs view
@@ -9,107 +9,73 @@ module Data.Markup.Types where -import Control.Applicative-import Control.Monad.Trans-import Control.Comonad-import Data.Monoid+import Data.Functor.Identity+import Control.Monad.Trans+import Control.Comonad +-- * Inline Deployment -newtype InlineMarkupT m a = InlineMarkupT { runInlineMarkupT :: m a }- deriving (Functor)+newtype InlineMarkupT m a = InlineMarkupT+ { runInlineMarkupT :: m a+ } deriving (Functor) -deriving instance Monoid (m a) => Monoid (InlineMarkupT m a)+type InlineMarkup = InlineMarkupT Identity++deriving instance Monoid (m a) => Monoid (InlineMarkupT m a) deriving instance Applicative f => Applicative (InlineMarkupT f)-deriving instance Monad m => Monad (InlineMarkupT m)+deriving instance Monad m => Monad (InlineMarkupT m) -instance (Comonad m, Monad m) => Comonad (InlineMarkupT m) where+instance ( Comonad m+ , Monad m+ ) => Comonad (InlineMarkupT m) where extract = extract . runInlineMarkupT duplicate = InlineMarkupT . return instance MonadTrans InlineMarkupT where lift = InlineMarkupT -newtype HostedMarkupT m a = HostedMarkupT { runHostedMarkupT :: m a }- deriving (Functor) -deriving instance Monoid (m a) => Monoid (HostedMarkupT m a)+-- * Hosted Deployment++newtype HostedMarkupT m a = HostedMarkupT+ { runHostedMarkupT :: m a+ } deriving (Functor)++type HostedMarkup = HostedMarkupT Identity++deriving instance Monoid (m a) => Monoid (HostedMarkupT m a) deriving instance Applicative f => Applicative (HostedMarkupT f)-deriving instance Monad m => Monad (HostedMarkupT m)+deriving instance Monad m => Monad (HostedMarkupT m) -instance (Comonad m, Monad m) => Comonad (HostedMarkupT m) where+instance ( Comonad m+ , Monad m+ ) => Comonad (HostedMarkupT m) where extract = extract . runHostedMarkupT duplicate = HostedMarkupT . return instance MonadTrans HostedMarkupT where lift = HostedMarkupT -newtype LocalMarkupT m a = LocalMarkupT { runLocalMarkupT :: m a }- deriving (Functor) -deriving instance Monoid (m a) => Monoid (LocalMarkupT m a)+-- * Local Deployment++newtype LocalMarkupT m a = LocalMarkupT+ { runLocalMarkupT :: m a+ } deriving (Functor)++type LocalMarkup = LocalMarkupT Identity++deriving instance Monoid (m a) => Monoid (LocalMarkupT m a) deriving instance Applicative f => Applicative (LocalMarkupT f)-deriving instance Monad m => Monad (LocalMarkupT m)+deriving instance Monad m => Monad (LocalMarkupT m) -instance (Comonad m, Monad m) => Comonad (LocalMarkupT m) where+instance ( Comonad m+ , Monad m+ ) => Comonad (LocalMarkupT m) where extract = extract . runLocalMarkupT duplicate = LocalMarkupT . return instance MonadTrans LocalMarkupT where lift = LocalMarkupT ---newtype InlineMarkupM a = InlineMarkupM {runInlineMarkupM :: a}- deriving (Functor)--deriving instance Monoid a => Monoid (InlineMarkupM a)--instance Applicative InlineMarkupM where- (<*>) f x = InlineMarkupM $- runInlineMarkupM f (runInlineMarkupM x)- pure = InlineMarkupM--instance Monad InlineMarkupM where- return = InlineMarkupM- x >>= f = f $ runInlineMarkupM x--instance Comonad InlineMarkupM where- extract = runInlineMarkupM- duplicate = InlineMarkupM--newtype HostedMarkupM a = HostedMarkupM {runHostedMarkupM :: a}- deriving (Functor)--deriving instance Monoid a => Monoid (HostedMarkupM a)--instance Applicative HostedMarkupM where- (<*>) f x = HostedMarkupM $- runHostedMarkupM f (runHostedMarkupM x)- pure = HostedMarkupM--instance Monad HostedMarkupM where- return = HostedMarkupM- x >>= f = f $ runHostedMarkupM x--instance Comonad HostedMarkupM where- extract = runHostedMarkupM- duplicate = HostedMarkupM--newtype LocalMarkupM a = LocalMarkupM {runLocalMarkupM :: a}- deriving (Functor)--deriving instance Monoid a => Monoid (LocalMarkupM a)--instance Applicative LocalMarkupM where- (<*>) f x = LocalMarkupM $- runLocalMarkupM f (runLocalMarkupM x)- pure = LocalMarkupM--instance Monad LocalMarkupM where- return = LocalMarkupM- x >>= f = f $ runLocalMarkupM x--instance Comonad LocalMarkupM where- extract = runLocalMarkupM- duplicate = LocalMarkupM
− test/Spec.hs
@@ -1,1 +0,0 @@-{-# OPTIONS_GHC -F -pgmF hspec-discover #-}