Add JSON utils

src/Guide/Utils.hs

@@ -46,6 +46,12 @@ module Guide.Utils
   randomLongUid,
   uid_,
 
+  -- * JSON
+  fromJson,
+  fromJsonWith,
+  toJson,
+  toJsonPretty,
+
   -- * Lucid
   includeJS,
   includeCSS,
@@ -76,8 +82,14 @@ import qualified Data.Set as S
 import System.Random
 -- Text
 import qualified Data.Text.All as T
+-- Bytestring
+import qualified Data.ByteString.Lazy as BSL
 -- JSON
 import qualified Data.Aeson as A
+import qualified Data.Aeson.Text as A
+import qualified Data.Aeson.Types as A
+import qualified Data.Aeson.Internal as A
+import qualified Data.Aeson.Encode.Pretty as A
 -- Network
 import qualified Network.Socket as Network
 import Data.IP
@@ -360,6 +372,56 @@ data Node
 uid_ :: Uid Node -> Attribute
 uid_ = id_ . uidToText
 
+----------------------------------------------------------------------------
+-- JSON
+----------------------------------------------------------------------------
+
+class AsJson s where
+  -- | Parse JSON using the default JSON instance.
+  fromJson :: A.FromJSON a => s -> Either String a
+  fromJson = fromJsonWith A.parseJSON
+
+  -- | Parse JSON using a custom parser.
+  fromJsonWith :: (A.Value -> A.Parser a) -> s -> Either String a
+  fromJsonWith p s = do
+    v <- fromJson s
+    case A.iparse p v of
+      A.IError path err -> Left (A.formatError path err)
+      A.ISuccess res    -> Right res
+
+  -- | Convert a value to JSON.
+  toJson :: A.ToJSON a => a -> s
+
+  -- | Convert a value to pretty-printed JSON.
+  toJsonPretty :: A.ToJSON a => a -> s
+
+instance AsJson ByteString where
+  fromJson = A.eitherDecodeStrict
+  toJson = BSL.toStrict . A.encode
+  toJsonPretty = BSL.toStrict . A.encodePretty
+
+instance AsJson LByteString where
+  fromJson = A.eitherDecode
+  toJson = A.encode
+  toJsonPretty = A.encodePretty
+
+instance AsJson Text where
+  fromJson = A.eitherDecode . T.toLByteString
+  toJson = T.toStrict . A.encodeToLazyText
+  toJsonPretty = T.toStrict . A.encodePrettyToTextBuilder
+
+instance AsJson LText where
+  fromJson = A.eitherDecode . T.toLByteString
+  toJson = A.encodeToLazyText
+  toJsonPretty = T.toLazy . A.encodePrettyToTextBuilder
+
+instance AsJson A.Value where
+  fromJsonWith p v = case A.iparse p v of
+    A.IError path err -> Left (A.formatError path err)
+    A.ISuccess res    -> Right res
+  toJson = A.toJSON
+  toJsonPretty = A.toJSON
+
 ----------------------------------------------------------------------------
 -- Lucid
 ----------------------------------------------------------------------------

src/Guide/Views/Utils.hs

@@ -87,7 +87,6 @@ import qualified System.FilePath.Find as F
 import Text.Mustache.Plus
 import qualified Data.Aeson as A
 import qualified Data.Aeson.Text as A
-import qualified Data.Aeson.Encode.Pretty as A
 import qualified Data.ByteString.Lazy.Char8 as BS
 import qualified Data.Semigroup as Semigroup
 import qualified Data.List.NonEmpty as NonEmpty
@@ -296,10 +295,9 @@ mustache f v = do
         ("selectIf", \[x] -> if x == A.Bool True
             then return (A.String "selected")
             else return A.Null),
-        ("js", \[x] -> return $
-            A.String . T.toStrict . A.encodeToLazyText $ x),
+        ("js", \[x] -> return $ A.String (toJson x)),
         ("trace", \xs -> do
-            mapM_ (BS.putStrLn . A.encodePretty) xs
+            mapM_ (BS.putStrLn . toJsonPretty) xs
             return A.Null) ]
   widgets <- readWidgets
   let templates = [(tname, t) | (HTML_ tname, t) <- widgets]