xml-html-qq-0.1.0.1/src/ 0000755 0000000 0000000 00000000000 13046305761 013012 5 ustar 00 0000000 0000000 xml-html-qq-0.1.0.1/src/Text/ 0000755 0000000 0000000 00000000000 13046526303 013733 5 ustar 00 0000000 0000000 xml-html-qq-0.1.0.1/src/Text/HTML/ 0000755 0000000 0000000 00000000000 13046742760 014506 5 ustar 00 0000000 0000000 xml-html-qq-0.1.0.1/src/Text/XML/ 0000755 0000000 0000000 00000000000 13046742644 014403 5 ustar 00 0000000 0000000 xml-html-qq-0.1.0.1/src/Text/XMLHTML/ 0000755 0000000 0000000 00000000000 13046535751 015067 5 ustar 00 0000000 0000000 xml-html-qq-0.1.0.1/test/ 0000755 0000000 0000000 00000000000 13046546544 013210 5 ustar 00 0000000 0000000 xml-html-qq-0.1.0.1/src/Text/HTML/QQ.hs 0000644 0000000 0000000 00000005141 13046742760 015364 0 ustar 00 0000000 0000000 {-# 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.hs 0000644 0000000 0000000 00000010506 13046742644 015262 0 ustar 00 0000000 0000000 {-# 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.hs 0000644 0000000 0000000 00000004571 13046535751 017206 0 ustar 00 0000000 0000000 {-# 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.hs 0000644 0000000 0000000 00000003703 13046546544 014441 0 ustar 00 0000000 0000000 {-# 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.hs 0000644 0000000 0000000 00000001627 13046305027 015104 0 ustar 00 0000000 0000000
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/LICENSE 0000644 0000000 0000000 00000002767 13046305116 013236 0 ustar 00 0000000 0000000 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.
xml-html-qq-0.1.0.1/Setup.hs 0000644 0000000 0000000 00000000056 13046305027 013653 0 ustar 00 0000000 0000000 import Distribution.Simple
main = defaultMain
xml-html-qq-0.1.0.1/xml-html-qq.cabal 0000644 0000000 0000000 00000004433 13046743604 015376 0 ustar 00 0000000 0000000 name: 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.md 0000644 0000000 0000000 00000001434 13046742274 013510 0 ustar 00 0000000 0000000
Text.XML.QQ and Text.HTML.QQ
============================
[](http://travis-ci.org/cdepillabout/xml-html-qq)
[](https://hackage.haskell.org/package/xml-html-qq)
[](http://stackage.org/lts/package/xml-html-qq)
[](http://stackage.org/nightly/package/xml-html-qq)

`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.