packages feed

markup (empty) → 0.0.1

raw patch · 8 files changed

+361/−0 lines, 8 filesdep +basedep +blaze-htmldep +blaze-markupsetup-changed

Dependencies added: base, blaze-html, blaze-markup, hspec, lucid, mtl, text, transformers, urlpath

Files

+ LICENSE view
@@ -0,0 +1,21 @@+The MIT License++Copyright (c) 2014 Athan Clark, athan.clark@gmail.com++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in+all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN+THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ markup.cabal view
@@ -0,0 +1,76 @@+Name:                   markup+Version:                0.0.1+Author:                 Athan Clark <athan.clark@gmail.com>+Maintainer:             Athan Clark <athan.clark@gmail.com>+License:                MIT+License-File:           LICENSE+Synopsis:               Abstraction for markup languages+Description:+  This library tries to make things more uniformly controlled when working with +  markup languages in haskell - namely /deployment/ of markup assets.+  .+  Deployment, from this library's perspective, means /how/ something can be +  rendered to markup, yet still achieve the same "result" to the end user (namely +  the DOM).+  .+  We use monad transformers to infer the deployment mechanism for a context of +  markup. The three deployment mechanisms provided include /inline/ (content is +  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' = renderMarkup Image :: Monad m => HostedMarkupT m T.Text (Html ())+  > +  > image = runHostedMarkupT image' "foo.png"+  > +  > λ> renderText 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 ())+  >+  > λ> (runUrlReader $ renderTextT $ runIdentity $ runLocalMarkupT image' $+  >      "foo.png" <?> ("key","bar")+  >    ) "example.com"+  >+  > "<img src=\"example.com/foo.png?key=bar\">"+  .+  Right now this library isn't so great, hopefully it will get better soon :)++Cabal-Version:          >= 1.10+Build-Type:             Simple++Library+  Default-Language:     Haskell2010+  HS-Source-Dirs:       src+  GHC-Options:          -Wall+  Exposed-Modules:      Data.Markup+                        Data.Markup.Types+                        Data.Markup.Class+                        Data.Markup.Library+  Build-Depends:        base >= 4 && < 5+                      , transformers+                      , mtl+                      , lucid >= 2.5+                      , blaze-html+                      , blaze-markup+                      , text+                      , urlpath++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++Source-Repository head+  Type:                 git+  Location:             https://github.com/athanclark/markup.git
+ src/Data/Markup.hs view
@@ -0,0 +1,12 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE FlexibleInstances #-}++module Data.Markup+    ( module Data.Markup.Types+    , module Data.Markup.Class+    , module Data.Markup.Library ) where++import Data.Markup.Types+import Data.Markup.Class+import Data.Markup.Library
+ src/Data/Markup/Class.hs view
@@ -0,0 +1,49 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE FlexibleInstances #-}++module Data.Markup.Class where++import Data.Markup.Types++import Lucid+import Data.Monoid+import qualified Data.Text as T++-- | Overload assets and their markup library, over some deployment+class Markup markup t (m :: * -> *) where+  renderMarkup :: t -> 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++-- | 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 ( InlineMarkup markup t input+         , Monad m ) =>+             Markup markup t (InlineMarkupT input m) where+  renderMarkup t = InlineMarkupT $ \i ->+    return $ renderInline t i++instance ( HostedMarkup markup t input+         , Monad m ) =>+             Markup markup t (HostedMarkupT input m) where+  renderMarkup t = HostedMarkupT $ \i ->+    return $ renderHosted t i++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
@@ -0,0 +1,99 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ExtendedDefaultRules #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}++module Data.Markup.Library where++import Data.Markup.Class++import UrlPath++import qualified Lucid as L+import qualified Lucid.Base as LBase++import qualified Text.Blaze.Html5 as H+import qualified Text.Blaze.Html5.Attributes as A+import qualified Text.Blaze.Internal as HI++import qualified Data.Text as T+import qualified Data.Text.Lazy as LT++import Data.Monoid+import Control.Monad.Trans++-- | Abstract data type of an "image" asset.+data Image = Image deriving (Show, Eq)++-- | Abstract data type of javascript.+data JavaScript = JavaScript deriving (Show, Eq)+++-- Lucid instances++instance Monad m =>+           HostedMarkup (LBase.HtmlT m ()) Image T.Text where+  renderHosted Image t =+    L.img_ [L.src_ t]++instance ( Monad m+         , Url input m ) =>+             LocalMarkup (LBase.HtmlT m ()) Image input where+  renderLocal Image t = do+    url <- lift $ renderUrl t+    L.img_ [L.src_ url]+++instance Monad m =>+           InlineMarkup (LBase.HtmlT m ()) JavaScript T.Text where+  renderInline JavaScript t =+    L.script_ [] t++instance Monad m =>+           InlineMarkup (LBase.HtmlT m ()) JavaScript LT.Text where+  renderInline JavaScript t =+    L.script_ [] t++instance Monad m =>+           HostedMarkup (LBase.HtmlT m ()) JavaScript T.Text where+  renderHosted JavaScript t =+    L.script_ [L.src_ t] ("" :: T.Text)++instance ( Monad m+         , Url input m ) =>+             LocalMarkup (LBase.HtmlT m ()) JavaScript input where+  renderLocal JavaScript t = do+    url <- lift $ renderUrl t+    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 Url input HI.MarkupM =>+             LocalMarkup (HI.MarkupM ()) Image input where+  renderLocal Image t = do+    url <- renderUrl t+    H.img H.! A.src (H.toValue url)+++instance H.ToMarkup a =>+             InlineMarkup (HI.MarkupM ()) JavaScript a where+  renderInline JavaScript t =+    H.script (H.toMarkup t)++instance H.ToValue a =>+             HostedMarkup (HI.MarkupM ()) JavaScript a where+  renderHosted JavaScript t =+    (H.script H.! A.src (H.toValue t)) HI.Empty++instance Url input HI.MarkupM =>+             LocalMarkup (HI.MarkupM ()) JavaScript input where+  renderLocal JavaScript t = do+    url <- renderUrl t+    (H.script H.! A.src (H.toValue url)) HI.Empty
+ src/Data/Markup/Types.hs view
@@ -0,0 +1,101 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}++module Data.Markup.Types where++import Control.Applicative+import Control.Monad+import Control.Monad.Trans+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 }+  deriving (Functor)++instance Applicative f => Applicative (InlineMarkupT i f) where+  (<*>) f x = InlineMarkupT $ \i ->+    (<*>) (runInlineMarkupT f i) (runInlineMarkupT x i)++instance Alternative f => Alternative (InlineMarkupT i f) where+  (<|>) m n = InlineMarkupT $ \i ->+    (<|>) (runInlineMarkupT m i) (runInlineMarkupT n i)++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 MonadPlus m => MonadPlus (InlineMarkupT i m) where+  mzero = lift mzero+  x `mplus` y = InlineMarkupT $ \i ->+    (runInlineMarkupT x i) `mplus` (runInlineMarkupT y i)++instance MonadTrans (InlineMarkupT i) where+  lift x = InlineMarkupT $ \_ -> x++instance Monad m => MonadReader i (InlineMarkupT i m) where+  ask = InlineMarkupT $ \i -> return i+++-- | Mirror of the ReaderT monad transformer - used to coerce markup to /hosted/ +-- rendering.+newtype HostedMarkupT i m a = HostedMarkupT { runHostedMarkupT :: i -> m a }+  deriving (Functor)++instance Applicative f => Applicative (HostedMarkupT i f) where+  (<*>) f x = HostedMarkupT $ \i ->+    (<*>) (runHostedMarkupT f i) (runHostedMarkupT x i)++instance Alternative f => Alternative (HostedMarkupT i f) where+  (<|>) m n = HostedMarkupT $ \i ->+    (<|>) (runHostedMarkupT m i) (runHostedMarkupT n i)++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 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+++-- | Mirror of the ReaderT monad transformer - used to coerce markup to /local/ +-- rendering.+newtype LocalMarkupT i m a = LocalMarkupT { runLocalMarkupT :: i -> m a }+  deriving (Functor)++instance Applicative f => Applicative (LocalMarkupT i f) where+  (<*>) f x = LocalMarkupT $ \i ->+    (<*>) (runLocalMarkupT f i) (runLocalMarkupT x i)++instance Alternative f => Alternative (LocalMarkupT i f) where+  (<|>) m n = LocalMarkupT $ \i ->+    (<|>) (runLocalMarkupT m i) (runLocalMarkupT n i)++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++instance MonadPlus m => MonadPlus (LocalMarkupT i m) where+  mzero = lift mzero+  x `mplus` y = LocalMarkupT $ \i ->+    (runLocalMarkupT x i) `mplus` (runLocalMarkupT y i)++instance MonadTrans (LocalMarkupT i) where+  lift x = LocalMarkupT $ \_ -> x++instance Monad m => MonadReader i (LocalMarkupT i m) where+  ask = LocalMarkupT $ \i -> return i
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}