{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} module Nix.XML (toXML) where import qualified Data.HashMap.Lazy as M import Data.List import Data.Ord import qualified Data.Text as Text import Nix.Atoms import Nix.Expr.Types import Nix.String import Nix.Value import Text.XML.Light 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 . (t -> (NValue t f m -> WithStringContextT Identity Element) -> WithStringContextT Identity Element) -> (NValue' t f m (WithStringContextT Identity Element) -> WithStringContextT Identity Element) -> NValue t f m -> WithStringContextT Identity Element forall t (f :: * -> *) (m :: * -> *) r. MonadDataContext f m => (t -> (NValue t f m -> r) -> r) -> (NValue' t f m r -> r) -> NValue t f m -> r iterNValue (\t _ NValue t f m -> WithStringContextT Identity Element _ -> 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 $ String -> String -> String -> Element mkElem String "string" String "value" String "<CYCLE>" pp :: Element -> Text pp = (Text "<?xml version='1.0' encoding='utf-8'?>\n" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <>) (Text -> Text) -> (Element -> Text) -> Element -> Text forall b c a. (b -> c) -> (a -> b) -> a -> c . (Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "\n") (Text -> Text) -> (Element -> Text) -> Element -> Text forall b c a. (b -> c) -> (a -> b) -> a -> c . String -> Text Text.pack (String -> Text) -> (Element -> String) -> Element -> Text forall b c a. (b -> c) -> (a -> b) -> a -> c . Element -> String ppElement (Element -> String) -> (Element -> Element) -> Element -> String forall b c a. (b -> c) -> (a -> b) -> a -> c . (\Element e -> QName -> [Attr] -> [Content] -> Maybe Line -> Element Element (String -> QName unqual String "expr") [] [Element -> Content Elem Element e] Maybe Line forall a. Maybe a Nothing) 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 -> case NAtom a of NURI Text t -> 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 $ String -> String -> String -> Element mkElem String "string" String "value" (Text -> String Text.unpack Text t) NInt Line n -> 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 $ String -> String -> String -> Element mkElem String "int" String "value" (Line -> String forall a. Show a => a -> String show Line n) NFloat Float f -> 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 $ String -> String -> String -> Element mkElem String "float" String "value" (Float -> String forall a. Show a => a -> String show Float f) NBool Bool b -> 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 $ String -> String -> String -> Element mkElem String "bool" String "value" (if Bool b then String "true" else String "false") NAtom NNull -> 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 $ QName -> [Attr] -> [Content] -> Maybe Line -> Element Element (String -> QName unqual String "null") [] [] Maybe Line forall a. Maybe a Nothing NVStr' NixString str -> String -> String -> String -> Element mkElem String "string" String "value" (String -> Element) -> (Text -> String) -> Text -> Element forall b c a. (b -> c) -> (a -> b) -> a -> c . Text -> String Text.unpack (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 -> [WithStringContextT Identity Element] -> WithStringContextT Identity [Element] forall (t :: * -> *) (m :: * -> *) a. (Traversable t, Monad m) => t (m a) -> m (t a) sequence [WithStringContextT Identity Element] l WithStringContextT Identity [Element] -> ([Element] -> WithStringContextT Identity Element) -> WithStringContextT Identity Element forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= \[Element] els -> 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 $ QName -> [Attr] -> [Content] -> Maybe Line -> Element Element (String -> QName unqual String "list") [] (Element -> Content Elem (Element -> Content) -> [Element] -> [Content] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> [Element] els) Maybe Line forall a. Maybe a Nothing NVSet' AttrSet (WithStringContextT Identity Element) s AttrSet SourcePos _ -> AttrSet (WithStringContextT Identity Element) -> WithStringContextT Identity (HashMap Text Element) forall (t :: * -> *) (m :: * -> *) a. (Traversable t, Monad m) => t (m a) -> m (t a) sequence AttrSet (WithStringContextT Identity Element) s WithStringContextT Identity (HashMap Text Element) -> (HashMap Text Element -> WithStringContextT Identity Element) -> WithStringContextT Identity Element forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= \HashMap Text Element kvs -> 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 $ QName -> [Attr] -> [Content] -> Maybe Line -> Element Element (String -> QName unqual String "attrs") [] (((Text, Element) -> Content) -> [(Text, Element)] -> [Content] forall a b. (a -> b) -> [a] -> [b] map (\(Text k, Element v) -> Element -> Content Elem (QName -> [Attr] -> [Content] -> Maybe Line -> Element Element (String -> QName unqual String "attr") [QName -> String -> Attr Attr (String -> QName unqual String "name") (Text -> String Text.unpack Text k)] [Element -> Content Elem Element v] Maybe Line forall a. Maybe a Nothing ) ) (((Text, Element) -> (Text, Element) -> Ordering) -> [(Text, Element)] -> [(Text, Element)] forall a. (a -> a -> Ordering) -> [a] -> [a] sortBy (((Text, Element) -> Text) -> (Text, Element) -> (Text, Element) -> Ordering forall a b. Ord a => (b -> a) -> b -> b -> Ordering comparing (Text, Element) -> Text forall a b. (a, b) -> a fst) ([(Text, Element)] -> [(Text, Element)]) -> [(Text, Element)] -> [(Text, Element)] forall a b. (a -> b) -> a -> b $ HashMap Text Element -> [(Text, Element)] forall k v. HashMap k v -> [(k, v)] M.toList HashMap Text Element kvs) ) Maybe Line 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 $ QName -> [Attr] -> [Content] -> Maybe Line -> Element Element (String -> QName unqual String "function") [] (Params () -> [Content] forall r. Params r -> [Content] paramsXML Params () p) Maybe Line forall a. Maybe a Nothing NVPath' String 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 $ String -> String -> String -> Element mkElem String "path" String "value" String fp NVBuiltin' String 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 $ String -> String -> String -> Element mkElem String "function" String "name" String name NValue' t f m (WithStringContextT Identity Element) _ -> String -> WithStringContextT Identity Element forall a. HasCallStack => String -> a error String "Pattern synonyms mask coverage" mkElem :: String -> String -> String -> Element mkElem :: String -> String -> String -> Element mkElem String n String a String v = QName -> [Attr] -> [Content] -> Maybe Line -> Element Element (String -> QName unqual String n) [QName -> String -> Attr Attr (String -> QName unqual String a) String v] [] Maybe Line forall a. Maybe a Nothing paramsXML :: Params r -> [Content] paramsXML :: Params r -> [Content] paramsXML (Param Text name) = [Element -> Content Elem (Element -> Content) -> Element -> Content forall a b. (a -> b) -> a -> b $ String -> String -> String -> Element mkElem String "varpat" String "name" (Text -> String Text.unpack Text name)] paramsXML (ParamSet ParamSet r s Bool b Maybe Text mname) = [Element -> Content Elem (Element -> Content) -> Element -> Content forall a b. (a -> b) -> a -> b $ QName -> [Attr] -> [Content] -> Maybe Line -> 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 s) Maybe Line forall a. Maybe a Nothing] where battr :: [Attr] battr = [ QName -> String -> Attr Attr (String -> QName unqual String "ellipsis") String "1" | Bool b ] nattr :: [Attr] nattr = [Attr] -> (Text -> [Attr]) -> Maybe Text -> [Attr] forall b a. b -> (a -> b) -> Maybe a -> b maybe [] ((Attr -> [Attr] -> [Attr] forall a. a -> [a] -> [a] : []) (Attr -> [Attr]) -> (Text -> Attr) -> Text -> [Attr] forall b c a. (b -> c) -> (a -> b) -> a -> c . QName -> String -> Attr Attr (String -> QName unqual String "name") (String -> Attr) -> (Text -> String) -> Text -> Attr forall b c a. (b -> c) -> (a -> b) -> a -> c . Text -> String Text.unpack) Maybe Text mname paramSetXML :: ParamSet r -> [Content] paramSetXML :: ParamSet r -> [Content] paramSetXML = ((Text, Maybe r) -> Content) -> ParamSet r -> [Content] forall a b. (a -> b) -> [a] -> [b] map (\(Text k, Maybe r _) -> Element -> Content Elem (Element -> Content) -> Element -> Content forall a b. (a -> b) -> a -> b $ String -> String -> String -> Element mkElem String "attr" String "name" (Text -> String Text.unpack Text k))