diff --git a/src/Guide/Utils.hs b/src/Guide/Utils.hs index df69be2..ef0afeb 100644 --- a/src/Guide/Utils.hs +++ b/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 ---------------------------------------------------------------------------- diff --git a/src/Guide/Views/Utils.hs b/src/Guide/Views/Utils.hs index 77a0ac3..64e52b7 100644 --- a/src/Guide/Views/Utils.hs +++ b/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]