picnoir/hnix
1
0
Fork 0
Code Issues Pull requests Releases Wiki Activity

Accumulate string context in builtins.toXML

Browse source
This commit is contained in:
Ken Micklas 2018-11-23 12:47:56 -05:00
parent dcbde8c2d5
commit b1d48c5364
2 changed files with 29 additions and 24 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
src/Nix/Builtins.hs
View file

@ -980,8 +980,7 @@ fromJSON = fromValue >=> \encoded ->
Right v -> toValue v
toXML_ :: MonadNix e m => m (NValue m) -> m (NValue m)
toXML_ v = v >>= normalForm >>= \x ->
pure $ nvStr $ hackyMakeNixStringWithoutContext $ Text.pack (toXML x)
toXML_ v = v >>= normalForm >>= pure . nvStr . toXML
typeOf :: MonadNix e m => m (NValue m) -> m (NValue m)
typeOf v = v >>= toNix @Text . \case

50
src/Nix/XML.hs
View file

@ -1,6 +1,9 @@
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Nix.XML where
module Nix.XML (toXML) where
import Control.Monad.Free
import qualified Data.HashMap.Lazy as M
@ -13,38 +16,41 @@ import Nix.String
import Nix.Value
import Text.XML.Light
toXML :: Functor m => NValueNF m -> String
toXML = ("<?xml version='1.0' encoding='utf-8'?>\n" ++)
. (++ "\n")
toXML :: Functor m => NValueNF m -> NixString
toXML = runWithStringContext . fmap pp . iterM phi . check
where
pp = ("<?xml version='1.0' encoding='utf-8'?>\n" <>)
. (<> "\n")
. Text.pack
. ppElement
. (\e -> Element (unqual "expr") [] [Elem e] Nothing)
. iter phi
. check
where
check :: NValueNF m -> Free (NValueF m) Element
check = fmap (const (mkElem "cycle" "value" ""))
phi :: NValueF m Element -> Element
check :: NValueNF f -> Free (NValueF f) Element
check = fmap $ const $ mkElem "cycle" "value" ""
phi :: NValueF f (WithStringContext Element) -> WithStringContext Element
phi = \case
NVConstantF a -> case a of
NInt n -> mkElem "int" "value" (show n)
NFloat f -> mkElem "float" "value" (show f)
NBool b -> mkElem "bool" "value" (if b then "true" else "false")
NNull -> Element (unqual "null") [] [] Nothing
NInt n -> return $ mkElem "int" "value" (show n)
NFloat f -> return $ mkElem "float" "value" (show f)
NBool b -> return $ mkElem "bool" "value" (if b then "true" else "false")
NNull -> return $ Element (unqual "null") [] [] Nothing
NVStrF ns -> mkElem "string" "value" (Text.unpack $ hackyStringIgnoreContext ns)
NVListF l -> Element (unqual "list") [] (Elem <$> l) Nothing
NVStrF str -> mkElem "string" "value" . Text.unpack <$> extractNixString str
NVListF l -> sequence l >>= \els ->
return $ Element (unqual "list") [] (Elem <$> els) Nothing
NVSetF s _ -> Element (unqual "attrs") []
NVSetF s _ -> sequence s >>= \kvs ->
return $ Element (unqual "attrs") []
(map (\(k, v) ->
Elem (Element (unqual "attr")
[Attr (unqual "name") (Text.unpack k)]
[Elem v] Nothing))
(sortBy (comparing fst) $ M.toList s)) Nothing
(sortBy (comparing fst) $ M.toList kvs)) Nothing
NVClosureF p _ -> Element (unqual "function") [] (paramsXML p) Nothing
NVPathF fp -> mkElem "path" "value" fp
NVBuiltinF name _ -> mkElem "function" "name" name
NVClosureF p _ -> return $ Element (unqual "function") [] (paramsXML p) Nothing
NVPathF fp -> return $ mkElem "path" "value" fp
NVBuiltinF name _ -> return $ mkElem "function" "name" name
mkElem :: String -> String -> String -> Element
mkElem n a v = Element (unqual n) [Attr (unqual a) v] [] Nothing
@ -53,7 +59,7 @@ paramsXML :: Params r -> [Content]
paramsXML (Param name) =
[Elem $ mkElem "varpat" "name" (Text.unpack name)]
paramsXML (ParamSet s b mname) =
[Elem $ Element (unqual "attrspat") (battr ++ nattr) (paramSetXML s) Nothing]
[Elem $ Element (unqual "attrspat") (battr <> nattr) (paramSetXML s) Nothing]
where
battr = [ Attr (unqual "ellipsis") "1" | b ]
nattr = maybe [] ((:[]) . Attr (unqual "name") . Text.unpack) mname