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

Run brittany

This commit is contained in:
John Wiegley 2019-03-18 21:47:43 -07:00
parent 9b046a80c7
commit d1ada44817
No known key found for this signature in database
GPG Key ID: C144D8F4F19FE630
16 changed files with 144 additions and 139 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
main/Main.hs
View File

@ -158,18 +158,16 @@ main = do
findAttrs = go ""
where
go prefix s = do
xs <-
forM (sortOn fst (M.toList s))
$ \(k, nv) -> case nv of
Free v -> pure (k, Just (Free v))
Pure (StdThunk (extract -> Thunk _ _ ref)) -> do
let path = prefix ++ Text.unpack k
(_, descend) = filterEntry path k
val <- readVar @(StandardT IO) ref
case val of
Computed _ -> pure (k, Nothing)
_ | descend -> (k, ) <$> forceEntry path nv
| otherwise -> pure (k, Nothing)
xs <- forM (sortOn fst (M.toList s)) $ \(k, nv) -> case nv of
Free v -> pure (k, Just (Free v))
Pure (StdThunk (extract -> Thunk _ _ ref)) -> do
let path = prefix ++ Text.unpack k
(_, descend) = filterEntry path k
val <- readVar @(StandardT IO) ref
case val of
Computed _ -> pure (k, Nothing)
_ | descend -> (k, ) <$> forceEntry path nv
| otherwise -> pure (k, Nothing)
forM_ xs $ \(k, mv) -> do
let path = prefix ++ Text.unpack k

2
src/Nix.hs
View File

@ -135,7 +135,7 @@ processResult
processResult h val = do
opts :: Options <- asks (view hasLens)
case attr opts of
Nothing -> h val
Nothing -> h val
Just (Text.splitOn "." -> keys) -> go keys val
where
go :: [Text.Text] -> NValue t f m -> m a

31
src/Nix/Convert.hs
View File

@ -75,10 +75,7 @@ class FromValue a m v where
fromValueMay :: v -> m (Maybe a)
type Convertible e t f m
= ( Framed e m
, MonadDataErrorContext t f m
, MonadThunk t m (NValue t f m)
)
= (Framed e m, MonadDataErrorContext t f m, MonadThunk t m (NValue t f m))
instance ( Convertible e t f m
, MonadValue (NValueNF t f m) m
@ -86,7 +83,7 @@ instance ( Convertible e t f m
)
=> FromValue a m (NValueNF t f m) where
fromValueMay (Fix v) = fromValueMay v
fromValue (Fix v) = fromValue v
fromValue (Fix v) = fromValue v
instance ( Convertible e t f m
, MonadValue (NValue t f m) m
@ -96,7 +93,7 @@ instance ( Convertible e t f m
fromValueMay = flip demand $ \case
Pure t -> force t fromValueMay
Free v -> fromValueMay v
fromValue = flip demand $ \case
fromValue = flip demand $ \case
Pure t -> force t fromValue
Free v -> fromValue v
@ -106,7 +103,7 @@ instance ( Convertible e t f m
)
=> FromValue a m (Deeper (NValueNF t f m)) where
fromValueMay (Deeper (Fix v)) = fromValueMay (Deeper v)
fromValue (Deeper (Fix v)) = fromValue (Deeper v)
fromValue (Deeper (Fix v)) = fromValue (Deeper v)
instance ( Convertible e t f m
, MonadValue (NValue t f m) m
@ -116,7 +113,7 @@ instance ( Convertible e t f m
fromValueMay (Deeper v) = demand v $ \case
Pure t -> force t (fromValueMay . Deeper)
Free v -> fromValueMay (Deeper v)
fromValue (Deeper v) = demand v $ \case
fromValue (Deeper v) = demand v $ \case
Pure t -> force t (fromValue . Deeper)
Free v -> fromValue (Deeper v)
@ -196,7 +193,7 @@ instance (Convertible e t f m
_ -> pure Nothing
fromValue v = fromValueMay v >>= \case
Just b -> pure b
_ -> throwError $ Expectation @t @f @m (TString NoContext) (embedValue v)
_ -> throwError $ Expectation @t @f @m (TString NoContext) (embedValue v)
instance ( Convertible e t f m
, EmbedValue t f m r
@ -204,10 +201,10 @@ instance ( Convertible e t f m
=> FromValue ByteString m (NValue' t f m r) where
fromValueMay = \case
NVStr' ns -> pure $ encodeUtf8 <$> hackyGetStringNoContext ns
_ -> pure Nothing
_ -> pure Nothing
fromValue v = fromValueMay v >>= \case
Just b -> pure b
_ -> throwError $ Expectation @t @f @m (TString NoContext) (embedValue v)
_ -> throwError $ Expectation @t @f @m (TString NoContext) (embedValue v)
newtype Path = Path { getPath :: FilePath }
deriving Show
@ -291,7 +288,7 @@ instance ( Convertible e t f m
)
=> FromValue (AttrSet a, AttrSet SourcePos) m (Deeper (NValue' t f m r)) where
fromValueMay = \case
Deeper (NVSet' s p) -> fmap (,p) <$> sequence <$> traverse fromValueMay s
Deeper (NVSet' s p) -> fmap (, p) <$> sequence <$> traverse fromValueMay s
_ -> pure Nothing
fromValue v = fromValueMay v >>= \case
Just b -> pure b
@ -368,11 +365,7 @@ instance ( Convertible e t f m
f' <- toValue (principledMakeNixStringWithoutContext (Text.pack f))
l' <- toValue (unPos l)
c' <- toValue (unPos c)
let pos = M.fromList
[ ("file" :: Text, f')
, ("line" , l')
, ("column" , c')
]
let pos = M.fromList [("file" :: Text, f'), ("line", l'), ("column", c')]
pure $ nvSet' pos mempty
-- | With 'ToValue', we can always act recursively
@ -420,9 +413,9 @@ instance ( MonadValue (NValue t f m) m
[] -> return Nothing
_ -> Just <$> toValue ts
pure $ flip nvSet' M.empty $ M.fromList $ catMaybes
[ (\p -> ("path", p)) <$> path
[ (\p -> ("path", p)) <$> path
, (\ao -> ("allOutputs", ao)) <$> allOutputs
, (\os -> ("outputs", os)) <$> outputs
, (\os -> ("outputs", os)) <$> outputs
]
instance Convertible e t f m => ToValue () m (NExprF r) where

5
src/Nix/Eval.hs
View File

@ -212,10 +212,7 @@ attrSetAlter (k : ks) pos m p val = case M.lookup k m of
recurse st sp = attrSetAlter ks pos st sp val <&> \(st', _) ->
( M.insert
k
( toValue @(AttrSet v, AttrSet SourcePos)
=<< (, mempty)
<$> sequence st'
)
(toValue @(AttrSet v, AttrSet SourcePos) =<< (, mempty) <$> sequence st')
st
, M.insert k pos sp
)

87
src/Nix/Exec.hs
View File

@ -88,9 +88,9 @@ import GHC.DataSize
type MonadCited t f m
= ( HasCitations m (NValue t f m) t
, HasCitations1 m (NValue t f m) f
, MonadDataContext f m
)
, HasCitations1 m (NValue t f m) f
, MonadDataContext f m
)
nvConstantP
:: MonadCited t f m => Provenance m (NValue t f m) -> NAtom -> NValue t f m
@ -104,14 +104,14 @@ nvStrP
nvStrP p ns = addProvenance p (nvStr ns)
nvPathP
:: MonadCited t f m
=> Provenance m (NValue t f m)
-> FilePath
-> NValue t f m
:: MonadCited t f m => Provenance m (NValue t f m) -> FilePath -> NValue t f m
nvPathP p x = addProvenance p (nvPath x)
nvListP :: MonadCited t f m
=> Provenance m (NValue t f m) -> [NValue t f m] -> NValue t f m
nvListP
:: MonadCited t f m
=> Provenance m (NValue t f m)
-> [NValue t f m]
-> NValue t f m
nvListP p l = addProvenance p (nvList l)
nvSetP
@ -299,10 +299,9 @@ instance MonadNix e t f m => MonadEval (NValue t f m) m where
evalAbs p k = do
scope <- currentScopes
span <- currentPos
pure $ nvClosureP
(Provenance scope (NAbs_ span (Nothing <$ p) Nothing))
(void p)
(\arg -> snd <$> k (pure arg) (\_ b -> ((), ) <$> b))
pure $ nvClosureP (Provenance scope (NAbs_ span (Nothing <$ p) Nothing))
(void p)
(\arg -> snd <$> k (pure arg) (\_ b -> ((), ) <$> b))
evalError = throwError
@ -706,18 +705,27 @@ instance ( MonadFix m
Lazy $ ReaderT $ const $ modify (M.insert path expr)
pure expr
derivationStrict = fromValue @(AttrSet (NValue t f (Lazy t f m))) >=> \s -> do
nn <- maybe (pure False) (demand ?? fromValue) (M.lookup "__ignoreNulls" s)
s' <- M.fromList <$> mapMaybeM (handleEntry nn) (M.toList s)
v' <- normalForm =<< toValue @(AttrSet (NValue t f (Lazy t f m))) @_ @(NValue t f (Lazy t f m)) s'
nixInstantiateExpr $ "derivationStrict " ++ show (prettyNValueNF v')
derivationStrict = fromValue @(AttrSet (NValue t f (Lazy t f m))) >=> \s ->
do
nn <- maybe (pure False)
(demand ?? fromValue)
(M.lookup "__ignoreNulls" s)
s' <- M.fromList <$> mapMaybeM (handleEntry nn) (M.toList s)
v' <-
normalForm
=<< toValue @(AttrSet (NValue t f (Lazy t f m))) @_
@(NValue t f (Lazy t f m))
s'
nixInstantiateExpr $ "derivationStrict " ++ show (prettyNValueNF v')
where
mapMaybeM :: (a -> Lazy t f m (Maybe b)) -> [a] -> Lazy t f m [b]
mapMaybeM op = foldr f (return [])
where f x xs = op x >>= (<$> xs) . (++) . maybeToList
handleEntry :: Bool -> (Text, NValue t f (Lazy t f m))
-> Lazy t f m (Maybe (Text, NValue t f (Lazy t f m)))
handleEntry
:: Bool
-> (Text, NValue t f (Lazy t f m))
-> Lazy t f m (Maybe (Text, NValue t f (Lazy t f m)))
handleEntry ignoreNulls (k, v) = fmap (k, ) <$> case k of
-- The `args' attribute is special: it supplies the command-line
-- arguments to the builder.
@ -729,10 +737,12 @@ instance ( MonadFix m
NVConstant NNull | ignoreNulls -> pure Nothing
v' -> Just <$> coerceNix v'
where
coerceNix :: NValue t f (Lazy t f m) -> Lazy t f m (NValue t f (Lazy t f m))
coerceNix
:: NValue t f (Lazy t f m) -> Lazy t f m (NValue t f (Lazy t f m))
coerceNix = toValue <=< coerceToString CopyToStore CoerceAny
coerceNixList :: NValue t f (Lazy t f m) -> Lazy t f m (NValue t f (Lazy t f m))
coerceNixList
:: NValue t f (Lazy t f m) -> Lazy t f m (NValue t f (Lazy t f m))
coerceNixList v = do
xs <- fromValue @[NValue t f (Lazy t f m)] v
ys <- traverse (\x -> demand x coerceNix) xs
@ -798,17 +808,18 @@ findPathBy finder l name = do
where
go :: Maybe FilePath -> NValue t f m -> m (Maybe FilePath)
go p@(Just _) _ = pure p
go Nothing l = demand l $ fromValue >=> \(s :: HashMap Text (NValue t f m)) -> do
p <- resolvePath s
demand p $ fromValue >=> \(Path path) -> case M.lookup "prefix" s of
Nothing -> tryPath path Nothing
Just pf -> demand pf $ fromValueMay >=> \case
Just (nsPfx :: NixString) ->
let pfx = hackyStringIgnoreContext nsPfx
in if not (Text.null pfx)
then tryPath path (Just (Text.unpack pfx))
else tryPath path Nothing
_ -> tryPath path Nothing
go Nothing l =
demand l $ fromValue >=> \(s :: HashMap Text (NValue t f m)) -> do
p <- resolvePath s
demand p $ fromValue >=> \(Path path) -> case M.lookup "prefix" s of
Nothing -> tryPath path Nothing
Just pf -> demand pf $ fromValueMay >=> \case
Just (nsPfx :: NixString) ->
let pfx = hackyStringIgnoreContext nsPfx
in if not (Text.null pfx)
then tryPath path (Just (Text.unpack pfx))
else tryPath path Nothing
_ -> tryPath path Nothing
tryPath p (Just n) | n' : ns <- splitDirectories name, n == n' =
finder $ p <///> joinPath ns
@ -825,8 +836,12 @@ findPathBy finder l name = do
++ " with 'path' elements, but saw: "
++ show s
findPathM :: forall e t f m . MonadNix e t f m
=> [NValue t f m] -> FilePath -> m FilePath
findPathM
:: forall e t f m
. MonadNix e t f m
=> [NValue t f m]
-> FilePath
-> m FilePath
findPathM l name = findPathBy path l name
where
path :: MonadEffects t f m => FilePath -> m (Maybe FilePath)
@ -840,7 +855,7 @@ findEnvPathM name = do
mres <- lookupVar "__nixPath"
case mres of
Nothing -> error "impossible"
Just x -> demand x $ fromValue >=> \(l :: [NValue t f m]) ->
Just x -> demand x $ fromValue >=> \(l :: [NValue t f m]) ->
findPathBy nixFilePath l name
where
nixFilePath :: MonadEffects t f m => FilePath -> m (Maybe FilePath)

3
src/Nix/Json.hs
View File

@ -46,7 +46,8 @@ nvalueToJSON = \case
<$> traverse (join . lift . flip demand (return . nvalueToJSON)) l
NVSet m _ -> case HM.lookup "outPath" m of
Nothing ->
A.Object <$> traverse (join . lift . flip demand (return . nvalueToJSON)) m
A.Object
<$> traverse (join . lift . flip demand (return . nvalueToJSON)) m
Just outPath -> join $ lift $ demand outPath (return . nvalueToJSON)
NVPath p -> do
fp <- lift $ unStorePath <$> addPath p

21
src/Nix/Lint.hs
View File

@ -112,16 +112,23 @@ everyPossible = packSymbolic NAny
mkSymbolic :: MonadVar m => [NTypeF m (Symbolic m)] -> m (Symbolic m)
mkSymbolic xs = packSymbolic (NMany xs)
packSymbolic :: MonadVar m
=> NSymbolicF (NTypeF m (Symbolic m)) -> m (Symbolic m)
packSymbolic
:: MonadVar m => NSymbolicF (NTypeF m (Symbolic m)) -> m (Symbolic m)
packSymbolic = fmap SV . newVar
unpackSymbolic :: (MonadVar m, MonadThunkId m, MonadCatch m)
=> Symbolic m -> m (NSymbolicF (NTypeF m (Symbolic m)))
unpackSymbolic
:: (MonadVar m, MonadThunkId m, MonadCatch m)
=> Symbolic m
-> m (NSymbolicF (NTypeF m (Symbolic m)))
unpackSymbolic = flip demand $ readVar . getSV
type MonadLint e m
= (Scoped (Symbolic m) m, Framed e m, MonadVar m, MonadCatch m, MonadThunkId m)
= ( Scoped (Symbolic m) m
, Framed e m
, MonadVar m
, MonadCatch m
, MonadThunkId m
)
symerr :: forall e m a . MonadLint e m => String -> m a
symerr = evalError @(Symbolic m) . ErrorCall
@ -164,7 +171,9 @@ merge
merge context = go
where
go
:: [NTypeF m (Symbolic m)] -> [NTypeF m (Symbolic m)] -> m [NTypeF m (Symbolic m)]
:: [NTypeF m (Symbolic m)]
-> [NTypeF m (Symbolic m)]
-> m [NTypeF m (Symbolic m)]
go [] _ = return []
go _ [] = return []
go (x : xs) (y : ys) = case (x, y) of

29
src/Nix/Normal.hs
View File

@ -75,20 +75,21 @@ normalize f = run . iterNValueM run go (fmap Free . sequenceNValue' run)
stubCycles
:: forall t f m
. ( Applicative f
, Functor m
, HasCitations m (NValue t f m) t
, HasCitations1 m (NValue t f m) f
)
=> NValue t f m -> NValueNF t f m
stubCycles = freeToFix $ \t -> Fix
$ NValue
$ Prelude.foldr (addProvenance1 @m @(NValue t f m)) cyc
$ reverse
$ citations @m @(NValue t f m) t
where
Fix (NValue cyc) =
nvStrNF (principledMakeNixStringWithoutContext "<CYCLE>")
. ( Applicative f
, Functor m
, HasCitations m (NValue t f m) t
, HasCitations1 m (NValue t f m) f
)
=> NValue t f m
-> NValueNF t f m
stubCycles = freeToFix $ \t ->
Fix
$ NValue
$ Prelude.foldr (addProvenance1 @m @(NValue t f m)) cyc
$ reverse
$ citations @m @(NValue t f m) t
where
Fix (NValue cyc) = nvStrNF (principledMakeNixStringWithoutContext "<CYCLE>")
normalForm
:: ( Framed e m

7
src/Nix/Pretty.hs
View File

@ -339,11 +339,12 @@ valueToExpr = iterNValueNF phi
phi (NVClosure' _ _ ) = Fix . NSym . pack $ "<closure>"
phi (NVPath' p ) = Fix $ NLiteralPath p
phi (NVBuiltin' name _) = Fix . NSym . pack $ "builtins." ++ name
phi _ = error "Pattern synonyms foil completeness check"
phi _ = error "Pattern synonyms foil completeness check"
mkStr ns = Fix $ NStr $ DoubleQuoted [Plain (hackyStringIgnoreContext ns)]
prettyNValueNF :: forall t f m ann. MonadDataContext f m => NValueNF t f m -> Doc ann
prettyNValueNF
:: forall t f m ann . MonadDataContext f m => NValueNF t f m -> Doc ann
prettyNValueNF = prettyNix . valueToExpr
-- | This function is used only by the testing code.
@ -371,7 +372,7 @@ printNix = iterNValueNF phi
phi NVClosure'{} = "<<lambda>>"
phi (NVPath' fp ) = fp
phi (NVBuiltin' name _) = "<<builtin " ++ name ++ ">>"
phi _ = error "Pattern synonyms foil completeness check"
phi _ = error "Pattern synonyms foil completeness check"
prettyNValue
:: (MonadThunk t m (NValue t f m), MonadDataContext f m)

16
src/Nix/Render/Frame.hs
View File

@ -159,16 +159,12 @@ renderExpr _level longLabel shortLabel e@(Fix (Compose (Ann _ x))) = do
renderValueFrame
:: forall e t f m ann
. ( MonadReader e m
, Has e Options
, MonadFile m
, MonadCitedThunks t f m
)
. (MonadReader e m, Has e Options, MonadFile m, MonadCitedThunks t f m)
=> NixLevel
-> ValueFrame t f m
-> m [Doc ann]
renderValueFrame level = fmap (: []) . \case
ForcingThunk _t -> pure "ForcingThunk" -- jww (2019-03-18): NYI
ForcingThunk _t -> pure "ForcingThunk" -- jww (2019-03-18): NYI
ConcerningValue _v -> pure "ConcerningValue"
Comparison _ _ -> pure "Comparing"
Addition _ _ -> pure "Adding"
@ -185,7 +181,7 @@ renderValueFrame level = fmap (: []) . \case
v' <- renderValue level "" "" v
pure $ "CoercionToJson " <> v'
CoercionFromJson _j -> pure "CoercionFromJson"
Expectation t r -> case getEitherOr r of
Expectation t r -> case getEitherOr r of
Left nf -> do
let v' = prettyNValueNF @t @f @m nf
pure $ "Saw " <> v' <> " but expected " <> pretty (describeValue t)
@ -195,11 +191,7 @@ renderValueFrame level = fmap (: []) . \case
renderValue
:: forall e t f m ann
. ( MonadReader e m
, Has e Options
, MonadFile m
, MonadCitedThunks t f m
)
. (MonadReader e m, Has e Options, MonadFile m, MonadCitedThunks t f m)
=> NixLevel
-> String
-> String

8
src/Nix/Thunk/Basic.hs
View File

@ -39,11 +39,11 @@ type MonadBasicThunk m = (MonadThunkId m, MonadVar m)
instance (MonadBasicThunk m, MonadCatch m)
=> MonadThunk (NThunkF m v) m v where
thunk = buildThunk
thunk = buildThunk
thunkId (Thunk n _ _) = n
queryM = queryThunk
force = forceThunk
forceEff = forceEffects
queryM = queryThunk
force = forceThunk
forceEff = forceEffects
buildThunk :: MonadBasicThunk m => m v -> m (NThunkF m v)
buildThunk action = do

4
src/Nix/Thunk/Standard.hs
View File

@ -78,8 +78,8 @@ instance ( MonadStdThunk (u m)
thunk = fmap (StdThunk . StdCited) . thunk
thunkId = thunkId . _stdCited . _stdThunk
queryM x b f = queryM (_stdCited (_stdThunk x)) b f
force = force . _stdCited . _stdThunk
forceEff = forceEff . _stdCited . _stdThunk
force = force . _stdCited . _stdThunk
forceEff = forceEff . _stdCited . _stdThunk
-- query x b f = query (_stdCited (_stdThunk x)) b f
-- wrapValue = StdThunk . StdCited . wrapValue
-- getValue = getValue . _stdCited . _stdThunk

6
src/Nix/Type/Infer.hs
View File

@ -403,10 +403,12 @@ instance Monad m => MonadCatch (InferT s m) where
(fromException (toException e))
err -> error $ "Unexpected error: " ++ show err
type MonadInfer m = ({- MonadThunkId m,-} MonadVar m, MonadFix m)
type MonadInfer m
= ({- MonadThunkId m,-}
MonadVar m, MonadFix m)
instance MonadValue (Judgment s) (InferT s m) where
defer = id
defer = id
demand = flip ($)
{-

19
src/Nix/Utils.hs
View File

@ -95,23 +95,20 @@ transport :: Functor g => (forall x . f x -> g x) -> Fix f -> Fix g
transport f (Fix x) = Fix $ fmap (transport f) (f x)
lifted
:: ( MonadTransControl u
, Monad (u m)
, Monad m
)
=> ((a -> m (StT u b)) -> m (StT u b)) -> (a -> u m b) -> u m b
:: (MonadTransControl u, Monad (u m), Monad m)
=> ((a -> m (StT u b)) -> m (StT u b))
-> (a -> u m b)
-> u m b
lifted f k = liftWith (\run -> f (run . k)) >>= restoreT . return
freeToFix :: Functor f => (a -> Fix f) -> Free f a -> Fix f
freeToFix f = go
where
go (Pure a) = f a
go (Free v) = Fix (fmap go v)
where
go (Pure a) = f a
go (Free v) = Fix (fmap go v)
fixToFree :: Functor f => Fix f -> Free f Void
fixToFree = Free . go
where
go (Fix f) = fmap (Free . go) f
fixToFree = Free . go where go (Fix f) = fmap (Free . go) f
-- | adi is Abstracting Definitional Interpreters:
--

11
src/Nix/Value/Equal.hs
View File

@ -154,16 +154,17 @@ compareAttrSets f eq lm rm = runIdentity
$ compareAttrSetsM (\t -> Identity (f t)) (\x y -> Identity (eq x y)) lm rm
valueEqM
:: forall t f m. (MonadThunk t m (NValue t f m), Comonad f)
:: forall t f m
. (MonadThunk t m (NValue t f m), Comonad f)
=> NValue t f m
-> NValue t f m
-> m Bool
valueEqM (Pure x) (Pure y) = thunkEqM x y
valueEqM (Pure x) y@(Free _) = thunkEqM x =<< thunk (pure y)
valueEqM x@(Free _) (Pure y) = thunkEqM ?? y =<< thunk (pure x)
valueEqM ( Pure x) ( Pure y) = thunkEqM x y
valueEqM ( Pure x) y@(Free _) = thunkEqM x =<< thunk (pure y)
valueEqM x@(Free _) ( Pure y) = thunkEqM ?? y =<< thunk (pure x)
valueEqM (Free (NValue (extract -> x))) (Free (NValue (extract -> y))) =
valueFEqM (compareAttrSetsM f valueEqM) valueEqM x y
where
where
f (Pure t) = force t $ \case
NVStr s -> pure $ Just s
_ -> pure Nothing

12
src/Nix/XML.hs
View File

@ -16,10 +16,7 @@ import Nix.Value
import Text.XML.Light
toXML :: forall t f m . MonadDataContext f m => NValueNF t f m -> NixString
toXML =
runWithStringContext
. fmap pp
. iterNValueNF phi
toXML = runWithStringContext . fmap pp . iterNValueNF phi
where
pp =
("<?xml version='1.0' encoding='utf-8'?>\n" <>)
@ -36,8 +33,9 @@ toXML =
NBool b -> return $ mkElem "bool" "value" (if b then "true" else "false")
NNull -> return $ Element (unqual "null") [] [] Nothing
NVStr' str -> mkElem "string" "value" . Text.unpack <$> extractNixString str
NVList' l -> sequence l
NVStr' str ->
mkElem "string" "value" . Text.unpack <$> extractNixString str
NVList' l -> sequence l
>>= \els -> return $ Element (unqual "list") [] (Elem <$> els) Nothing
NVSet' s _ -> sequence s >>= \kvs -> return $ Element
@ -59,7 +57,7 @@ toXML =
return $ Element (unqual "function") [] (paramsXML p) Nothing
NVPath' fp -> return $ mkElem "path" "value" fp
NVBuiltin' name _ -> return $ mkElem "function" "name" name
_ -> error "Pattern synonyms mask coverage"
_ -> error "Pattern synonyms mask coverage"
mkElem :: String -> String -> String -> Element
mkElem n a v = Element (unqual n) [Attr (unqual a) v] [] Nothing