packages feed

xml-html-qq (empty) → 0.1.0.0

raw patch · 9 files changed

+512/−0 lines, 9 filesdep +Globdep +basedep +blaze-markupsetup-changed

Dependencies added: Glob, base, blaze-markup, conduit, data-default, doctest, from-sum, heterocephalus, html-conduit, resourcet, tasty, tasty-hunit, template-haskell, text, th-lift, th-lift-instances, xml-conduit, xml-html-qq

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Dennis Gosnell (c) 2017++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Author name here nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,11 @@++Text.XML.QQ and Text.HTML.QQ+============================++[![Build Status](https://secure.travis-ci.org/cdepillabout/xml-html-qq.svg)](http://travis-ci.org/cdepillabout/xml-html-qq)+[![Hackage](https://img.shields.io/hackage/v/xml-html-qq.svg)](https://hackage.haskell.org/package/xml-html-qq)+[![Stackage LTS](http://stackage.org/package/xml-html-qq/badge/lts)](http://stackage.org/lts/package/xml-html-qq)+[![Stackage Nightly](http://stackage.org/package/xml-html-qq/badge/nightly)](http://stackage.org/nightly/package/xml-html-qq)+![BSD3 license](https://img.shields.io/badge/license-BSD3-blue.svg)++`xml-html-qq` provides quasi-quoters for XML and HTML `Document`s.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ src/Text/HTML/QQ.hs view
@@ -0,0 +1,83 @@+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE TemplateHaskell #-}++{- |+Module      :  Text.HTML.QQ++Copyright   :  Dennis Gosnell 2017+License     :  BSD3++Maintainer  :  Dennis Gosnell (cdep.illabout@gmail.com)+Stability   :  experimental+Portability :  unknown++This module provides a quasi-quoter for HTML 'Document's.  See the 'html'+function for some examples.++See "Text.XML.QQ" for an explanation of the difference between "Text.HTML.QQ"+and "Text.XML.QQ".+-}++module Text.HTML.QQ+  ( html+  , htmlRaw+    -- * Types+  , Document+  ) where++import Data.Text.Lazy (pack)+import Language.Haskell.TH (appE)+import Language.Haskell.TH.Quote (QuasiQuoter(..))+import Language.Haskell.TH.Syntax (lift)+import Text.Blaze.Renderer.Text (renderMarkup)+import Text.Heterocephalus (compileFromString, textSetting)+import Text.HTML.DOM (parseLT)+import Text.XML (Document)++import Text.XMLHTML.Internal (createExpQuasiQuoter)++-- $setup+-- >>> :set -XQuasiQuotes+-- >>> :set -XTemplateHaskell+++-- | This 'QuasiQuoter' produces HTML 'Document's.+--+-- This 'QuasiQuoter' produces expressions of type 'Document'.+--+-- Here's a simple example of using it:+--+-- >>> [html|<html></html>|]+-- Document {documentPrologue = Prologue {prologueBefore = [], prologueDoctype = Nothing, prologueAfter = []}, documentRoot = Element {elementName = Name {nameLocalName = "html", nameNamespace = Nothing, namePrefix = Nothing}, elementAttributes = fromList [], elementNodes = []}, documentEpilogue = []}+--+-- Internally, this function is using the+-- <https://hackage.haskell.org/package/heterocephalus heterocephalus> package.+-- This means you can use variable interpolation, as well as @forall@, @if@,+-- and @case@ control statements.  Checkout the+-- <https://github.com/arowM/heterocephalus#syntax heterocephalus README> for+-- more info.+--+-- >>> let a = "hello world"+-- >>> [html|<html>#{a}</html>|]+-- Document ...+--+-- Even invalid HTML will still parse.+--+-- >>> [html|<html </html>|]+-- Document ...+--+-- Here's an example of a template that can be parsed as an HTML 'Document', but+-- not as an XML 'Document':+--+-- >>> [html|<html><br></html>|]+-- Document ...+html :: QuasiQuoter+html =+  createExpQuasiQuoter $ \string ->+    appE [|parseLT . renderMarkup|] $ compileFromString textSetting string++-- | This function is the same as 'html', but doesn't allow variable+-- interpolation or control statements.  It also produces expressions of type+-- 'Document'.+htmlRaw :: QuasiQuoter+htmlRaw = createExpQuasiQuoter $ lift . parseLT . pack
+ src/Text/XML/QQ.hs view
@@ -0,0 +1,124 @@+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE TemplateHaskell #-}++{- |+Module      :  Text.XML.QQ++Copyright   :  Dennis Gosnell 2017+License     :  BSD3++Maintainer  :  Dennis Gosnell (cdep.illabout@gmail.com)+Stability   :  experimental+Portability :  unknown++This module provides a quasi-quoter for XML 'Document's.  See the 'xml'+function for some examples.++The difference between "Text.XML.QQ" and "Text.HTML.QQ" is the function that is+used to parse the input 'String' into a 'Document'.++'Text.XML.QQ.xml' uses 'Text.XML.parseText' to parse the input 'String'.+'Text.XML.parseText' returns an error on a malformed document.  This is+generally what you want for XML documents.++'Text.HTML.QQ.html' uses 'Text.HTML.DOM'.parseLT' to parse the input 'String'.+'Text.HTML.DOM.parseLT' will parse any HTML document, skipping parts of the+document that are malformed.  This is generally what you want for HTML+documents.+-}++module Text.XML.QQ+  ( xml+  , xmlUnsafe+  , xmlRaw+    -- * Types+  , Document+  , SomeException+  ) where++import Control.Exception (SomeException)+import Control.FromSum (fromEither)+import Data.Default (def)+import Data.Text.Lazy (pack)+import Language.Haskell.TH (appE)+import Language.Haskell.TH.Quote (QuasiQuoter(..))+import Language.Haskell.TH.Syntax (lift)+import Text.Blaze.Renderer.Text (renderMarkup)+import Text.Heterocephalus (compileFromString, textSetting)+import Text.XML (Document(..), parseText)++import Text.XMLHTML.Internal+       (createExpQuasiQuoter, handleParseDocErr)++-- $setup+-- >>> :set -XQuasiQuotes+-- >>> :set -XTemplateHaskell+++-- | This 'QuasiQuoter' produces XML 'Document's.+--+-- This 'QuasiQuoter' produces expressions of type+-- @'Either' 'SomeException' 'Document'@.  It produces a+-- @'Left' 'SomeException'@ when the input string cannot be parsed into an XML+-- 'Document'.+--+-- Here's a simple example of using it:+--+-- >>> [xml|<html></html>|]+-- Right (Document {documentPrologue = Prologue {prologueBefore = [], prologueDoctype = Nothing, prologueAfter = []}, documentRoot = Element {elementName = Name {nameLocalName = "html", nameNamespace = Nothing, namePrefix = Nothing}, elementAttributes = fromList [], elementNodes = []}, documentEpilogue = []})+--+-- Internally, this function is using the+-- <https://hackage.haskell.org/package/heterocephalus heterocephalus> package.+-- This means you can use variable interpolation, as well as @forall@, @if@,+-- and @case@ control statements.  Checkout the+-- <https://github.com/arowM/heterocephalus#syntax heterocephalus README> for+-- more info.+--+-- >>> let a = "hello world"+-- >>> [xml|<html>#{a}</html>|]+-- Right ...+--+-- Here's an example of invalue XML that will produce a 'Left' value:+--+-- >>> [xml|<html </html>|]+-- Left ...+--+-- Here's an example of a template that can be parsed as an HTML 'Document', but+-- not as an XML 'Document':+--+-- >>> [xml|<html><br></html>|]+-- Left ...+xml :: QuasiQuoter+xml =+  createExpQuasiQuoter $ \string ->+    appE [|parseText def . renderMarkup|] $ compileFromString textSetting string++-- | This function is just like 'xml', but produces expressions of type+-- 'Document'.+--+-- If your input string cannot be parsed into a valid 'Document', an error will+-- be thrown at runtime with 'error'.+--+-- This function is nice to use in GHCi or tests, but should not be used in+-- production code.+xmlUnsafe :: QuasiQuoter+xmlUnsafe =+  createExpQuasiQuoter $ \string ->+    appE+      [|fromEither (handleParseDocErr "XML" "Text.XML.parseText" string) .+        parseText def . renderMarkup|]+      (compileFromString textSetting string)++-- | This function is similar to 'xml', but doesn't allow variable interpolation+-- or control statements.  It produces expressions of type 'Document'.+--+-- An error will be thrown at compile-time if the input string cannot be parsed+-- into a 'Document'.+xmlRaw :: QuasiQuoter+xmlRaw =+  createExpQuasiQuoter $ \string ->+    let eitherDoc = parseText def $ pack string+    in either+         (handleParseDocErr "XML" "Text.XML.parseText" string)+         lift+         eitherDoc
+ src/Text/XMLHTML/Internal.hs view
@@ -0,0 +1,85 @@+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++{- |+Module      :  Text.XMLHTML.Internal++Copyright   :  Dennis Gosnell 2017+License     :  BSD3++Maintainer  :  Dennis Gosnell (cdep.illabout@gmail.com)+Stability   :  experimental+Portability :  unknown++-}++module Text.XMLHTML.Internal where++import Control.Exception (SomeException)+import Instances.TH.Lift ()+import Language.Haskell.TH (Q, Exp)+import Language.Haskell.TH.Lift (deriveLiftMany)+import Language.Haskell.TH.Quote (QuasiQuoter(..))+import Text.XML+       (Doctype(..), Document(..), Element(..), ExternalID(..),+        Instruction(..), Miscellaneous(..), Name(..), Node(..),+        Prologue(..))++$(deriveLiftMany+    [ ''ExternalID+    , ''Node+    , ''Name+    , ''Instruction+    , ''Doctype+    , ''Element+    , ''Miscellaneous+    , ''Prologue+    , ''Document+    ])++-- | Create a 'QuasiQuoter' for 'Exp's.+createExpQuasiQuoter+  :: (String -> Q Exp)+  -- ^ The function to use for 'QuasiQuoter's 'quoteExp'.+  -> QuasiQuoter+createExpQuasiQuoter f =+  QuasiQuoter+  { quoteExp = f+  , quotePat = error "not used"+  , quoteType = error "not used"+  , quoteDec = error "not used"+  }++-- | This function handles errors that occur when a 'Document' can't be parsed.+--+-- This function throws an 'error' with an explanation of what happened.+handleParseDocErr+  :: String+  -- ^ The type of a document that was being parsed.  Should either be+  -- @\"XML\"@ or @\"HTML\"@.+  -> String+  -- ^ The name of the function that was being used to parse the document.+  -- Should probably either be @\"Text.XML.parseText\"@ or+  -- @\"Text.HTML.DOM.parseLT\"@ depending on whether you're parsing XML or+  -- HTML.+  -> String+  -- ^ The actual XML or HTML string that you were trying to parse into a+  -- 'Document'.+  -> SomeException+  -- ^ The exception that occurred when trying to parse the 'Document'.+  -> a+handleParseDocErr docType parseFunction string exception =+  let msg =+        "ERROR: Trying to parse a string into an " `mappend`+        docType `mappend`+        " Document,\n" `mappend`+        "but got the following error from " `mappend`+        parseFunction `mappend`+        ":\n" `mappend`+        show exception `mappend`+        "\n" `mappend`+        "attempting to parse the following document:\n" `mappend`+        string+  in error msg
+ test/DocTest.hs view
@@ -0,0 +1,40 @@++module Main (main) where++import Prelude++import Data.Monoid ((<>))+import System.FilePath.Glob (glob)+import Test.DocTest (doctest)++main :: IO ()+main = glob "src/**/*.hs" >>= doDocTest++doDocTest :: [String] -> IO ()+doDocTest options = doctest $ options <> ghcExtensions++ghcExtensions :: [String]+ghcExtensions =+    [+    --   "-XConstraintKinds"+    -- , "-XDataKinds"+      "-XDeriveDataTypeable"+    , "-XDeriveGeneric"+    -- , "-XEmptyDataDecls"+    , "-XFlexibleContexts"+    -- , "-XFlexibleInstances"+    -- , "-XGADTs"+    -- , "-XGeneralizedNewtypeDeriving"+    -- , "-XInstanceSigs"+    -- , "-XMultiParamTypeClasses"+    -- , "-XNoImplicitPrelude"+    , "-XOverloadedStrings"+    -- , "-XPolyKinds"+    -- , "-XRankNTypes"+    -- , "-XRecordWildCards"+    , "-XScopedTypeVariables"+    -- , "-XStandaloneDeriving"+    -- , "-XTupleSections"+    -- , "-XTypeFamilies"+    -- , "-XTypeOperators"+    ]
+ test/Spec.hs view
@@ -0,0 +1,74 @@+{-# LANGUAGE OverloadedLists #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}++module Main where++import Data.Text (Text)+import Test.Tasty (TestTree, defaultMain, testGroup)+import Test.Tasty.HUnit ((@?=), testCase)+import Text.XML+       (Document(..), Element(..), Name(..), Node(..), Prologue(..))++import Text.XML.QQ (xmlRaw, xmlUnsafe)++main :: IO ()+main = defaultMain tests++tests :: TestTree+tests = testGroup "tests" [xmlTests]++xmlTests :: TestTree+xmlTests = testGroup "xml" [xmlUnsafeTests, xmlRawTests]++xmlUnsafeTests :: TestTree+xmlUnsafeTests = testGroup "xmlUnsafe" [xmlUnsafeWorksCorrectly]++xmlUnsafeWorksCorrectly :: TestTree+xmlUnsafeWorksCorrectly = testCase "works correctly" $ doc @?= expectedDoc+  where+    doc :: Document+    doc =+      let a = "hello" :: Text+      in [xmlUnsafe|<html>#{a}</html>|]++    expectedDoc :: Document+    expectedDoc =+      Document+      { documentPrologue =+          Prologue+          {prologueBefore = [], prologueDoctype = Nothing, prologueAfter = []}+      , documentRoot =+          Element+          { elementName =+              Name+              { nameLocalName = "html"+              , nameNamespace = Nothing+              , namePrefix = Nothing+              }+          , elementAttributes = mempty+          , elementNodes = [NodeContent "hello"]+          }+      , documentEpilogue = []+      }++xmlRawTests :: TestTree+xmlRawTests = testGroup "xmlRaw" [xmlRawWorksCorrectly]++xmlRawWorksCorrectly :: TestTree+xmlRawWorksCorrectly = testCase "works correctly" $ doc @?= expectedDoc+  where+    doc :: Document+    doc = [xmlRaw|<html></html>|]++    expectedDoc :: Document+    expectedDoc =+      Document+      { documentPrologue =+          Prologue+          {prologueBefore = [], prologueDoctype = Nothing, prologueAfter = []}+      , documentRoot =+          Element+          {elementName = "html", elementAttributes = mempty, elementNodes = []}+      , documentEpilogue = []+      }
+ xml-html-qq.cabal view
@@ -0,0 +1,63 @@+name:                xml-html-qq+version:             0.1.0.0+synopsis:            Quasi-quoters for XML and HTML Documents+description:         Please see <https://github.com/cdepillabout/xml-html-qq#readme README.md>.+homepage:            https://github.com/cdepillabout/xml-html-qq+license:             BSD3+license-file:        LICENSE+author:              Dennis Gosnell+maintainer:          cdep.illabout@gmail.com+copyright:           2017 Dennis Gosnell+category:            Text+build-type:          Simple+extra-source-files:  README.md+cabal-version:       >=1.10++library+  hs-source-dirs:      src+  exposed-modules:     Text.HTML.QQ+                     , Text.XML.QQ+                     , Text.XMLHTML.Internal+  build-depends:       base >= 4.8 && < 5+                     , blaze-markup+                     , conduit+                     , data-default+                     , from-sum+                     , heterocephalus >= 1.0.4.0+                     , html-conduit+                     , resourcet+                     , template-haskell+                     , text+                     , th-lift+                     , th-lift-instances+                     , xml-conduit+  default-language:    Haskell2010+  ghc-options:         -Wall -fwarn-incomplete-uni-patterns -fwarn-incomplete-record-updates -fwarn-monomorphism-restriction+  other-extensions:    TemplateHaskell++test-suite xml-html-qq-doctest+  type:                exitcode-stdio-1.0+  main-is:             DocTest.hs+  hs-source-dirs:      test+  build-depends:       base+                     , doctest+                     , Glob+  default-language:    Haskell2010+  ghc-options:         -Wall -threaded -rtsopts -with-rtsopts=-N++test-suite xml-html-qq-test+  type:                exitcode-stdio-1.0+  main-is:             Spec.hs+  hs-source-dirs:      test+  build-depends:       base+                     , tasty+                     , tasty-hunit+                     , text+                     , xml-conduit+                     , xml-html-qq+  default-language:    Haskell2010+  ghc-options:         -Wall -threaded -rtsopts -with-rtsopts=-N -fwarn-incomplete-uni-patterns -fwarn-incomplete-record-updates -fwarn-monomorphism-restriction++source-repository head+  type:     git+  location: git@github.com:cdepillabout/xml-html-qq.git