{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE StandaloneKindSignatures #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} module Composite.XML (RecXML(RNode) , ToAttr(..) , ToAttrs(..) , FromAttr(..) , FromAttrs(..) , Formattable(..) , Readable(..) , ToElement(..) , ToElements(..) , FromElement(..) , FromElements(..)) where import Composite.CoRecord import Composite.Record import Control.Arrow import Control.Monad import Data.Functor.Identity import Data.Kind import Data.Map (Map) import qualified Data.Map as Map import Data.Maybe import Data.Proxy import Data.Ratio import Data.String import Data.Text (Text) import qualified Data.Text as T import Data.Vinyl import Data.Vinyl.Functor hiding (Identity) import GHC.TypeLits import Text.XML as X type RecXML :: Symbol -> [Type] -> [Type] -> Type data RecXML :: Symbol -> [Type] -> [Type] -> Type where RNode :: Rec Maybe xs -> [Field ys] -> RecXML s xs ys deriving stock instance (Show (Field ys), Show (Rec Maybe xs), RecApplicative ys) => Show (RecXML s xs ys) deriving stock instance (Eq (Field ys), Eq (Rec Maybe xs), RecApplicative ys) => Eq (RecXML s xs ys) type ToAttrs :: Type -> Constraint class ToAttrs x where toAttrs :: x -> Map Name Text instance ToAttrs (Rec f '[]) where toAttrs :: Rec f '[] -> Map Name Text toAttrs Rec f '[] RNil = Map Name Text forall a. Monoid a => a mempty type Formattable :: Type -> Constraint class Formattable x where formatC :: x -> Text instance Formattable Bool where formatC :: Bool -> Text formatC Bool True = Text "true" formatC Bool False = Text "false" instance Formattable String where formatC :: String -> Text formatC = String -> Text T.pack instance Formattable Int where formatC :: Int -> Text formatC = String -> Text T.pack (String -> Text) -> (Int -> String) -> Int -> Text forall b c a. (b -> c) -> (a -> b) -> a -> c . Int -> String forall a. Show a => a -> String show instance Formattable () where formatC :: () -> Text formatC = String -> Text T.pack (String -> Text) -> (() -> String) -> () -> Text forall b c a. (b -> c) -> (a -> b) -> a -> c . () -> String forall a. Show a => a -> String show instance Formattable (Ratio Integer) where formatC :: Ratio Integer -> Text formatC = String -> Text T.pack (String -> Text) -> (Ratio Integer -> String) -> Ratio Integer -> Text forall b c a. (b -> c) -> (a -> b) -> a -> c . Ratio Integer -> String forall a. Show a => a -> String show instance Formattable Double where formatC :: Double -> Text formatC = String -> Text T.pack (String -> Text) -> (Double -> String) -> Double -> Text forall b c a. (b -> c) -> (a -> b) -> a -> c . Double -> String forall a. Show a => a -> String show instance Formattable Text where formatC :: Text -> Text formatC = Text -> Text forall a. a -> a id type ToAttr :: Type -> Constraint class ToAttr a where toAttr :: a -> (Name, Text) instance (Formattable a, KnownSymbol s) => ToAttr (s :-> a) where toAttr :: (s :-> a) -> (Name, Text) toAttr = (Text -> Name) -> (Text, Text) -> (Name, Text) forall (a :: * -> * -> *) b c d. Arrow a => a b c -> a (b, d) (c, d) first (String -> Name forall a. IsString a => String -> a fromString (String -> Name) -> (Text -> String) -> Text -> Name forall b c a. (b -> c) -> (a -> b) -> a -> c . Text -> String T.unpack) ((Text, Text) -> (Name, Text)) -> ((s :-> a) -> (Text, Text)) -> (s :-> a) -> (Name, Text) forall b c a. (b -> c) -> (a -> b) -> a -> c . (a -> Text) -> (Text, a) -> (Text, Text) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap a -> Text forall x. Formattable x => x -> Text formatC ((Text, a) -> (Text, Text)) -> ((s :-> a) -> (Text, a)) -> (s :-> a) -> (Text, Text) forall b c a. (b -> c) -> (a -> b) -> a -> c . (s :-> a) -> (Text, a) forall (s :: Symbol) a. KnownSymbol s => (s :-> a) -> (Text, a) valWithName instance (ToAttr x, ToAttrs (Record xs)) => ToAttrs (Record (x ': xs)) where toAttrs :: Record (x : xs) -> Map Name Text toAttrs (Identity r x :& Rec Identity rs xs) = ([(Name, Text)] -> Map Name Text forall k a. Ord k => [(k, a)] -> Map k a Map.fromList ([(Name, Text)] -> Map Name Text) -> (r -> [(Name, Text)]) -> r -> Map Name Text forall b c a. (b -> c) -> (a -> b) -> a -> c . (Name, Text) -> [(Name, Text)] forall (f :: * -> *) a. Applicative f => a -> f a pure ((Name, Text) -> [(Name, Text)]) -> (r -> (Name, Text)) -> r -> [(Name, Text)] forall b c a. (b -> c) -> (a -> b) -> a -> c . r -> (Name, Text) forall a. ToAttr a => a -> (Name, Text) toAttr (r -> Map Name Text) -> r -> Map Name Text forall a b. (a -> b) -> a -> b $ r x) Map Name Text -> Map Name Text -> Map Name Text forall a. Semigroup a => a -> a -> a <> Rec Identity rs -> Map Name Text forall x. ToAttrs x => x -> Map Name Text toAttrs Rec Identity rs xs instance (ToAttr x, ToAttrs (Rec Maybe xs)) => ToAttrs (Rec Maybe (x ': xs)) where toAttrs :: Rec Maybe (x : xs) -> Map Name Text toAttrs (Just r x :& Rec Maybe rs xs) = ([(Name, Text)] -> Map Name Text forall k a. Ord k => [(k, a)] -> Map k a Map.fromList ([(Name, Text)] -> Map Name Text) -> (r -> [(Name, Text)]) -> r -> Map Name Text forall b c a. (b -> c) -> (a -> b) -> a -> c . (Name, Text) -> [(Name, Text)] forall (f :: * -> *) a. Applicative f => a -> f a pure ((Name, Text) -> [(Name, Text)]) -> (r -> (Name, Text)) -> r -> [(Name, Text)] forall b c a. (b -> c) -> (a -> b) -> a -> c . r -> (Name, Text) forall a. ToAttr a => a -> (Name, Text) toAttr (r -> Map Name Text) -> r -> Map Name Text forall a b. (a -> b) -> a -> b $ r x) Map Name Text -> Map Name Text -> Map Name Text forall a. Semigroup a => a -> a -> a <> Rec Maybe rs -> Map Name Text forall x. ToAttrs x => x -> Map Name Text toAttrs Rec Maybe rs xs toAttrs (Maybe r Nothing :& Rec Maybe rs xs) = Rec Maybe rs -> Map Name Text forall x. ToAttrs x => x -> Map Name Text toAttrs Rec Maybe rs xs type ToElement :: Type -> Constraint class ToElement a where toElement :: a -> Element type ToElements :: Type -> Constraint class ToElements x where toElements :: x -> [Element] instance ToElements (Rec f '[]) where toElements :: Rec f '[] -> [Element] toElements Rec f '[] RNil = [Element] forall a. Monoid a => a mempty instance (ToElement x, ToElements (Record xs)) => ToElements (Record (x ': xs)) where toElements :: Record (x : xs) -> [Element] toElements (Identity r x :& Rec Identity rs xs) = r -> Element forall a. ToElement a => a -> Element toElement r x Element -> [Element] -> [Element] forall a. a -> [a] -> [a] : Rec Identity rs -> [Element] forall x. ToElements x => x -> [Element] toElements Rec Identity rs xs instance (KnownSymbol s, ToAttrs (Rec Maybe xs), RecApplicative ys, AllHave '[ToElement] ys) => ToElement (RecXML s xs ys) where toElement :: RecXML s xs ys -> Element toElement (RNode Rec Maybe xs x [Field ys] y) = Name -> Map Name Text -> [Node] -> Element Element (String -> Name forall a. IsString a => String -> a fromString (String -> Name) -> String -> Name forall a b. (a -> b) -> a -> b $ Proxy s -> String forall (n :: Symbol) (proxy :: Symbol -> *). KnownSymbol n => proxy n -> String symbolVal @s (Proxy s forall k (t :: k). Proxy t Proxy :: Proxy s)) (Rec Maybe xs -> Map Name Text forall x. ToAttrs x => x -> Map Name Text toAttrs Rec Maybe xs x) (Element -> Node NodeElement (Element -> Node) -> [Element] -> [Node] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> [Field ys] -> [Element] forall x. ToElements x => x -> [Element] toElements [Field ys] y) type Readable :: Type -> Constraint class Readable x where readC :: Text -> Maybe x instance Readable Bool where readC :: Text -> Maybe Bool readC = \case Text "true" -> Bool -> Maybe Bool forall a. a -> Maybe a Just Bool True Text "false" -> Bool -> Maybe Bool forall a. a -> Maybe a Just Bool False Text _ -> Maybe Bool forall a. Maybe a Nothing instance Readable String where readC :: Text -> Maybe String readC = String -> Maybe String forall a. a -> Maybe a Just (String -> Maybe String) -> (Text -> String) -> Text -> Maybe String forall b c a. (b -> c) -> (a -> b) -> a -> c . Text -> String T.unpack instance Readable Text where readC :: Text -> Maybe Text readC = Text -> Maybe Text forall a. a -> Maybe a Just instance Readable Double where readC :: Text -> Maybe Double readC = Double -> Maybe Double forall a. a -> Maybe a Just (Double -> Maybe Double) -> (Text -> Double) -> Text -> Maybe Double forall b c a. (b -> c) -> (a -> b) -> a -> c . String -> Double forall a. Read a => String -> a read (String -> Double) -> (Text -> String) -> Text -> Double forall b c a. (b -> c) -> (a -> b) -> a -> c . Text -> String T.unpack instance Readable Int where readC :: Text -> Maybe Int readC = Int -> Maybe Int forall a. a -> Maybe a Just (Int -> Maybe Int) -> (Text -> Int) -> Text -> Maybe Int forall b c a. (b -> c) -> (a -> b) -> a -> c . String -> Int forall a. Read a => String -> a read (String -> Int) -> (Text -> String) -> Text -> Int forall b c a. (b -> c) -> (a -> b) -> a -> c . Text -> String T.unpack type FromAttr :: Symbol -> Type -> Constraint class FromAttr s a | a -> s where fromAttr :: (Name, Text) -> Maybe a instance (Readable a, KnownSymbol s) => FromAttr s (s :-> a) where fromAttr :: (Name, Text) -> Maybe (s :-> a) fromAttr (Name n, Text x) = if Name n Name -> Name -> Bool forall a. Eq a => a -> a -> Bool == String -> Name forall a. IsString a => String -> a fromString (Proxy s -> String forall (n :: Symbol) (proxy :: Symbol -> *). KnownSymbol n => proxy n -> String symbolVal @s (Proxy s forall k (t :: k). Proxy t Proxy :: Proxy s)) then forall a. a -> s :-> a forall (s :: Symbol) a. a -> s :-> a Val @s (a -> s :-> a) -> Maybe a -> Maybe (s :-> a) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Text -> Maybe a forall x. Readable x => Text -> Maybe x readC Text x else Maybe (s :-> a) forall a. Maybe a Nothing type FromAttrs :: Type -> Constraint class FromAttrs a where fromAttrs :: [(Name, Text)] -> Maybe a instance FromAttrs (Rec f '[]) where fromAttrs :: [(Name, Text)] -> Maybe (Rec f '[]) fromAttrs [(Name, Text)] _ = Rec f '[] -> Maybe (Rec f '[]) forall (f :: * -> *) a. Applicative f => a -> f a pure Rec f '[] forall u (a :: u -> *). Rec a '[] RNil instance (FromAttr s (s :-> x), FromAttrs (Record xs)) => FromAttrs (Record (s :-> x ': xs)) where fromAttrs :: [(Name, Text)] -> Maybe (Record ((s :-> x) : xs)) fromAttrs [(Name, Text)] xs = do let as' :: [((Name, Text), Maybe (s :-> x))] as' = ((Name, Text) -> ((Name, Text), Maybe (s :-> x))) -> [(Name, Text)] -> [((Name, Text), Maybe (s :-> x))] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap (\(Name, Text) i -> ((Name, Text) i, (Name, Text) -> Maybe (s :-> x) forall (s :: Symbol) a. FromAttr s a => (Name, Text) -> Maybe a fromAttr @s @(s :-> x) (Name, Text) i)) [(Name, Text)] xs let ts :: [Maybe (s :-> x)] ts = ((Name, Text), Maybe (s :-> x)) -> Maybe (s :-> x) forall a b. (a, b) -> b snd (((Name, Text), Maybe (s :-> x)) -> Maybe (s :-> x)) -> [((Name, Text), Maybe (s :-> x))] -> [Maybe (s :-> x)] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> (((Name, Text), Maybe (s :-> x)) -> Bool) -> [((Name, Text), Maybe (s :-> x))] -> [((Name, Text), Maybe (s :-> x))] forall a. (a -> Bool) -> [a] -> [a] Prelude.filter (Maybe (s :-> x) -> Bool forall a. Maybe a -> Bool isJust (Maybe (s :-> x) -> Bool) -> (((Name, Text), Maybe (s :-> x)) -> Maybe (s :-> x)) -> ((Name, Text), Maybe (s :-> x)) -> Bool forall b c a. (b -> c) -> (a -> b) -> a -> c . ((Name, Text), Maybe (s :-> x)) -> Maybe (s :-> x) forall a b. (a, b) -> b snd) [((Name, Text), Maybe (s :-> x))] as' let rs :: [(Name, Text)] rs = ((Name, Text), Maybe (s :-> x)) -> (Name, Text) forall a b. (a, b) -> a fst (((Name, Text), Maybe (s :-> x)) -> (Name, Text)) -> [((Name, Text), Maybe (s :-> x))] -> [(Name, Text)] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> (((Name, Text), Maybe (s :-> x)) -> Bool) -> [((Name, Text), Maybe (s :-> x))] -> [((Name, Text), Maybe (s :-> x))] forall a. (a -> Bool) -> [a] -> [a] Prelude.filter (Maybe (s :-> x) -> Bool forall a. Maybe a -> Bool isNothing (Maybe (s :-> x) -> Bool) -> (((Name, Text), Maybe (s :-> x)) -> Maybe (s :-> x)) -> ((Name, Text), Maybe (s :-> x)) -> Bool forall b c a. (b -> c) -> (a -> b) -> a -> c . ((Name, Text), Maybe (s :-> x)) -> Maybe (s :-> x) forall a b. (a, b) -> b snd) [((Name, Text), Maybe (s :-> x))] as' s :-> x t <- Maybe (Maybe (s :-> x)) -> Maybe (s :-> x) forall (m :: * -> *) a. Monad m => m (m a) -> m a join (Maybe (Maybe (s :-> x)) -> Maybe (s :-> x)) -> Maybe (Maybe (s :-> x)) -> Maybe (s :-> x) forall a b. (a -> b) -> a -> b $ [Maybe (s :-> x)] -> Maybe (Maybe (s :-> x)) forall a. [a] -> Maybe a listToMaybe [Maybe (s :-> x)] ts Record xs xs' <- [(Name, Text)] -> Maybe (Record xs) forall a. FromAttrs a => [(Name, Text)] -> Maybe a fromAttrs [(Name, Text)] rs Record ((s :-> x) : xs) -> Maybe (Record ((s :-> x) : xs)) forall (f :: * -> *) a. Applicative f => a -> f a pure (Record ((s :-> x) : xs) -> Maybe (Record ((s :-> x) : xs))) -> Record ((s :-> x) : xs) -> Maybe (Record ((s :-> x) : xs)) forall a b. (a -> b) -> a -> b $ (s :-> x) -> Identity (s :-> x) forall a. a -> Identity a Identity s :-> x t Identity (s :-> x) -> Record xs -> Record ((s :-> x) : xs) forall u (a :: u -> *) (r :: u) (rs :: [u]). a r -> Rec a rs -> Rec a (r : rs) :& Record xs xs' instance (FromAttr s (s :-> x), FromAttrs (Rec Maybe xs)) => FromAttrs (Rec Maybe (s :-> x ': xs)) where fromAttrs :: [(Name, Text)] -> Maybe (Rec Maybe ((s :-> x) : xs)) fromAttrs [(Name, Text)] xs = do let as' :: [((Name, Text), Maybe (s :-> x))] as' = ((Name, Text) -> ((Name, Text), Maybe (s :-> x))) -> [(Name, Text)] -> [((Name, Text), Maybe (s :-> x))] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap (\(Name, Text) i -> ((Name, Text) i, (Name, Text) -> Maybe (s :-> x) forall (s :: Symbol) a. FromAttr s a => (Name, Text) -> Maybe a fromAttr @s @(s :-> x) (Name, Text) i)) [(Name, Text)] xs let ts :: [Maybe (s :-> x)] ts = ((Name, Text), Maybe (s :-> x)) -> Maybe (s :-> x) forall a b. (a, b) -> b snd (((Name, Text), Maybe (s :-> x)) -> Maybe (s :-> x)) -> [((Name, Text), Maybe (s :-> x))] -> [Maybe (s :-> x)] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> (((Name, Text), Maybe (s :-> x)) -> Bool) -> [((Name, Text), Maybe (s :-> x))] -> [((Name, Text), Maybe (s :-> x))] forall a. (a -> Bool) -> [a] -> [a] Prelude.filter (Maybe (s :-> x) -> Bool forall a. Maybe a -> Bool isJust (Maybe (s :-> x) -> Bool) -> (((Name, Text), Maybe (s :-> x)) -> Maybe (s :-> x)) -> ((Name, Text), Maybe (s :-> x)) -> Bool forall b c a. (b -> c) -> (a -> b) -> a -> c . ((Name, Text), Maybe (s :-> x)) -> Maybe (s :-> x) forall a b. (a, b) -> b snd) [((Name, Text), Maybe (s :-> x))] as' let rs :: [(Name, Text)] rs = ((Name, Text), Maybe (s :-> x)) -> (Name, Text) forall a b. (a, b) -> a fst (((Name, Text), Maybe (s :-> x)) -> (Name, Text)) -> [((Name, Text), Maybe (s :-> x))] -> [(Name, Text)] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> (((Name, Text), Maybe (s :-> x)) -> Bool) -> [((Name, Text), Maybe (s :-> x))] -> [((Name, Text), Maybe (s :-> x))] forall a. (a -> Bool) -> [a] -> [a] Prelude.filter (Maybe (s :-> x) -> Bool forall a. Maybe a -> Bool isNothing (Maybe (s :-> x) -> Bool) -> (((Name, Text), Maybe (s :-> x)) -> Maybe (s :-> x)) -> ((Name, Text), Maybe (s :-> x)) -> Bool forall b c a. (b -> c) -> (a -> b) -> a -> c . ((Name, Text), Maybe (s :-> x)) -> Maybe (s :-> x) forall a b. (a, b) -> b snd) [((Name, Text), Maybe (s :-> x))] as' let t :: Maybe (s :-> x) t = Maybe (Maybe (s :-> x)) -> Maybe (s :-> x) forall (m :: * -> *) a. Monad m => m (m a) -> m a join (Maybe (Maybe (s :-> x)) -> Maybe (s :-> x)) -> Maybe (Maybe (s :-> x)) -> Maybe (s :-> x) forall a b. (a -> b) -> a -> b $ [Maybe (s :-> x)] -> Maybe (Maybe (s :-> x)) forall a. [a] -> Maybe a listToMaybe [Maybe (s :-> x)] ts Rec Maybe xs xs' <- [(Name, Text)] -> Maybe (Rec Maybe xs) forall a. FromAttrs a => [(Name, Text)] -> Maybe a fromAttrs [(Name, Text)] rs Rec Maybe ((s :-> x) : xs) -> Maybe (Rec Maybe ((s :-> x) : xs)) forall (f :: * -> *) a. Applicative f => a -> f a pure (Rec Maybe ((s :-> x) : xs) -> Maybe (Rec Maybe ((s :-> x) : xs))) -> Rec Maybe ((s :-> x) : xs) -> Maybe (Rec Maybe ((s :-> x) : xs)) forall a b. (a -> b) -> a -> b $ Maybe (s :-> x) t Maybe (s :-> x) -> Rec Maybe xs -> Rec Maybe ((s :-> x) : xs) forall u (a :: u -> *) (r :: u) (rs :: [u]). a r -> Rec a rs -> Rec a (r : rs) :& Rec Maybe xs xs' type FromElement :: Type -> Constraint class FromElement a where fromElement :: Element -> Maybe a type FromElements :: Type -> Constraint class FromElements x where fromElements :: [Element] -> Maybe x instance forall ys. (AllHave '[ToElement] ys, RecApplicative ys) => ToElement (CoRec Identity ys) where toElement :: CoRec Identity ys -> Element toElement (CoVal (Identity r x)) = r -> Element toElement' r x where toElementer :: Rec (Op Element) ys toElementer :: Rec (Op Element) ys toElementer = Proxy '[ToElement] -> (forall (proxy' :: * -> *) a. HasInstances a '[ToElement] => proxy' a -> Op Element a) -> Rec (Op Element) ys forall u (cs :: [u -> Constraint]) (f :: u -> *) (rs :: [u]) (proxy :: [u -> Constraint] -> *). (AllHave cs rs, RecApplicative rs) => proxy cs -> (forall (proxy' :: u -> *) (a :: u). HasInstances a cs => proxy' a -> f a) -> Rec f rs reifyDicts (Proxy '[ToElement] forall k (t :: k). Proxy t Proxy @'[ToElement]) (\proxy' a _ -> (a -> Element) -> Op Element a forall b a. (a -> b) -> Op b a Op a -> Element forall a. ToElement a => a -> Element toElement) toElement' :: r -> Element toElement' = Op Element r -> r -> Element forall b a. Op b a -> a -> b runOp (Rec (Op Element) ys -> Op Element r forall k (r :: k) (rs :: [k]) (f :: k -> *) (record :: (k -> *) -> [k] -> *). (RecElem record r r rs rs (RIndex r rs), RecElemFCtx record f) => record f rs -> f r rget Rec (Op Element) ys toElementer) instance forall ys. (AllHave '[FromElement] ys, RecApplicative ys, FoldRec ys ys, RMap ys) => FromElement (CoRec Identity ys) where fromElement :: Element -> Maybe (CoRec Identity ys) fromElement Element x = Rec Maybe ys -> Maybe (CoRec Identity ys) forall (rs :: [*]). (FoldRec rs rs, RMap rs) => Rec Maybe rs -> Maybe (Field rs) firstField (Rec Maybe ys -> Maybe (CoRec Identity ys)) -> Rec Maybe ys -> Maybe (CoRec Identity ys) forall a b. (a -> b) -> a -> b $ ((Element -> Rec Maybe ys) -> Element -> Rec Maybe ys forall a b. (a -> b) -> a -> b $ Element x) ((Element -> Rec Maybe ys) -> Rec Maybe ys) -> (Element -> Rec Maybe ys) -> Rec Maybe ys forall a b. (a -> b) -> a -> b $ (forall x. (:.) ((->) Element) Maybe x -> Element -> Maybe x) -> Rec ((->) Element :. Maybe) ys -> Element -> Rec Maybe ys forall u (h :: * -> *) (f :: u -> *) (g :: u -> *) (rs :: [u]). Applicative h => (forall (x :: u). f x -> h (g x)) -> Rec f rs -> h (Rec g rs) rtraverse forall x. (:.) ((->) Element) Maybe x -> Element -> Maybe x forall l (f :: l -> *) k (g :: k -> l) (x :: k). Compose f g x -> f (g x) getCompose Rec ((->) Element :. Maybe) ys fromElementer where fromElementer :: Rec ((->) Element :. Maybe ) ys fromElementer :: Rec ((->) Element :. Maybe) ys fromElementer = Proxy '[FromElement] -> (forall (proxy' :: * -> *) a. HasInstances a '[FromElement] => proxy' a -> (:.) ((->) Element) Maybe a) -> Rec ((->) Element :. Maybe) ys forall u (cs :: [u -> Constraint]) (f :: u -> *) (rs :: [u]) (proxy :: [u -> Constraint] -> *). (AllHave cs rs, RecApplicative rs) => proxy cs -> (forall (proxy' :: u -> *) (a :: u). HasInstances a cs => proxy' a -> f a) -> Rec f rs reifyDicts (Proxy '[FromElement] forall k (t :: k). Proxy t Proxy @'[FromElement]) (\proxy' a _ -> (Element -> Maybe a) -> (:.) ((->) Element) Maybe a forall l k (f :: l -> *) (g :: k -> l) (x :: k). f (g x) -> Compose f g x Compose Element -> Maybe a forall a. FromElement a => Element -> Maybe a fromElement) instance ToElement a => ToElements [a] where toElements :: [a] -> [Element] toElements = (a -> Element) -> [a] -> [Element] forall a b. (a -> b) -> [a] -> [b] Prelude.map a -> Element forall a. ToElement a => a -> Element toElement instance FromElement a => FromElements [a] where fromElements :: [Element] -> Maybe [a] fromElements = (Element -> Maybe a) -> [Element] -> Maybe [a] forall (t :: * -> *) (f :: * -> *) a b. (Traversable t, Applicative f) => (a -> f b) -> t a -> f (t b) Prelude.traverse Element -> Maybe a forall a. FromElement a => Element -> Maybe a fromElement instance FromElements (Record '[]) where fromElements :: [Element] -> Maybe (Record '[]) fromElements [] = Record '[] -> Maybe (Record '[]) forall a. a -> Maybe a Just Record '[] forall u (a :: u -> *). Rec a '[] RNil fromElements [Element] _ = Maybe (Record '[]) forall a. Maybe a Nothing instance (FromElement x, FromElements (Record xs)) => FromElements (Record (x ': xs)) where fromElements :: [Element] -> Maybe (Record (x : xs)) fromElements (Element x : [Element] xs) = do x x' <- Element -> Maybe x forall a. FromElement a => Element -> Maybe a fromElement Element x Record xs xs' <- [Element] -> Maybe (Record xs) forall x. FromElements x => [Element] -> Maybe x fromElements [Element] xs Record (x : xs) -> Maybe (Record (x : xs)) forall (f :: * -> *) a. Applicative f => a -> f a pure (Record (x : xs) -> Maybe (Record (x : xs))) -> Record (x : xs) -> Maybe (Record (x : xs)) forall a b. (a -> b) -> a -> b $ x -> Identity x forall a. a -> Identity a Identity x x' Identity x -> Record xs -> Record (x : xs) forall u (a :: u -> *) (r :: u) (rs :: [u]). a r -> Rec a rs -> Rec a (r : rs) :& Record xs xs' fromElements [Element] _ = Maybe (Record (x : xs)) forall a. Maybe a Nothing instance (KnownSymbol s, FromAttrs (Rec Maybe xs), FromElement (CoRec Identity ys)) => FromElement (RecXML s xs ys) where fromElement :: Element -> Maybe (RecXML s xs ys) fromElement (Element Name n Map Name Text xs [Node] ys) = do Bool -> Maybe () forall (f :: * -> *). Alternative f => Bool -> f () guard (Proxy s -> String forall (n :: Symbol) (proxy :: Symbol -> *). KnownSymbol n => proxy n -> String symbolVal (Proxy s forall k (t :: k). Proxy t Proxy @s) String -> String -> Bool forall a. Eq a => a -> a -> Bool == Text -> String T.unpack (Name -> Text nameLocalName Name n)) Rec Maybe xs xs' <- [(Name, Text)] -> Maybe (Rec Maybe xs) forall a. FromAttrs a => [(Name, Text)] -> Maybe a fromAttrs ([(Name, Text)] -> Maybe (Rec Maybe xs)) -> [(Name, Text)] -> Maybe (Rec Maybe xs) forall a b. (a -> b) -> a -> b $ Map Name Text -> [(Name, Text)] forall k a. Map k a -> [(k, a)] Map.toList Map Name Text xs [Element] ts <- [Maybe Element] -> Maybe [Element] forall (t :: * -> *) (m :: * -> *) a. (Traversable t, Monad m) => t (m a) -> m (t a) sequence ([Maybe Element] -> Maybe [Element]) -> [Maybe Element] -> Maybe [Element] forall a b. (a -> b) -> a -> b $ (Maybe Element -> Bool) -> [Maybe Element] -> [Maybe Element] forall a. (a -> Bool) -> [a] -> [a] Prelude.filter Maybe Element -> Bool forall a. Maybe a -> Bool isJust ([Maybe Element] -> [Maybe Element]) -> [Maybe Element] -> [Maybe Element] forall a b. (a -> b) -> a -> b $ (Node -> Maybe Element) -> [Node] -> [Maybe Element] forall a b. (a -> b) -> [a] -> [b] Prelude.map (\case NodeElement Element x' -> Element -> Maybe Element forall a. a -> Maybe a Just Element x' Node _ -> Maybe Element forall a. Maybe a Nothing) [Node] ys [CoRec Identity ys] ys' <- [Element] -> Maybe [CoRec Identity ys] forall x. FromElements x => [Element] -> Maybe x fromElements [Element] ts RecXML s xs ys -> Maybe (RecXML s xs ys) forall (f :: * -> *) a. Applicative f => a -> f a pure (RecXML s xs ys -> Maybe (RecXML s xs ys)) -> RecXML s xs ys -> Maybe (RecXML s xs ys) forall a b. (a -> b) -> a -> b $ Rec Maybe xs -> [CoRec Identity ys] -> RecXML s xs ys forall (xs :: [*]) (ys :: [*]) (s :: Symbol). Rec Maybe xs -> [Field ys] -> RecXML s xs ys RNode Rec Maybe xs xs' [CoRec Identity ys] ys'