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 :: forall t (f :: * -> *) (m :: * -> *).
MonadDataContext f m =>
NValue t f m -> NixString
toXML = WithStringContextT Identity Text -> NixString
runWithStringContext forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Element -> Text
pp forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (f :: * -> *) a. Applicative f => a -> f a
pure 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
    forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => String -> a
fromString
        (Element -> String
ppElement forall a b. (a -> b) -> a -> b
$
          Text -> [Content] -> Element
mkE
            Text
"expr"
            (forall x. One x => OneItem x -> x
one forall a b. (a -> b) -> a -> b
$ Element -> Content
Elem Element
e)
        )
    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 ->
      forall (f :: * -> *) a. Applicative f => a -> f a
pure 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"    forall a b. (a -> b) -> a -> b
$ forall b a. (Show a, IsString b) => a -> b
show Integer
n
          NFloat Float
f -> Text -> Text -> Element
mkEVal Text
"float"  forall a b. (a -> b) -> a -> b
$ forall b a. (Show a, IsString b) => a -> b
show Float
f
          NBool  Bool
b -> Text -> Text -> Element
mkEVal Text
"bool"   forall a b. (a -> b) -> a -> b
$ if Bool
b then Text
"true" else Text
"false"
          NAtom
NNull    -> Text -> [Content] -> Element
mkE    Text
"null"     forall a. Monoid a => a
mempty

    NVStr' NixString
str ->
      Text -> Text -> Element
mkEVal Text
"string" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
Monad m =>
NixString -> WithStringContextT m Text
extractNixString NixString
str
    NVList' [WithStringContextT Identity Element]
l ->
      Text -> [Content] -> Element
mkE Text
"list" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Element -> Content
Elem forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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"
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
            (VarName, Element) -> Content
mkElem'
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. Ord b => (a -> b) -> [a] -> [a]
sortWith forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. HashMap k v -> [(k, v)]
M.toList
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 forall a b. (a -> b) -> a -> b
$
          QName -> [Attr] -> [Content] -> Maybe Integer -> Element
Element
            (String -> QName
unqual String
"attr")
            (forall x. One x => OneItem x -> x
one forall a b. (a -> b) -> a -> b
$ QName -> String -> Attr
Attr (String -> QName
unqual String
"name") forall a b. (a -> b) -> a -> b
$ forall a. ToString a => a -> String
toString VarName
k)
            (forall x. One x => OneItem x -> x
one forall a b. (a -> b) -> a -> b
$ Element -> Content
Elem Element
v)
            forall a. Maybe a
Nothing

    NVClosure' Params ()
p NValue t f m -> m (WithStringContextT Identity Element)
_ ->
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
        Text -> [Content] -> Element
mkE
          Text
"function"
          (forall r. Params r -> [Content]
paramsXML Params ()
p)
    NVPath' Path
fp        -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> Text -> Element
mkEVal Text
"path" forall a b. (a -> b) -> a -> b
$ forall a. IsString a => String -> a
fromString forall a b. (a -> b) -> a -> b
$ coerce :: forall a b. Coercible a b => a -> b
coerce Path
fp
    NVBuiltin' VarName
name NValue t f m -> m (WithStringContextT Identity Element)
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> VarName -> Element
mkEName Text
"function" VarName
name

mkE :: Text -> [Content] -> Element
mkE :: Text -> [Content] -> Element
mkE (forall a. ToString a => a -> String
toString -> String
n) [Content]
c =
  QName -> [Attr] -> [Content] -> Maybe Integer -> Element
Element
    (String -> QName
unqual String
n)
    forall a. Monoid a => a
mempty
    [Content]
c
    forall a. Maybe a
Nothing

mkElem :: Text -> Text -> Text -> Element
mkElem :: Text -> Text -> Text -> Element
mkElem (forall a. ToString a => a -> String
toString -> String
n) (forall a. ToString a => a -> String
toString -> String
a) (forall a. ToString a => a -> String
toString -> String
v) =
  QName -> [Attr] -> [Content] -> Maybe Integer -> Element
Element
    (String -> QName
unqual String
n)
    (forall x. One x => OneItem x -> x
one forall a b. (a -> b) -> a -> b
$ QName -> String -> Attr
Attr (String -> QName
unqual String
a) String
v)
    forall a. Monoid a => a
mempty
    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 (coerce :: forall a b. Coercible a b => a -> b
coerce -> Text
y) = (Text -> Text -> Text -> Element
`mkElem` Text
"name") Text
x Text
y

paramsXML :: Params r -> [Content]
paramsXML :: forall r. Params r -> [Content]
paramsXML (Param VarName
name) = forall x. One x => OneItem x -> x
one forall a b. (a -> b) -> a -> b
$ Element -> Content
Elem 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) =
  forall x. One x => OneItem x -> x
one forall a b. (a -> b) -> a -> b
$ Element -> Content
Elem forall a b. (a -> b) -> a -> b
$ QName -> [Attr] -> [Content] -> Maybe Integer -> Element
Element (String -> QName
unqual String
"attrspat") ([Attr]
battr forall a. Semigroup a => a -> a -> a
<> [Attr]
nattr) (forall r. ParamSet r -> [Content]
paramSetXML ParamSet r
pset) forall a. Maybe a
Nothing
 where
  battr :: [Attr]
battr =
    forall x. One x => OneItem x -> x
one (QName -> String -> Attr
Attr (String -> QName
unqual String
"ellipsis") String
"1") forall a. Monoid a => a -> Bool -> a
`whenTrue` (Variadic
variadic forall a. Eq a => a -> a -> Bool
== Variadic
Variadic)
  nattr :: [Attr]
nattr =
    (forall x. One x => OneItem x -> x
one forall b c a. (b -> c) -> (a -> b) -> a -> c
. QName -> String -> Attr
Attr (String -> QName
unqual String
"name") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToString a => a -> String
toString) forall b a. Monoid b => (a -> b) -> Maybe a -> b
`whenJust` Maybe VarName
mname

paramSetXML :: ParamSet r -> [Content]
paramSetXML :: forall r. ParamSet r -> [Content]
paramSetXML = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Element -> Content
Elem forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> VarName -> Element
mkEName Text
"attr" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)