/
Json.hs
45 lines (41 loc) · 1.57 KB
/
Json.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
module Nix.Json where
import Control.Monad
import Control.Monad.Trans
import qualified Data.Aeson as A
import qualified Data.Aeson.Encoding as A
import qualified Data.Text as Text
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Encoding as TL
import qualified Data.Vector as V
import Nix.Atoms
import Nix.Effects
import Nix.Exec
import Nix.Frames
import Nix.String
import Nix.Thunk
import Nix.Utils
import Nix.Value
nvalueToJSONNixString :: MonadNix e m => NValue m -> m NixString
nvalueToJSONNixString = runWithStringContextT
. fmap (TL.toStrict . TL.decodeUtf8 . A.encodingToLazyByteString . toEncodingSorted)
. nvalueToJSON
nvalueToJSON :: MonadNix e m => NValue m -> WithStringContextT m A.Value
nvalueToJSON = \case
NVConstant (NInt n) -> pure $ A.toJSON n
NVConstant (NFloat n) -> pure $ A.toJSON n
NVConstant (NBool b) -> pure $ A.toJSON b
NVConstant NNull -> pure $ A.Null
NVStr ns -> do
addStringContext $ principledGetContext ns
return $ A.toJSON $ principledStringIgnoreContext ns
NVList l ->
A.Array . V.fromList <$> traverse (join . lift . flip force (return . nvalueToJSON)) l
NVSet m _ ->
A.Object <$> traverse (join . lift . flip force (return . nvalueToJSON)) m
NVPath p -> do
fp <- lift $ unStorePath <$> addPath p
addSingletonStringContext $ StringContext (Text.pack fp) DirectPath
return $ A.toJSON fp
v -> lift $ throwError $ CoercionToJson v