{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE QuasiQuotes #-} module Samples ( testSamples ) where import Zenacy.HTML import Data.Default ( Default(..) ) import Test.Framework ( Test , testGroup ) import Test.Framework.Providers.HUnit ( testCase ) import Test.HUnit ( assertBool , assertEqual , assertFailure ) import Data.Maybe ( fromJust , fromMaybe ) import Data.Text ( Text ) import qualified Data.Text as T ( pack ) import Text.RawString.QQ testSamples :: Test testSamples = testGroup "Samples" [ testHello , testRewrite , testExtract , testQuery , testQuery2 ] testHello :: Test testHello = testCase "sample hello" $ do flip (assertEqual "Sample 1") (htmlRender $ htmlParseEasy "
HelloWorld
") "
HelloWorld
" flip (assertEqual "Sample 2") (htmlParseEasy "
HelloWorld
") (HTMLDocument "" [ HTMLElement "html" HTMLNamespaceHTML [] [ HTMLElement "head" HTMLNamespaceHTML [] [] , HTMLElement "body" HTMLNamespaceHTML [] [ HTMLElement "div" HTMLNamespaceHTML [] [ HTMLText "HelloWorld" ] ] ] ]) flip (assertEqual "Sample 3") (htmlParseEasy "
HelloWorld
") HTMLDocument { htmlDocumentName = "" , htmlDocumentChildren = [ HTMLElement { htmlElementName = "html" , htmlElementNamespace = HTMLNamespaceHTML , htmlElementAttributes = [] , htmlElementChildren = [ HTMLElement { htmlElementName = "head" , htmlElementNamespace = HTMLNamespaceHTML , htmlElementAttributes = [] , htmlElementChildren = [] } , HTMLElement { htmlElementName = "body" , htmlElementNamespace = HTMLNamespaceHTML , htmlElementAttributes = [] , htmlElementChildren = [ HTMLElement { htmlElementName = "div" , htmlElementNamespace = HTMLNamespaceHTML , htmlElementAttributes = [] , htmlElementChildren = [ HTMLText { htmlTextData = "HelloWorld" } ] } ] } ] } ] } testRewrite :: Test testRewrite = testCase "sample rewrite" $ do flip (assertEqual "Sample 1") (rewrite "HelloWorld") "
Hello
World
" rewrite :: Text -> Text rewrite = htmlRender . htmlMapElem f . fromJust . htmlDocHtml . htmlParseEasy where f x | htmlElemHasName "span" x = htmlElemRename "div" x | otherwise = x testExtract :: Test testExtract = testCase "sample extract" $ do flip (assertEqual "Sample 1") (extract "") [ "https://example1.com" , "https://example2.com" ] extract :: Text -> [Text] extract = go . htmlParseEasy where go = \case HTMLDocument n c -> concatMap go c e @ (HTMLElement "a" s a c) -> case htmlElemAttrFind (htmlAttrHasName "href") e of Just (HTMLAttr n v s) -> v : concatMap go c Nothing -> concatMap go c HTMLElement n s a c -> concatMap go c _otherwise -> [] testQuery :: Test testQuery = testCase "sample query" $ do assertEqual "Sample 1" (Just "AAA") $ query (b h) where h = [r|


AAA

|] b = fromJust . htmlSpaceRemove . fromJust . htmlDocBody . htmlParseEasy query :: HTMLNode -> Maybe Text query = htmlQueryExec $ do htmlQueryName "body" htmlQueryFirst htmlQueryName "p" htmlQueryFirst htmlQueryId "x" htmlQueryNext htmlQueryNext htmlQueryName "a" a <- htmlQueryNode htmlQuerySucc $ fromMaybe "" $ htmlElemText a testQuery2 = testCase "sample query2" $ do assertEqual "Sample 1" (htmlRender h') $ htmlRender $ htmlMapElem query2 h where h = b [r|
|] h' = b [r|
aaa
bbb
ccc
|] b = fromJust . htmlSpaceRemove . fromJust . htmlDocBody . htmlParseEasy query2 :: HTMLNode -> HTMLNode query2 = htmlQueryTry $ do htmlQueryName "div" htmlQueryOnly "img" a <- htmlQueryNode let Just b = htmlElemGetAttr "src" a htmlQuerySucc $ htmlElem "a" [ htmlAttr "href" b ] [ htmlText b ]