module JsonLogic.Aeson (readJson, prettyPrintJson) where
import Data.Aeson (FromJSON (parseJSON), ToJSON (toJSON), Value (..), decode)
import Data.Aeson.Encode.Pretty
( Config (Config),
Indent (Spaces),
NumberFormat (Generic),
encodePretty',
)
import Data.Aeson.Key (toString)
import Data.Aeson.KeyMap (toMap)
import qualified Data.ByteString.Lazy as DBL (toStrict)
import qualified Data.ByteString.Lazy.UTF8 as BLU
import qualified Data.Map as M (mapKeys)
import Data.Scientific (toRealFloat)
import qualified Data.Text as DT (unpack)
import qualified Data.Text.Encoding as DTE (decodeUtf8)
import Data.Text.IO as TIO (putStrLn)
import Data.Vector (toList)
import JsonLogic.Json (Json (..))
instance ToJSON Json where
toJSON :: Json -> Value
toJSON Json
JsonNull = Value
Null
toJSON (JsonBool Bool
b) = Bool -> Value
forall a. ToJSON a => a -> Value
toJSON Bool
b
toJSON (JsonNumber Double
n) = Double -> Value
forall a. ToJSON a => a -> Value
toJSON Double
n
toJSON (JsonString String
s) = String -> Value
forall a. ToJSON a => a -> Value
toJSON String
s
toJSON (JsonArray [Json]
js) = [Json] -> Value
forall a. ToJSON a => a -> Value
toJSON [Json]
js
toJSON (JsonObject JsonObject
o) = JsonObject -> Value
forall a. ToJSON a => a -> Value
toJSON JsonObject
o
instance FromJSON Json where
parseJSON :: Value -> Parser Json
parseJSON Value
Null = Json -> Parser Json
forall (m :: * -> *) a. Monad m => a -> m a
return Json
JsonNull
parseJSON (Bool Bool
b) = Json -> Parser Json
forall (m :: * -> *) a. Monad m => a -> m a
return (Json -> Parser Json) -> Json -> Parser Json
forall a b. (a -> b) -> a -> b
$ Bool -> Json
JsonBool Bool
b
parseJSON (Number Scientific
n) = Json -> Parser Json
forall (m :: * -> *) a. Monad m => a -> m a
return (Json -> Parser Json) -> Json -> Parser Json
forall a b. (a -> b) -> a -> b
$ Double -> Json
JsonNumber (Double -> Json) -> Double -> Json
forall a b. (a -> b) -> a -> b
$ Scientific -> Double
forall a. RealFloat a => Scientific -> a
toRealFloat Scientific
n
parseJSON (String Text
s) = Json -> Parser Json
forall (m :: * -> *) a. Monad m => a -> m a
return (Json -> Parser Json) -> Json -> Parser Json
forall a b. (a -> b) -> a -> b
$ String -> Json
JsonString (String -> Json) -> String -> Json
forall a b. (a -> b) -> a -> b
$ Text -> String
DT.unpack Text
s
parseJSON (Array Array
xs) = [Json] -> Json
JsonArray ([Json] -> Json) -> Parser [Json] -> Parser Json
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value -> Parser Json) -> [Value] -> Parser [Json]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Value -> Parser Json
forall a. FromJSON a => Value -> Parser a
parseJSON (Array -> [Value]
forall a. Vector a -> [a]
toList Array
xs)
parseJSON (Object Object
o) = JsonObject -> Json
JsonObject (JsonObject -> Json)
-> (Map Key Json -> JsonObject) -> Map Key Json -> Json
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key -> String) -> Map Key Json -> JsonObject
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
M.mapKeys Key -> String
toString (Map Key Json -> Json) -> Parser (Map Key Json) -> Parser Json
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value -> Parser Json) -> Map Key Value -> Parser (Map Key Json)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Value -> Parser Json
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Map Key Value
forall v. KeyMap v -> Map Key v
toMap Object
o)
readJson :: String -> Maybe Json
readJson :: String -> Maybe Json
readJson String
s = ByteString -> Maybe Json
forall a. FromJSON a => ByteString -> Maybe a
decode (ByteString -> Maybe Json) -> ByteString -> Maybe Json
forall a b. (a -> b) -> a -> b
$ String -> ByteString
BLU.fromString String
s
prettyPrintJson :: Json -> IO ()
prettyPrintJson :: Json -> IO ()
prettyPrintJson = Text -> IO ()
TIO.putStrLn (Text -> IO ()) -> (Json -> Text) -> Json -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
DTE.decodeUtf8 (ByteString -> Text) -> (Json -> ByteString) -> Json -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
DBL.toStrict (ByteString -> ByteString)
-> (Json -> ByteString) -> Json -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> Json -> ByteString
forall a. ToJSON a => Config -> a -> ByteString
encodePretty' Config
config
where
config :: Config
config = Indent
-> (Text -> Text -> Ordering) -> NumberFormat -> Bool -> Config
Config (Int -> Indent
Spaces Int
2) Text -> Text -> Ordering
forall a. Monoid a => a
mempty NumberFormat
Generic Bool
False