markup 0.0.1 → 0.0.2
raw patch · 5 files changed
+207/−148 lines, 5 filesdep ~urlpath
Dependency ranges changed: urlpath
Files
- markup.cabal +9/−13
- src/Data/Markup.hs +0/−4
- src/Data/Markup/Class.hs +16/−30
- src/Data/Markup/Library.hs +125/−38
- src/Data/Markup/Types.hs +57/−63
markup.cabal view
@@ -1,5 +1,5 @@ Name: markup-Version: 0.0.1+Version: 0.0.2 Author: Athan Clark <athan.clark@gmail.com> Maintainer: Athan Clark <athan.clark@gmail.com> License: MIT@@ -21,25 +21,21 @@ . As an example, here is remotely hosted image: .- > image' = renderMarkup Image :: Monad m => HostedMarkupT m T.Text (Html ())- > - > image = runHostedMarkupT image' "foo.png"- > - > λ> renderText image+ > image = deploy Image "foo.png" :: HostedMarkupM (Html ())+ >+ > λ> renderMarkup image > > <img src="foo.png"> . Here is the same example, going relative instead: .- > image' = renderMarkup Image :: (Monad m, Url UrlString AbsoluteUrl) => LocalMarkupT UrlString m (HtmlT AbsoluteUrl ())+ > image :: LocalMarkupM (HtmlT AbsoluteUrl ())+ > image = deploy Image $ "foo.png" <?> ("some","getparam") >- > λ> (runUrlReader $ renderTextT $ runIdentity $ runLocalMarkupT image' $- > "foo.png" <?> ("key","bar")+ > λ> (runUrlReader $ renderTextT $ renderMarkup image $ > ) "example.com" >- > "<img src=\"example.com/foo.png?key=bar\">"- .- Right now this library isn't so great, hopefully it will get better soon :)+ > "<img src=\"example.com/foo.png?some=getparam\">" Cabal-Version: >= 1.10 Build-Type: Simple@@ -59,7 +55,7 @@ , blaze-html , blaze-markup , text- , urlpath+ , urlpath >= 0.0.5 Test-Suite spec Type: exitcode-stdio-1.0
src/Data/Markup.hs view
@@ -1,7 +1,3 @@-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE KindSignatures #-}-{-# LANGUAGE FlexibleInstances #-}- module Data.Markup ( module Data.Markup.Types , module Data.Markup.Class
src/Data/Markup/Class.hs view
@@ -1,6 +1,9 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE AllowAmbiguousTypes #-} module Data.Markup.Class where @@ -10,40 +13,23 @@ import Data.Monoid import qualified Data.Text as T +import Data.Functor.Identity+ -- | Overload assets and their markup library, over some deployment-class Markup markup t (m :: * -> *) where- renderMarkup :: t -> m markup+class Deploy symbol input markup (m :: * -> *) where+ deploy :: symbol -> input -> m markup --- | Assets that implement this (with their representing markup library) can be --- rendered as Inline-class InlineMarkup markup t input where- renderInline :: t -> input -> markup+-- | Overload extraction of monad+class Monad m => Markup (m :: * -> *) where+ renderMarkup :: m a -> a --- | Assets that implement this can be rendered as /hosted/.-class HostedMarkup markup t input where- renderHosted :: t -> input -> markup --- | Assets that implement this can be rendered as /local/.-class LocalMarkup markup t input where- renderLocal :: t -> input -> markup---- TODO: wrap all three deployment systems in one class, and remove the need to --- worry about it post-`renderMarkup`.+instance Markup InlineMarkupM where+ renderMarkup = runInlineMarkupM -instance ( InlineMarkup markup t input- , Monad m ) =>- Markup markup t (InlineMarkupT input m) where- renderMarkup t = InlineMarkupT $ \i ->- return $ renderInline t i+instance Markup HostedMarkupM where+ renderMarkup = runHostedMarkupM -instance ( HostedMarkup markup t input- , Monad m ) =>- Markup markup t (HostedMarkupT input m) where- renderMarkup t = HostedMarkupT $ \i ->- return $ renderHosted t i+instance Markup LocalMarkupM where+ renderMarkup = runLocalMarkupM -instance ( LocalMarkup markup t input- , Monad m ) =>- Markup markup t (LocalMarkupT input m) where- renderMarkup t = LocalMarkupT $ \i ->- return $ renderLocal t i
src/Data/Markup/Library.hs view
@@ -7,6 +7,7 @@ module Data.Markup.Library where import Data.Markup.Class+import Data.Markup.Types import UrlPath @@ -32,68 +33,154 @@ -- Lucid instances +-- Images only have local and hosted instances - inline can only be done with +-- js... TODO?+ instance Monad m =>- HostedMarkup (LBase.HtmlT m ()) Image T.Text where- renderHosted Image t =- L.img_ [L.src_ t]+ 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 ()) LocalMarkupM where+ deploy Image i = return $+ L.img_ [L.src_ i]++instance Url input m =>+ Deploy Image input (LBase.HtmlT m ()) LocalMarkupM where+ deploy Image i = return $ do+ url <- lift $ renderUrl i+ L.img_ [L.src_ url]+ instance ( Monad m- , Url input m ) =>- LocalMarkup (LBase.HtmlT m ()) Image input where- renderLocal Image t = do- url <- lift $ renderUrl t+ , Monad m' ) =>+ Deploy Image T.Text (LBase.HtmlT m ()) (HostedMarkupT m') where+ deploy Image i = return $+ L.img_ [L.src_ i]++instance ( Monad m+ , Monad m' ) =>+ Deploy Image T.Text (LBase.HtmlT m ()) (LocalMarkupT m') where+ deploy Image i = return $+ L.img_ [L.src_ i]++instance ( Url input m+ , Monad m' ) =>+ Deploy Image input (LBase.HtmlT m ()) (LocalMarkupT m') where+ deploy Image i = return $ do+ url <- lift $ renderUrl i L.img_ [L.src_ url] +-- JS instances+ instance Monad m =>- InlineMarkup (LBase.HtmlT m ()) JavaScript T.Text where- renderInline JavaScript t =- L.script_ [] t+ Deploy JavaScript T.Text (LBase.HtmlT m ()) InlineMarkupM where+ deploy JavaScript i = return $+ L.script_ [] i instance Monad m =>- InlineMarkup (LBase.HtmlT m ()) JavaScript LT.Text where- renderInline JavaScript t =- L.script_ [] t+ Deploy JavaScript LT.Text (LBase.HtmlT m ()) InlineMarkupM where+ deploy JavaScript i = return $+ L.script_ [] i instance Monad m =>- HostedMarkup (LBase.HtmlT m ()) JavaScript T.Text where- renderHosted JavaScript t =- L.script_ [L.src_ t] ("" :: T.Text)+ Deploy JavaScript T.Text (LBase.HtmlT m ()) HostedMarkupM where+ deploy JavaScript i = return $+ L.script_ [L.src_ i] ("" :: T.Text) +instance Url input m =>+ Deploy JavaScript input (LBase.HtmlT m ()) LocalMarkupM where+ deploy JavaScript i = return $ do+ url <- lift $ renderUrl i+ L.script_ [L.src_ url] ("" :: T.Text)+ instance ( Monad m- , Url input m ) =>- LocalMarkup (LBase.HtmlT m ()) JavaScript input where- renderLocal JavaScript t = do- url <- lift $ renderUrl t+ , Monad m' ) =>+ Deploy JavaScript T.Text (LBase.HtmlT m ()) (InlineMarkupT m') where+ deploy JavaScript i = return $+ L.script_ [] i++instance ( Monad m+ , Monad m' ) =>+ Deploy JavaScript LT.Text (LBase.HtmlT m ()) (InlineMarkupT m') where+ deploy JavaScript i = return $+ L.script_ [] i++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)++instance ( Url input m+ , Monad m' ) =>+ Deploy JavaScript input (LBase.HtmlT m ()) (LocalMarkupT m') where+ deploy JavaScript i = return $ do+ url <- lift $ renderUrl i L.script_ [L.src_ url] ("" :: T.Text) -- Blaze-html instances -instance H.ToValue a =>- HostedMarkup (HI.MarkupM ()) Image a where- renderHosted Image t =- H.img H.! A.src (H.toValue t) +instance H.ToValue input =>+ Deploy Image input (HI.MarkupM ()) HostedMarkupM where+ deploy Image i = return $+ H.img H.! A.src (H.toValue i)+ instance Url input HI.MarkupM =>- LocalMarkup (HI.MarkupM ()) Image input where- renderLocal Image t = do- url <- renderUrl t+ Deploy Image input (HI.MarkupM ()) LocalMarkupM where+ deploy Image i = return $ do+ url <- renderUrl i H.img H.! A.src (H.toValue url) +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 H.ToMarkup a =>- InlineMarkup (HI.MarkupM ()) JavaScript a where- renderInline JavaScript t =- H.script (H.toMarkup t)+instance ( Url input HI.MarkupM+ , Monad m ) =>+ Deploy Image input (HI.MarkupM ()) (LocalMarkupT m) where+ deploy Image i = return $ do+ url <- renderUrl i+ H.img H.! A.src (H.toValue url) -instance H.ToValue a =>- HostedMarkup (HI.MarkupM ()) JavaScript a where- renderHosted JavaScript t =- (H.script H.! A.src (H.toValue t)) HI.Empty ++instance H.ToMarkup input =>+ Deploy JavaScript input (HI.MarkupM ()) InlineMarkupM where+ deploy JavaScript i = return $+ H.script (H.toMarkup i)++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 Url input HI.MarkupM =>- LocalMarkup (HI.MarkupM ()) JavaScript input where- renderLocal JavaScript t = do- url <- renderUrl t+ Deploy JavaScript input (HI.MarkupM ()) LocalMarkupM where+ deploy JavaScript i = return $ do+ url <- renderUrl i+ (H.script H.! A.src (H.toValue url)) HI.Empty++instance ( H.ToMarkup input+ , Monad m ) =>+ Deploy JavaScript input (HI.MarkupM ()) (InlineMarkupT m) where+ deploy JavaScript i = return $+ H.script (H.toMarkup i)++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 ( Url input HI.MarkupM+ , Monad m ) =>+ Deploy JavaScript input (HI.MarkupM ()) (LocalMarkupT m) where+ deploy JavaScript i = return $ do+ url <- renderUrl i (H.script H.! A.src (H.toValue url)) HI.Empty
src/Data/Markup/Types.hs view
@@ -11,91 +11,85 @@ import Control.Monad.Reader.Class --- | Mirror of the ReaderT monad transformer - used to coerce markup to /inline/ --- rendering.-newtype InlineMarkupT i m a = InlineMarkupT { runInlineMarkupT :: i -> m a }++newtype InlineMarkupT m a = InlineMarkupT { runInlineMarkupT :: m a } deriving (Functor) -instance Applicative f => Applicative (InlineMarkupT i f) where- (<*>) f x = InlineMarkupT $ \i ->- (<*>) (runInlineMarkupT f i) (runInlineMarkupT x i)+instance Applicative f => Applicative (InlineMarkupT f) where+ (<*>) f x = InlineMarkupT $+ (<*>) (runInlineMarkupT f) $ runInlineMarkupT x -instance Alternative f => Alternative (InlineMarkupT i f) where- (<|>) m n = InlineMarkupT $ \i ->- (<|>) (runInlineMarkupT m i) (runInlineMarkupT n i)+instance Monad m => Monad (InlineMarkupT m) where+ return = InlineMarkupT . return+ x >>= f = InlineMarkupT $ + runInlineMarkupT x >>= (runInlineMarkupT . f) -instance Monad m => Monad (InlineMarkupT i m) where- return x = InlineMarkupT $ \_ -> return x- (>>=) x f = InlineMarkupT $ \i ->- runInlineMarkupT x i >>= \y -> runInlineMarkupT (f y) i+instance MonadTrans InlineMarkupT where+ lift = InlineMarkupT -instance MonadPlus m => MonadPlus (InlineMarkupT i m) where- mzero = lift mzero- x `mplus` y = InlineMarkupT $ \i ->- (runInlineMarkupT x i) `mplus` (runInlineMarkupT y i)+newtype HostedMarkupT m a = HostedMarkupT { runHostedMarkupT :: m a }+ deriving (Functor) -instance MonadTrans (InlineMarkupT i) where- lift x = InlineMarkupT $ \_ -> x+instance Applicative f => Applicative (HostedMarkupT f) where+ (<*>) f x = HostedMarkupT $+ (<*>) (runHostedMarkupT f) $ runHostedMarkupT x -instance Monad m => MonadReader i (InlineMarkupT i m) where- ask = InlineMarkupT $ \i -> return i+instance Monad m => Monad (HostedMarkupT m) where+ return = HostedMarkupT . return+ x >>= f = HostedMarkupT $ + runHostedMarkupT x >>= (runHostedMarkupT . f) +instance MonadTrans HostedMarkupT where+ lift = HostedMarkupT --- | Mirror of the ReaderT monad transformer - used to coerce markup to /hosted/ --- rendering.-newtype HostedMarkupT i m a = HostedMarkupT { runHostedMarkupT :: i -> m a }+newtype LocalMarkupT m a = LocalMarkupT { runLocalMarkupT :: m a } deriving (Functor) -instance Applicative f => Applicative (HostedMarkupT i f) where- (<*>) f x = HostedMarkupT $ \i ->- (<*>) (runHostedMarkupT f i) (runHostedMarkupT x i)+instance Applicative f => Applicative (LocalMarkupT f) where+ (<*>) f x = LocalMarkupT $+ (<*>) (runLocalMarkupT f) $ runLocalMarkupT x -instance Alternative f => Alternative (HostedMarkupT i f) where- (<|>) m n = HostedMarkupT $ \i ->- (<|>) (runHostedMarkupT m i) (runHostedMarkupT n i)+instance Monad m => Monad (LocalMarkupT m) where+ return = LocalMarkupT . return+ x >>= f = LocalMarkupT $ + runLocalMarkupT x >>= (runLocalMarkupT . f) -instance Monad m => Monad (HostedMarkupT i m) where- return x = HostedMarkupT $ \_ -> return x- (>>=) x f = HostedMarkupT $ \i ->- runHostedMarkupT x i >>= \y -> runHostedMarkupT (f y) i+instance MonadTrans LocalMarkupT where+ lift = LocalMarkupT -instance MonadPlus m => MonadPlus (HostedMarkupT i m) where- mzero = lift mzero- x `mplus` y = HostedMarkupT $ \i ->- (runHostedMarkupT x i) `mplus` (runHostedMarkupT y i) -instance MonadTrans (HostedMarkupT i) where- lift x = HostedMarkupT $ \_ -> x -instance Monad m => MonadReader i (HostedMarkupT i m) where- ask = HostedMarkupT $ \i -> return i+newtype InlineMarkupM a = InlineMarkupM {runInlineMarkupM :: a}+ deriving (Functor) +instance Applicative InlineMarkupM where+ (<*>) f x = InlineMarkupM $+ runInlineMarkupM f (runInlineMarkupM x) --- | Mirror of the ReaderT monad transformer - used to coerce markup to /local/ --- rendering.-newtype LocalMarkupT i m a = LocalMarkupT { runLocalMarkupT :: i -> m a }+instance Monad InlineMarkupM where+ return = InlineMarkupM+ x >>= f = f $ runInlineMarkupM x++newtype HostedMarkupM a = HostedMarkupM {runHostedMarkupM :: a} deriving (Functor) -instance Applicative f => Applicative (LocalMarkupT i f) where- (<*>) f x = LocalMarkupT $ \i ->- (<*>) (runLocalMarkupT f i) (runLocalMarkupT x i)+instance Applicative HostedMarkupM where+ (<*>) f x = HostedMarkupM $+ runHostedMarkupM f (runHostedMarkupM x) -instance Alternative f => Alternative (LocalMarkupT i f) where- (<|>) m n = LocalMarkupT $ \i ->- (<|>) (runLocalMarkupT m i) (runLocalMarkupT n i)+instance Monad HostedMarkupM where+ return = HostedMarkupM+ x >>= f = f $ runHostedMarkupM x -instance Monad m => Monad (LocalMarkupT i m) where- return x = LocalMarkupT $ \_ -> return x- (>>=) x f = LocalMarkupT $ \i ->- runLocalMarkupT x i >>= \y -> runLocalMarkupT (f y) i+newtype LocalMarkupM a = LocalMarkupM {runLocalMarkupM :: a}+ deriving (Functor) -instance MonadPlus m => MonadPlus (LocalMarkupT i m) where- mzero = lift mzero- x `mplus` y = LocalMarkupT $ \i ->- (runLocalMarkupT x i) `mplus` (runLocalMarkupT y i)+instance Applicative LocalMarkupM where+ (<*>) f x = LocalMarkupM $+ runLocalMarkupM f (runLocalMarkupM x) -instance MonadTrans (LocalMarkupT i) where- lift x = LocalMarkupT $ \_ -> x+instance Monad LocalMarkupM where+ return = LocalMarkupM+ x >>= f = f $ runLocalMarkupM x -instance Monad m => MonadReader i (LocalMarkupT i m) where- ask = LocalMarkupT $ \i -> return i+