{-# language CPP #-}

module Nix.Json where

import           Nix.Prelude
import qualified Data.Aeson                    as A
import qualified Data.Aeson.Encoding           as A
import qualified Data.Vector                   as V
import qualified Data.HashMap.Strict           as HM
#if MIN_VERSION_aeson(2,0,0)
import qualified Data.Aeson.Key                as AKM
import qualified Data.Aeson.KeyMap             as AKM
#endif
import           Nix.Atoms
import           Nix.Effects
import           Nix.Exec
import           Nix.Frames
import           Nix.String
import           Nix.Value
import           Nix.Value.Monad
import           Nix.Expr.Types

-- This was moved from Utils.
toEncodingSorted :: A.Value -> A.Encoding
toEncodingSorted :: Value -> Encoding
toEncodingSorted = \case
  A.Object Object
m ->
    Series -> Encoding
A.pairs
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap
      (\(Key
k, Value
v) -> Key -> Encoding -> Series
A.pair Key
k forall a b. (a -> b) -> a -> b
$ Value -> Encoding
toEncodingSorted Value
v)
      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 a b. (a -> b) -> a -> b
$
#if MIN_VERSION_aeson(2,0,0)
          forall v. KeyMap v -> [(Key, v)]
AKM.toList
#else
          HM.toList
#endif
            Object
m
  A.Array Array
l -> forall a. (a -> Encoding) -> [a] -> Encoding
A.list Value -> Encoding
toEncodingSorted forall a b. (a -> b) -> a -> b
$ forall a. Vector a -> [a]
V.toList Array
l
  Value
v         -> forall a. ToJSON a => a -> Encoding
A.toEncoding Value
v

toJSONNixString :: MonadNix e t f m => NValue t f m -> m NixString
toJSONNixString :: forall e t (f :: * -> *) (m :: * -> *).
MonadNix e t f m =>
NValue t f m -> m NixString
toJSONNixString =
  forall (m :: * -> *).
Monad m =>
WithStringContextT m Text -> m NixString
runWithStringContextT forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
      ( forall a b. ConvertUtf8 a b => b -> a
decodeUtf8
      -- This is completely not optimal, but seems we do not have better encoding analog (except for @unsafe*@), Aeson gatekeeps through this.
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Encoding' a -> ByteString
A.encodingToLazyByteString
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Encoding
toEncodingSorted
      )

      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e t (f :: * -> *) (m :: * -> *).
MonadNix e t f m =>
NValue t f m -> WithStringContextT m Value
toJSON

toJSON :: MonadNix e t f m => NValue t f m -> WithStringContextT m A.Value
toJSON :: forall e t (f :: * -> *) (m :: * -> *).
MonadNix e t f m =>
NValue t f m -> WithStringContextT m Value
toJSON = \case
  NVConstant (NInt   Integer
n) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> Value
A.toJSON Integer
n
  NVConstant (NFloat Float
n) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> Value
A.toJSON Float
n
  NVConstant (NBool  Bool
b) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> Value
A.toJSON Bool
b
  NVConstant NAtom
NNull      -> forall (f :: * -> *) a. Applicative f => a -> f a
pure   Value
A.Null
  NVStr      NixString
ns         -> forall a. ToJSON a => a -> Value
A.toJSON forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
Monad m =>
NixString -> WithStringContextT m Text
extractNixString NixString
ns
  NVList [NValue t f m]
l -> Array -> Value
A.Array forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Vector a
V.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall e t (f :: * -> *) (m :: * -> *).
MonadNix e t f m =>
NValue t f m -> WithStringContextT m Value
intoJson [NValue t f m]
l
  NVSet PositionSet
_ AttrSet (NValue t f m)
m ->
    forall b a. b -> (a -> b) -> Maybe a -> b
maybe
      (Object -> Value
A.Object forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall e t (f :: * -> *) (m :: * -> *).
MonadNix e t f m =>
NValue t f m -> WithStringContextT m Value
intoJson KeyMap (NValue t f m)
kmap)
      forall e t (f :: * -> *) (m :: * -> *).
MonadNix e t f m =>
NValue t f m -> WithStringContextT m Value
intoJson
      (forall {v}. Key -> KeyMap v -> Maybe v
lkup Key
"outPath" KeyMap (NValue t f m)
kmap)
   where
#if MIN_VERSION_aeson(2,0,0)
    lkup :: Key -> KeyMap v -> Maybe v
lkup = forall {v}. Key -> KeyMap v -> Maybe v
AKM.lookup
    kmap :: KeyMap (NValue t f m)
kmap = forall v. HashMap Key v -> KeyMap v
AKM.fromHashMap forall a b. (a -> b) -> a -> b
$ forall k2 k1 v.
(Eq k2, Hashable k2) =>
(k1 -> k2) -> HashMap k1 v -> HashMap k2 v
HM.mapKeys (Text -> Key
AKM.fromText forall b c a. (b -> c) -> (a -> b) -> a -> c
. coerce :: forall a b. Coercible a b => a -> b
coerce) AttrSet (NValue t f m)
m
#else
    lkup = HM.lookup
    kmap = HM.mapKeys (coerce @VarName @Text) m
#endif
  NVPath Path
p ->
    do
      String
fp <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ coerce :: forall a b. Coercible a b => a -> b
coerce forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e (m :: * -> *).
(Framed e m, MonadStore m) =>
Path -> m StorePath
addPath Path
p
      forall (m :: * -> *).
Monad m =>
StringContext -> WithStringContextT m ()
addSingletonStringContext forall a b. (a -> b) -> a -> b
$ ContextFlavor -> VarName -> StringContext
StringContext ContextFlavor
DirectPath forall a b. (a -> b) -> a -> b
$ forall a. IsString a => String -> a
fromString String
fp
      pure $ forall a. ToJSON a => a -> Value
A.toJSON String
fp
  NValue t f m
v -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall s e (m :: * -> *) a.
(Framed e m, Exception s, MonadThrow m) =>
s -> m a
throwError forall a b. (a -> b) -> a -> b
$ forall t (f :: * -> *) (m :: * -> *).
NValue t f m -> ValueFrame t f m
CoercionToJson NValue t f m
v

 where
  intoJson :: MonadNix e t f m => NValue t f m -> WithStringContextT m A.Value
  intoJson :: forall e t (f :: * -> *) (m :: * -> *).
MonadNix e t f m =>
NValue t f m -> WithStringContextT m Value
intoJson NValue t f m
nv = forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall e t (f :: * -> *) (m :: * -> *).
MonadNix e t f m =>
NValue t f m -> WithStringContextT m Value
toJSON forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall v (m :: * -> *). MonadValue v m => v -> m v
demand NValue t f m
nv