{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralisedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -fno-warn-unused-top-binds #-}
{-# OPTIONS_GHC -fno-warn-missing-kind-signatures #-}
module Main (main) where
import Composite
import Composite.CoRecord hiding (Op)
import Composite.TH
import Composite.XML
import Data.Text
import Test.Tasty
import Test.Tasty.HUnit
import Text.XML as X
withLensesAndProxies
[d|
type A = "a" :-> Text
type B = "b" :-> Int
type C = "c" :-> Bool
type D = "d" :-> Text
type E = "e" :-> Int
|]
type Child1 = RecXML "Child1" '[C] '[]
type Child2 = RecXML "Child2" '[D, E] '[]
type Root = RecXML "Root" '[A, B] '[Child1, Child2]
child1 :: Child1
child1 = RNode (Just True :^: RNil) []
child2 :: Child2
child2 = RNode (Just "bar" :^: Just 7 :^: RNil) []
child2b :: Child2
child2b = RNode (Just "quux" :^: Just 8 :^: RNil) []
root :: Root
root = RNode (Just "foo" :^: Just 5 :^: RNil) [field child1, field child2, field child2b]
tests :: TestTree
tests =
testGroup
"Parsing Tests"
[ testCase "parses RecXML" $ do
k <- X.readFile def "./test/data/A.xml"
let x = fromElement @Root $ documentRoot k
assertEqual "" (Just root) x
]
main :: IO ()
main = defaultMain tests