xml-html-qq-0.1.0.1/src/0000755000000000000000000000000013046305761013012 5ustar0000000000000000xml-html-qq-0.1.0.1/src/Text/0000755000000000000000000000000013046526303013733 5ustar0000000000000000xml-html-qq-0.1.0.1/src/Text/HTML/0000755000000000000000000000000013046742760014506 5ustar0000000000000000xml-html-qq-0.1.0.1/src/Text/XML/0000755000000000000000000000000013046742644014403 5ustar0000000000000000xml-html-qq-0.1.0.1/src/Text/XMLHTML/0000755000000000000000000000000013046535751015067 5ustar0000000000000000xml-html-qq-0.1.0.1/test/0000755000000000000000000000000013046546544013210 5ustar0000000000000000xml-html-qq-0.1.0.1/src/Text/HTML/QQ.hs0000644000000000000000000000514113046742760015364 0ustar0000000000000000{-# 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||] :: Document -- 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 -- package. -- This means you can use variable interpolation, as well as @forall@, @if@, -- and @case@ control statements. Checkout the -- for -- more info. -- -- >>> let a = "hello world" -- >>> [html|#{a}|] -- Document ... -- -- Even invalid HTML will still parse. -- -- >>> [html||] -- Document ... -- -- Here's an example of a template that can be parsed as an HTML 'Document', but -- not as an XML 'Document': -- -- >>> [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'. -- -- Here's a simple example of using it: -- -- >>> [htmlRaw||] :: Document -- Document ... htmlRaw :: QuasiQuoter htmlRaw = createExpQuasiQuoter $ lift . parseLT . pack xml-html-qq-0.1.0.1/src/Text/XML/QQ.hs0000644000000000000000000001050613046742644015262 0ustar0000000000000000{-# 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||] :: Either SomeException Document -- 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 -- package. -- This means you can use variable interpolation, as well as @forall@, @if@, -- and @case@ control statements. Checkout the -- for -- more info. -- -- >>> let a = "hello world" -- >>> [xml|#{a}|] -- Right ... -- -- Here's an example of invalue XML that will produce a 'Left' value: -- -- >>> [xml||] -- Left ... -- -- Here's an example of a template that can be parsed as an HTML 'Document', but -- not as an XML 'Document': -- -- >>> [xml|
|] -- 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. -- -- Here's a simple example of using it: -- -- >>> [xmlUnsafe||] :: Document -- Document ... 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'. -- -- Unlike 'xmlUnsafe', this function is safe to use in production code. -- -- Here's a simple example of using it: -- -- >>> [xmlRaw||] :: Document -- Document ... xmlRaw :: QuasiQuoter xmlRaw = createExpQuasiQuoter $ \string -> let eitherDoc = parseText def $ pack string in either (handleParseDocErr "XML" "Text.XML.parseText" string) lift eitherDoc xml-html-qq-0.1.0.1/src/Text/XMLHTML/Internal.hs0000644000000000000000000000457113046535751017206 0ustar0000000000000000{-# 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 xml-html-qq-0.1.0.1/test/Spec.hs0000644000000000000000000000370313046546544014441 0ustar0000000000000000{-# 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|#{a}|] 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||] expectedDoc :: Document expectedDoc = Document { documentPrologue = Prologue {prologueBefore = [], prologueDoctype = Nothing, prologueAfter = []} , documentRoot = Element {elementName = "html", elementAttributes = mempty, elementNodes = []} , documentEpilogue = [] } xml-html-qq-0.1.0.1/test/DocTest.hs0000644000000000000000000000162713046305027015104 0ustar0000000000000000 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" ] xml-html-qq-0.1.0.1/LICENSE0000644000000000000000000000276713046305116013236 0ustar0000000000000000Copyright 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. xml-html-qq-0.1.0.1/Setup.hs0000644000000000000000000000005613046305027013653 0ustar0000000000000000import Distribution.Simple main = defaultMain xml-html-qq-0.1.0.1/xml-html-qq.cabal0000644000000000000000000000443313046743604015376 0ustar0000000000000000name: xml-html-qq version: 0.1.0.1 synopsis: Quasi-quoters for XML and HTML Documents description: Please see . 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 xml-html-qq-0.1.0.1/README.md0000644000000000000000000000143413046742274013510 0ustar0000000000000000 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. For documentation and usage examples, see the [documentation](https://hackage.haskell.org/package/xml-html-qq) on Hackage.