module Nix.XML ( toXML ) where import Nix.Prelude import qualified Data.HashMap.Lazy as M import Nix.Atoms import Nix.Expr.Types import Nix.String import Nix.Value import Text.XML.Light ( Element(Element) , Attr(Attr) , Content(Elem) , unqual , ppElement ) toXML :: forall t f m . MonadDataContext f m => NValue t f m -> NixString toXML :: NValue t f m -> NixString toXML = WithStringContextT Identity Text -> NixString runWithStringContext (WithStringContextT Identity Text -> NixString) -> (NValue t f m -> WithStringContextT Identity Text) -> NValue t f m -> NixString forall b c a. (b -> c) -> (a -> b) -> a -> c . (Element -> Text) -> WithStringContextT Identity Element -> WithStringContextT Identity Text forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap Element -> Text pp (WithStringContextT Identity Element -> WithStringContextT Identity Text) -> (NValue t f m -> WithStringContextT Identity Element) -> NValue t f m -> WithStringContextT Identity Text forall b c a. (b -> c) -> (a -> b) -> a -> c . WithStringContextT Identity Element -> (NValue' t f m (WithStringContextT Identity Element) -> WithStringContextT Identity Element) -> NValue t f m -> WithStringContextT Identity Element forall (f :: * -> *) (m :: * -> *) r t. MonadDataContext f m => r -> (NValue' t f m r -> r) -> NValue t f m -> r iterNValueByDiscardWith WithStringContextT Identity Element cyc NValue' t f m (WithStringContextT Identity Element) -> WithStringContextT Identity Element phi where cyc :: WithStringContextT Identity Element cyc = Element -> WithStringContextT Identity Element forall (f :: * -> *) a. Applicative f => a -> f a pure (Element -> WithStringContextT Identity Element) -> Element -> WithStringContextT Identity Element forall a b. (a -> b) -> a -> b $ Text -> Text -> Element mkEVal Text "string" Text "<expr>" pp :: Element -> Text pp :: Element -> Text pp Element e = Text heading Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> String -> Text forall a. IsString a => String -> a fromString (Element -> String ppElement (Element -> String) -> Element -> String forall a b. (a -> b) -> a -> b $ Text -> [Content] -> Element mkE Text "expr" (OneItem [Content] -> [Content] forall x. One x => OneItem x -> x one (OneItem [Content] -> [Content]) -> OneItem [Content] -> [Content] forall a b. (a -> b) -> a -> b $ Element -> Content Elem Element e) ) Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "\n" where heading :: Text heading = Text "<?xml version='1.0' encoding='utf-8'?>\n" phi :: NValue' t f m (WithStringContext Element) -> WithStringContext Element phi :: NValue' t f m (WithStringContextT Identity Element) -> WithStringContextT Identity Element phi = \case NVConstant' NAtom a -> Element -> WithStringContextT Identity Element forall (f :: * -> *) a. Applicative f => a -> f a pure (Element -> WithStringContextT Identity Element) -> Element -> WithStringContextT Identity Element forall a b. (a -> b) -> a -> b $ case NAtom a of NURI Text t -> Text -> Text -> Element mkEVal Text "string" Text t NInt Integer n -> Text -> Text -> Element mkEVal Text "int" (Text -> Element) -> Text -> Element forall a b. (a -> b) -> a -> b $ Integer -> Text forall b a. (Show a, IsString b) => a -> b show Integer n NFloat Float f -> Text -> Text -> Element mkEVal Text "float" (Text -> Element) -> Text -> Element forall a b. (a -> b) -> a -> b $ Float -> Text forall b a. (Show a, IsString b) => a -> b show Float f NBool Bool b -> Text -> Text -> Element mkEVal Text "bool" (Text -> Element) -> Text -> Element forall a b. (a -> b) -> a -> b $ if Bool b then Text "true" else Text "false" NAtom NNull -> Text -> [Content] -> Element mkE Text "null" [Content] forall a. Monoid a => a mempty NVStr' NixString str -> Text -> Text -> Element mkEVal Text "string" (Text -> Element) -> WithStringContextT Identity Text -> WithStringContextT Identity Element forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> NixString -> WithStringContextT Identity Text forall (m :: * -> *). Monad m => NixString -> WithStringContextT m Text extractNixString NixString str NVList' [WithStringContextT Identity Element] l -> Text -> [Content] -> Element mkE Text "list" ([Content] -> Element) -> ([Element] -> [Content]) -> [Element] -> Element forall b c a. (b -> c) -> (a -> b) -> a -> c . (Element -> Content) -> [Element] -> [Content] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap Element -> Content Elem ([Element] -> Element) -> WithStringContextT Identity [Element] -> WithStringContextT Identity Element forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> [WithStringContextT Identity Element] -> WithStringContextT Identity [Element] forall (t :: * -> *) (f :: * -> *) a. (Traversable t, Applicative f) => t (f a) -> f (t a) sequenceA [WithStringContextT Identity Element] l NVSet' PositionSet _ AttrSet (WithStringContextT Identity Element) s -> Text -> [Content] -> Element mkE Text "attrs" ([Content] -> Element) -> (HashMap VarName Element -> [Content]) -> HashMap VarName Element -> Element forall b c a. (b -> c) -> (a -> b) -> a -> c . ((VarName, Element) -> Content) -> [(VarName, Element)] -> [Content] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap (VarName, Element) -> Content mkElem' ([(VarName, Element)] -> [Content]) -> (HashMap VarName Element -> [(VarName, Element)]) -> HashMap VarName Element -> [Content] forall b c a. (b -> c) -> (a -> b) -> a -> c . ((VarName, Element) -> VarName) -> [(VarName, Element)] -> [(VarName, Element)] forall b a. Ord b => (a -> b) -> [a] -> [a] sortWith (VarName, Element) -> VarName forall a b. (a, b) -> a fst ([(VarName, Element)] -> [(VarName, Element)]) -> (HashMap VarName Element -> [(VarName, Element)]) -> HashMap VarName Element -> [(VarName, Element)] forall b c a. (b -> c) -> (a -> b) -> a -> c . HashMap VarName Element -> [(VarName, Element)] forall k v. HashMap k v -> [(k, v)] M.toList (HashMap VarName Element -> Element) -> WithStringContextT Identity (HashMap VarName Element) -> WithStringContextT Identity Element forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> AttrSet (WithStringContextT Identity Element) -> WithStringContextT Identity (HashMap VarName Element) forall (t :: * -> *) (f :: * -> *) a. (Traversable t, Applicative f) => t (f a) -> f (t a) sequenceA AttrSet (WithStringContextT Identity Element) s where mkElem' :: (VarName, Element) -> Content mkElem' :: (VarName, Element) -> Content mkElem' (VarName k, Element v) = Element -> Content Elem (Element -> Content) -> Element -> Content forall a b. (a -> b) -> a -> b $ QName -> [Attr] -> [Content] -> Maybe Integer -> Element Element (String -> QName unqual String "attr") (OneItem [Attr] -> [Attr] forall x. One x => OneItem x -> x one (OneItem [Attr] -> [Attr]) -> OneItem [Attr] -> [Attr] forall a b. (a -> b) -> a -> b $ QName -> String -> Attr Attr (String -> QName unqual String "name") (String -> Attr) -> String -> Attr forall a b. (a -> b) -> a -> b $ VarName -> String forall a. ToString a => a -> String toString VarName k) (OneItem [Content] -> [Content] forall x. One x => OneItem x -> x one (OneItem [Content] -> [Content]) -> OneItem [Content] -> [Content] forall a b. (a -> b) -> a -> b $ Element -> Content Elem Element v) Maybe Integer forall a. Maybe a Nothing NVClosure' Params () p NValue t f m -> m (WithStringContextT Identity Element) _ -> Element -> WithStringContextT Identity Element forall (f :: * -> *) a. Applicative f => a -> f a pure (Element -> WithStringContextT Identity Element) -> Element -> WithStringContextT Identity Element forall a b. (a -> b) -> a -> b $ Text -> [Content] -> Element mkE Text "function" (Params () -> [Content] forall r. Params r -> [Content] paramsXML Params () p) NVPath' Path fp -> Element -> WithStringContextT Identity Element forall (f :: * -> *) a. Applicative f => a -> f a pure (Element -> WithStringContextT Identity Element) -> Element -> WithStringContextT Identity Element forall a b. (a -> b) -> a -> b $ Text -> Text -> Element mkEVal Text "path" (Text -> Element) -> Text -> Element forall a b. (a -> b) -> a -> b $ String -> Text forall a. IsString a => String -> a fromString (String -> Text) -> String -> Text forall a b. (a -> b) -> a -> b $ Path -> String coerce Path fp NVBuiltin' VarName name NValue t f m -> m (WithStringContextT Identity Element) _ -> Element -> WithStringContextT Identity Element forall (f :: * -> *) a. Applicative f => a -> f a pure (Element -> WithStringContextT Identity Element) -> Element -> WithStringContextT Identity Element forall a b. (a -> b) -> a -> b $ Text -> VarName -> Element mkEName Text "function" VarName name mkE :: Text -> [Content] -> Element mkE :: Text -> [Content] -> Element mkE (Text -> String forall a. ToString a => a -> String toString -> String n) [Content] c = QName -> [Attr] -> [Content] -> Maybe Integer -> Element Element (String -> QName unqual String n) [Attr] forall a. Monoid a => a mempty [Content] c Maybe Integer forall a. Maybe a Nothing mkElem :: Text -> Text -> Text -> Element mkElem :: Text -> Text -> Text -> Element mkElem (Text -> String forall a. ToString a => a -> String toString -> String n) (Text -> String forall a. ToString a => a -> String toString -> String a) (Text -> String forall a. ToString a => a -> String toString -> String v) = QName -> [Attr] -> [Content] -> Maybe Integer -> Element Element (String -> QName unqual String n) (OneItem [Attr] -> [Attr] forall x. One x => OneItem x -> x one (OneItem [Attr] -> [Attr]) -> OneItem [Attr] -> [Attr] forall a b. (a -> b) -> a -> b $ QName -> String -> Attr Attr (String -> QName unqual String a) String v) [Content] forall a. Monoid a => a mempty Maybe Integer forall a. Maybe a Nothing mkEVal :: Text -> Text -> Element mkEVal :: Text -> Text -> Element mkEVal = (Text -> Text -> Text -> Element `mkElem` Text "value") mkEName :: Text -> VarName -> Element mkEName :: Text -> VarName -> Element mkEName Text x (VarName -> Text coerce -> Text y) = (Text -> Text -> Text -> Element `mkElem` Text "name") Text x Text y paramsXML :: Params r -> [Content] paramsXML :: Params r -> [Content] paramsXML (Param VarName name) = OneItem [Content] -> [Content] forall x. One x => OneItem x -> x one (OneItem [Content] -> [Content]) -> OneItem [Content] -> [Content] forall a b. (a -> b) -> a -> b $ Element -> Content Elem (Element -> Content) -> Element -> Content forall a b. (a -> b) -> a -> b $ Text -> VarName -> Element mkEName Text "varpat" VarName name paramsXML (ParamSet Maybe VarName mname Variadic variadic ParamSet r pset) = OneItem [Content] -> [Content] forall x. One x => OneItem x -> x one (OneItem [Content] -> [Content]) -> OneItem [Content] -> [Content] forall a b. (a -> b) -> a -> b $ Element -> Content Elem (Element -> Content) -> Element -> Content forall a b. (a -> b) -> a -> b $ QName -> [Attr] -> [Content] -> Maybe Integer -> Element Element (String -> QName unqual String "attrspat") ([Attr] battr [Attr] -> [Attr] -> [Attr] forall a. Semigroup a => a -> a -> a <> [Attr] nattr) (ParamSet r -> [Content] forall r. ParamSet r -> [Content] paramSetXML ParamSet r pset) Maybe Integer forall a. Maybe a Nothing where battr :: [Attr] battr = OneItem [Attr] -> [Attr] forall x. One x => OneItem x -> x one (QName -> String -> Attr Attr (String -> QName unqual String "ellipsis") String "1") [Attr] -> Bool -> [Attr] forall a. Monoid a => a -> Bool -> a `whenTrue` (Variadic variadic Variadic -> Variadic -> Bool forall a. Eq a => a -> a -> Bool == Variadic Variadic) nattr :: [Attr] nattr = (Attr -> [Attr] forall x. One x => OneItem x -> x one (Attr -> [Attr]) -> (VarName -> Attr) -> VarName -> [Attr] forall b c a. (b -> c) -> (a -> b) -> a -> c . QName -> String -> Attr Attr (String -> QName unqual String "name") (String -> Attr) -> (VarName -> String) -> VarName -> Attr forall b c a. (b -> c) -> (a -> b) -> a -> c . VarName -> String forall a. ToString a => a -> String toString) (VarName -> [Attr]) -> Maybe VarName -> [Attr] forall b a. Monoid b => (a -> b) -> Maybe a -> b `whenJust` Maybe VarName mname paramSetXML :: ParamSet r -> [Content] paramSetXML :: ParamSet r -> [Content] paramSetXML = ((VarName, Maybe r) -> Content) -> ParamSet r -> [Content] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap (Element -> Content Elem (Element -> Content) -> ((VarName, Maybe r) -> Element) -> (VarName, Maybe r) -> Content forall b c a. (b -> c) -> (a -> b) -> a -> c . Text -> VarName -> Element mkEName Text "attr" (VarName -> Element) -> ((VarName, Maybe r) -> VarName) -> (VarName, Maybe r) -> Element forall b c a. (b -> c) -> (a -> b) -> a -> c . (VarName, Maybe r) -> VarName forall a b. (a, b) -> a fst)