{-# LANGUAGE ScopedTypeVariables #-} module Nix.XML ( toXML ) where 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) -> Free (NValue' t f m) t -> 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 $ String -> String -> Element mkEVal String "string" String "<expr>" pp :: Element -> Text pp Element e = Text heading Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> String -> Text forall a. ToText a => a -> Text toText (Element -> String ppElement (Element -> String) -> Element -> String forall a b. (a -> b) -> a -> b $ String -> [Content] -> Element mkE String "expr" [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 -> String -> String -> Element mkEVal String "string" (String -> Element) -> String -> Element forall a b. (a -> b) -> a -> b $ Text -> String forall a. ToString a => a -> String toString Text t NInt Integer n -> String -> String -> Element mkEVal String "int" (String -> Element) -> String -> Element forall a b. (a -> b) -> a -> b $ Integer -> String forall b a. (Show a, IsString b) => a -> b show Integer n NFloat Float f -> String -> String -> Element mkEVal String "float" (String -> Element) -> String -> Element forall a b. (a -> b) -> a -> b $ Float -> String forall b a. (Show a, IsString b) => a -> b show Float f NBool Bool b -> String -> String -> Element mkEVal String "bool" (String -> Element) -> String -> Element forall a b. (a -> b) -> a -> b $ if Bool b then String "true" else String "false" NAtom NNull -> String -> [Content] -> Element mkE String "null" [Content] forall a. Monoid a => a mempty NVStr' NixString str -> String -> String -> Element mkEVal String "string" (String -> Element) -> (Text -> String) -> Text -> Element forall b c a. (b -> c) -> (a -> b) -> a -> c . Text -> String forall a. ToString a => a -> String toString (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 -> do [Element] els <- [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 pure $ String -> [Content] -> Element mkE String "list" (Element -> Content Elem (Element -> Content) -> [Element] -> [Content] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> [Element] els) NVSet' AttrSet (WithStringContextT Identity Element) s AttrSet SourcePos _ -> do HashMap Text Element kvs <- 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 pure $ String -> [Content] -> Element mkE String "attrs" ((\ (Text 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") [QName -> String -> Attr Attr (String -> QName unqual String "name") (Text -> String forall a. ToString a => a -> String toString Text k)] [Element -> Content Elem Element v] Maybe Integer forall a. Maybe a Nothing ) ((Text, Element) -> Content) -> [(Text, Element)] -> [Content] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> ((Text, Element) -> Text) -> [(Text, Element)] -> [(Text, Element)] forall b a. Ord b => (a -> b) -> [a] -> [a] sortWith (Text, Element) -> Text forall a b. (a, b) -> a fst (HashMap Text Element -> [(Text, Element)] forall k v. HashMap k v -> [(k, v)] M.toList HashMap Text Element kvs) ) 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 $ String -> [Content] -> Element mkE String "function" (Params () -> [Content] forall r. Params r -> [Content] paramsXML Params () p) 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 -> Element mkEVal String "path" String fp NVBuiltin' Text 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 -> Element mkEName String "function" (String -> Element) -> String -> Element forall a b. (a -> b) -> a -> b $ Text -> String forall a. ToString a => a -> String toString Text name mkE :: String -> [Content] -> Element mkE :: String -> [Content] -> Element mkE 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 :: String -> String -> String -> Element mkElem :: String -> String -> String -> Element mkElem String n String a String v = QName -> [Attr] -> [Content] -> Maybe Integer -> Element Element (String -> QName unqual String n) [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 :: String -> String -> Element mkEVal :: String -> String -> Element mkEVal = (String -> String -> String -> Element `mkElem` String "value") mkEName :: String -> String -> Element mkEName :: String -> String -> Element mkEName = (String -> String -> String -> Element `mkElem` String "name") 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 -> Element mkEName String "varpat" (Text -> String forall a. ToString a => a -> String toString 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 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 s) Maybe Integer 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] forall a. Monoid a => a mempty ((Attr -> [Attr] -> [Attr] forall a. a -> [a] -> [a] : [Attr] forall a. Monoid a => a mempty) (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 forall a. ToString a => a -> String toString) Maybe Text mname paramSetXML :: ParamSet r -> [Content] paramSetXML :: ParamSet r -> [Content] paramSetXML = ((Text, Maybe r) -> Content) -> ParamSet r -> [Content] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap (\(Text k, Maybe r _) -> Element -> Content Elem (Element -> Content) -> Element -> Content forall a b. (a -> b) -> a -> b $ String -> String -> Element mkEName String "attr" (Text -> String forall a. ToString a => a -> String toString Text k))