core-data (empty) → 0.2.0.0

raw patch · 6 files changed

+804/−0 lines, 6 filesdep +aesondep +basedep +bytestring

Dependencies added: aeson, base, bytestring, containers, core-text, hashable, prettyprinter, prettyprinter-ansi-terminal, scientific, text, unordered-containers, vector

Files

• LICENCE +32/−0
• core-data.cabal +51/−0
• lib/Core/Data.hs +26/−0
• lib/Core/Data/Structures.hs +323/−0
• lib/Core/Encoding.hs +26/−0
• lib/Core/Encoding/Json.hs +346/−0

@@ -0,0 +1,32 @@+Opinionated Haskell Interoperability++Copyright © 2018-2019 Operational Dynamics Consulting, Pty Ltd and Others+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:++    1. Redistributions of source code must retain the above copyright+       notice, this list of conditions and the following disclaimer.++    2. Redistributions in binary form must reproduce the above+       copyright notice, this list of conditions and the following+       disclaimer in the documentation and/or other materials provided+       with the distribution.+      +    3. Neither the name of the project nor the names of its contributors+       may be used to endorse or promote products derived from this +       software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,51 @@+cabal-version: 1.12+name: core-data+version: 0.2.0.0+license: BSD3+license-file: LICENCE+copyright: © 2018-2019 Operational Dynamics Consulting Pty Ltd, and Others+maintainer: Andrew Cowie <andrew@operationaldynamics.com>+author: Andrew Cowie <andrew@operationaldynamics.com>+stability: experimental+tested-with: ghc ==8.6.5+homepage: https://github.com/oprdyn/unbeliever#readme+bug-reports: https://github.com/oprdyn/unbeliever/issues+synopsis: Convenience wrappers around common data structures and encodings+description:+    Wrappers around common data structures and encodings.+    .+    This is part of a library intended to ease interoperability and assist in+    building command-line programs, both tools and longer-running daemons.+    A list of features and some background to the library's design is contained+    in the+    <https://github.com/oprdyn/unbeliever/blob/master/README.markdown README>+    on GitHub.+category: System+build-type: Simple++source-repository head+    type: git+    location: https://github.com/oprdyn/unbeliever++library+    exposed-modules:+        Core.Data+        Core.Data.Structures+        Core.Encoding+        Core.Encoding.Json+    hs-source-dirs: lib+    default-language: Haskell2010+    ghc-options: -Wall -Wwarn -fwarn-tabs+    build-depends:+        aeson >=1.4.2.0 && <1.5,+        base >=4.11 && <5,+        bytestring >=0.10.8.2 && <0.11,+        containers >=0.6.0.1 && <0.7,+        core-text >=0.2.0.0 && <0.3,+        hashable >=1.2.7.0 && <1.3,+        prettyprinter >=1.2.1 && <1.3,+        prettyprinter-ansi-terminal >=1.1.1.2 && <1.2,+        scientific >=0.3.6.2 && <0.4,+        text >=1.2.3.1 && <1.3,+        unordered-containers >=0.2.10.0 && <0.3,+        vector >=0.12.0.3 && <0.13

@@ -0,0 +1,26 @@+{-# OPTIONS_HADDOCK not-home #-}++{-|+Wrappers and adaptors for various data structures common in the Haskell+ecosystem.++This is intended to be used directly:++@+import "Core.Data"+@++as this module re-exports all of its various components.+-}+module Core.Data+    (+        {-* Wrappers -}+{-|+Exposes 'Map', a wrapper around a dictionary type, and 'Set', for+collections of elements.+-}+        module Core.Data.Structures+    ) where++import Core.Data.Structures+

@@ -0,0 +1,323 @@+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeFamilies #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++{-|+Convenience wrappers around dictionary and collection types and tools+facilitating conversion between them and various map and set types in+common use in the Haskell ecosystem.+-}+module Core.Data.Structures+(+      {-* Map type -}+      Map+    , emptyMap+    , singletonMap+    , insertKeyValue+    , containsKey+    , lookupKeyValue++      {-* Conversions -}+    , Dictionary(K, V, fromMap, intoMap)++      {-* Set type -}+    , Set+    , emptySet+    , singletonSet+    , insertElement+    , containsElement++      {-* Conversions -}+    , Collection(E, fromSet, intoSet)++      {-* Internals -}+    , Key+    , unMap+    , unSet+)+where++import Data.Foldable (Foldable(..))+import Data.Hashable (Hashable)+import qualified Data.HashMap.Strict as HashMap+import qualified Data.HashSet as HashSet+import qualified Data.Map.Strict as OrdMap+import qualified Data.Set as OrdSet+import qualified Data.Text as T (Text)+import qualified Data.Text.Lazy as U (Text)+import qualified GHC.Exts as Exts (IsList(..))++import Core.Text.Rope (Rope)+import Core.Text.Bytes (Bytes)++-- Naming convention used throughout this file is (Thing u) where u is the+-- underlying structure [from unordered-containers] wrapped in the Thing+-- newtype. Leaves p for our Map and s for our Set in tests.++{-|+A mapping from keys to values.++The keys in a map needs to be an instance of the 'Key' typeclass.+Instances are already provided for many common element types.++'Map' implements 'Foldable', 'Monoid', etc so many common operations such+as 'foldr' to reduce the structure with a right fold, 'length' to get the+number of key/value pairs in the dictionary, 'null' to test whether the+map is empty, and ('<>') to join two maps together are available.++To convert to other dictionary types see 'fromMap' below.++(this is a thin wrapper around __unordered-containers__'s+'Data.HashMap.Strict.HashMap', but if you use the conversion functions to+extract the key/value pairs in a list the list will be ordered according to+the keys' 'Ord' instance)+-}+newtype Map κ ν = Map (HashMap.HashMap κ ν)+    deriving (Show, Eq)++unMap :: Map κ ν -> HashMap.HashMap κ ν+unMap (Map u) = u+{-# INLINE unMap #-}++{-|+Types that can be used as keys in dictionaries or elements in collections.++To be an instance of 'Key' a type must implement both 'Hashable' and 'Ord'.+This requirement means we can subsequently offer easy conversion+between different the dictionary and collection types you might encounter+when interacting with other libraries.++Instances for this library's 'Rope' and 'Bytes' are provided here, along+with many other common types.+-}+class (Hashable κ, Ord κ) => Key κ++instance Key String+instance Key Rope+instance Key Bytes+instance Key T.Text+instance Key U.Text+instance Key Char+instance Key Int++instance Foldable (Map κ) where+    foldr f start (Map u) = HashMap.foldr f start u+    null (Map u) = HashMap.null u+    length (Map u) = HashMap.size u++{-|+A dictionary with no key/value mappings.+-}+emptyMap :: Map κ ν+emptyMap = Map (HashMap.empty)++{-|+Construct a dictionary with only a single key/value pair.+-}+singletonMap :: Key κ => κ -> ν -> Map κ ν+singletonMap k v = Map (HashMap.singleton k v)++{-|+Insert a key/value pair into the dictionary. If the key is already present+in the dictionary, the old value will be discarded and replaced with the+value supplied here.+-}+insertKeyValue :: Key κ => κ -> ν -> Map κ ν -> Map κ ν+insertKeyValue k v (Map u) = Map (HashMap.insert k v u)++{-|+If the dictionary contains the specified key, return the value associated+with that key.+-}+lookupKeyValue :: Key κ => κ -> Map κ ν -> Maybe ν+lookupKeyValue k (Map u) = HashMap.lookup k u++{-|+Does the dictionary contain the specified key?+-}+containsKey :: Key κ => κ -> Map κ ν -> Bool+containsKey k (Map u) = HashMap.member k u++{-|+-}+instance Key κ => Semigroup (Map κ ν) where+    (<>) (Map u1) (Map u2) = Map (HashMap.union u1 u2)++instance Key κ => Monoid (Map κ ν) where+    mempty = emptyMap+    mappend = (<>)++instance Key κ => Exts.IsList (Map κ ν) where+    type Item (Map κ ν) = (κ, ν)+    fromList pairs = Map (HashMap.fromList pairs)+    toList (Map u) = HashMap.toList u++{-|+Types that represent key/value pairs that can be converted to 'Map's.+Haskell's ecosystem has several such. This typeclass provides an adaptor to+get between them. It also allows you to serialize out to an association+list.++For example, to convert a 'Map' to an \"association list\" of key/value+pairs, use 'fromMap':++@+    answers :: 'Map' 'Rope' 'Int'+    answers = 'singletonMap' \"Life, The Universe, and Everything\" 42++    list :: [('Rope','Int')]+    list = 'fromMap' answers+@++Instances are provided for __containers__'s 'Data.Map.Strict.Map' and+__unordered-containers__'s 'Data.HashMap.Strict.HashMap' in addition to the+instance for @[(κ,ν)]@ lists shown above.+-}+--+-- Getting an instance for [(κ,ν)] was very difficult. The approach+-- implemented below was suggested by Xia Li-yao, @Lysxia was to use+-- type families.+--+-- >   "Maybe you can change your type class to be indexed by the fully+-- >   applied dictionary type, instead of a type constructor * -> * -> *"+--+-- https://stackoverflow.com/questions/53554687/list-instances-for-higher-kinded-types/53556313+--+-- Many thanks for an elegant solution to the problem.+--+class Dictionary α where+    type K α :: *+    type V α :: *+    fromMap :: Map (K α) (V α) -> α+    intoMap :: α -> Map (K α) (V α)++instance Key κ => Dictionary (Map κ ν) where+    type K (Map κ ν) = κ+    type V (Map κ ν) = ν+    fromMap = id+    intoMap = id++{-| from "Data.HashMap.Strict" (and .Lazy) -}+instance Key κ => Dictionary (HashMap.HashMap κ ν) where+    type K (HashMap.HashMap κ ν) = κ+    type V (HashMap.HashMap κ ν) = ν+    fromMap (Map u) = u+    intoMap u = Map u++{-| from "Data.Map.Strict" (and .Lazy) -}+instance Key κ => Dictionary (OrdMap.Map κ ν) where+    type K (OrdMap.Map κ ν) = κ+    type V (OrdMap.Map κ ν) = ν+    fromMap (Map u) = HashMap.foldrWithKey OrdMap.insert OrdMap.empty u+    intoMap o = Map (OrdMap.foldrWithKey HashMap.insert HashMap.empty o)++instance Key κ => Dictionary [(κ,ν)] where+    type K [(κ,ν)] = κ+    type V [(κ,ν)] = ν+    fromMap (Map u) = OrdMap.toList (HashMap.foldrWithKey OrdMap.insert OrdMap.empty u)+    intoMap kvs = Map (HashMap.fromList kvs)++{-|+A set of unique elements.++The element type needs to be an instance of the same 'Key' typeclass that+is used for keys in the 'Map' type above. Instances are already provided+for many common element types.++'Set' implements 'Foldable', 'Monoid', etc so many common operations such+as 'foldr' to walk the elements and reduce them, 'length' to return the+size of the collection, 'null' to test whether is empty, and ('<>') to take+the union of two sets are available.++To convert to other collection types see 'fromSet' below.++(this is a thin wrapper around __unordered-containers__'s+'Data.HashSet.HashSet', but if you use the conversion functions to extract+a list the list will be ordered according to the elements' 'Ord' instance)+-}+newtype Set ε = Set (HashSet.HashSet ε)+    deriving (Show, Eq)++unSet :: Set ε -> HashSet.HashSet ε+unSet (Set u) = u+{-# INLINE unSet #-}++instance Foldable Set where+    foldr f start (Set u) = HashSet.foldr f start u+    null (Set u) = HashSet.null u+    length (Set u) = HashSet.size u++instance Key ε => Semigroup (Set ε) where+    (<>) (Set u1) (Set u2) = Set (HashSet.union u1 u2)++instance Key ε => Monoid (Set ε) where+    mempty = emptySet+    mappend = (<>)++{-|+An empty collection. This is used for example as an inital value when+building up a 'Set' using a fold.+-}+emptySet :: Key ε => Set ε+emptySet = Set (HashSet.empty)++{-|+Construct a collection comprising only the supplied element.+-}+singletonSet :: Key ε => ε -> Set ε+singletonSet e = Set (HashSet.singleton e)++{-|+Insert a new element into the collection. Since the 'Set' type does not+allow duplicates, inserting an element already in the collection has no+effect.+-}+insertElement :: Key ε => ε -> Set ε -> Set ε+insertElement e (Set u) = Set (HashSet.insert e u)++{-|+Does the collection contain the specified element?+-}+containsElement :: Key ε => ε -> Set ε -> Bool+containsElement e (Set u) = HashSet.member e u++{-|+Types that represent collections of elements that can be converted to+'Set's.  Haskell's ecosystem has several such. This typeclass provides an+adaptor to convert between them.++This typeclass also provides a mechanism to serialize a 'Set' out to a+Haskell list. The list will be ordered according to the 'Ord' instance of+the element type.++Instances are provided for __containers__'s 'Data.Set.Set' and+__unordered-containers__'s 'Data.HashSet.HashSet' in addition to the+instance for @[ε]@ lists described above.+-}+class Collection α where+    type E α :: *+    fromSet :: Set (E α) -> α+    intoSet :: α -> Set (E α)++instance Key ε => Collection (Set ε) where+    type E (Set ε) = ε+    fromSet = id+    intoSet = id++{-| from "Data.HashSet" -}+instance Key ε => Collection (HashSet.HashSet ε) where+    type E (HashSet.HashSet ε) = ε+    fromSet (Set u) = u+    intoSet u = Set u++{-| from "Data.Set" -}+instance Key ε => Collection (OrdSet.Set ε) where+    type E (OrdSet.Set ε) = ε+    fromSet (Set u) = HashSet.foldr OrdSet.insert OrdSet.empty u+    intoSet u = Set (OrdSet.foldr HashSet.insert HashSet.empty u)++instance Key ε => Collection [ε] where+    type E [ε] = ε+    fromSet (Set u) = OrdSet.toList (HashSet.foldr OrdSet.insert OrdSet.empty u)+    intoSet es = Set (HashSet.fromList es)

@@ -0,0 +1,26 @@+{-# OPTIONS_HADDOCK not-home #-}++{-|+Various formats used for serialization, data transfer, and configuration.++This can be used by simply importing the top level module:++@+import "Core.Encoding"+@++although the individual formats are quite usable indepedently.++Each of these encodings are backed by a popular and well tuned library in+wide use across the Haskell community; these modules are here as wrappers+providing for ease of use and interoperability across the various tools in+this package.++-}+module Core.Encoding+    (+        module Core.Encoding.Json+    ) where++import Core.Encoding.Json+

@@ -0,0 +1,346 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE StrictData #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE TypeFamilies #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++{-|+Encoding and decoding UTF-8 JSON content.++This module is a thin wrapper around the most excellent __aeson__ library,+which has rich and powerful facilities for encoding Haskell types into+JSON.++Quite often, however, you find yourself having to create a Haskell type+/just/ to read some JSON coming from an external web service or API. This+can be challenging when the source of the JSON is complex or varying its+schema over time. For ease of exploration this module simply defines an+easy to use intermediate type representing JSON as a format.++Often you'll be working with literals directly in your code. While you can+write:++@+    j = 'JsonObject' ('intoMap' [('JsonKey' "answer", 'JsonNumber' 42)])+@++and it would be correct, enabling:++@+\{\-\# LANGUAGE OverloadedStrings \#\-\}+\{\-\# LANGUAGE OverloadedLists \#\-\}+@++allows you to write:++@+    j = 'JsonObject' [("answer", 42)]+@++which you is somewhat less cumbersome in declaration-heavy code. You're+certainly welcome to use the constructors if you find it makes for more+readable code or if you need the type annotations.+-}+--+-- As currently implemented this module, in conjunction with+-- Core.Text, is the opposite of efficient. The idea right now is to+-- experiment with the surface API. If it stabilizes, then the fact+-- that our string objects are already in UTF-8 will make for a very+-- efficient emitter.+--+module Core.Encoding.Json+      ( {-* Encoding and Decoding -}+        encodeToUTF8+      , decodeFromUTF8+      , JsonValue(..)+      , JsonKey(..)+        {-* Syntax highlighting -}+{-|+Support for pretty-printing JSON values with syntax highlighting using the+__prettyprinter__ library. To output a JSON structure to terminal+colourized with ANSI escape codes you can use the 'Render' instance:++@+    debug "j" (render j)+@++will get you:++@+23:46:04Z (00000.007) j =+{+    "answer": 42.0+}+@++-}+      , JsonToken(..)+      , colourizeJson+      , prettyKey+      , prettyValue+    ) where++import qualified Data.Aeson as Aeson+import Data.Coerce+import Data.HashMap.Strict (HashMap)+import qualified Data.HashMap.Strict as HashMap+import Data.Hashable (Hashable)+import Data.Text.Prettyprint.Doc+    ( Doc, Pretty(..), viaShow, dquote, comma, punctuate, lbracket+    , rbracket, vsep, (<+>), indent, lbrace, rbrace+    , line, sep, hcat, annotate+    , unAnnotate, line', group, nest+    )+import Data.Text.Prettyprint.Doc.Render.Terminal+    ( color, colorDull, Color(..)+    )+import Data.Text.Prettyprint.Doc.Render.Terminal (AnsiStyle)+import Data.Scientific (Scientific)+import Data.String (IsString(..))+import qualified Data.Text as T+import qualified Data.Vector as V+import GHC.Generics++import Core.Data.Structures (Map, Key, fromMap, intoMap)+import Core.Text.Bytes (Bytes, intoBytes, fromBytes)+import Core.Text.Rope (Rope, Textual, intoRope, fromRope)+import Core.Text.Utilities (Render(..))++{-|+Given a JSON value, encode it to UTF-8 bytes++I know we're not /supposed/ to rely on types to document functions, but+really, this one does what it says on the tin.+-}+encodeToUTF8 :: JsonValue -> Bytes+encodeToUTF8 = intoBytes . Aeson.encode . intoAeson++{-|+Given an array of bytes, attempt to decode it as a JSON value.+-}+decodeFromUTF8 :: Bytes -> Maybe JsonValue+decodeFromUTF8 b =+  let+    x :: Maybe Aeson.Value+    x = Aeson.decodeStrict' (fromBytes b)+  in+    fmap fromAeson x++{-|+A JSON value.+-}+data JsonValue+    = JsonObject (Map JsonKey JsonValue)+    | JsonArray [JsonValue]+    | JsonString Rope+    | JsonNumber Scientific+    | JsonBool Bool+    | JsonNull+    deriving (Eq, Show, Generic)++--+-- Overloads so that Haskell code literals can be interpreted as JSON+-- values. Obviously these are a lot on the partial side, but what else are+-- you supposed to do? This is all Haskell gives us for getting at+-- literals.+--+instance IsString JsonValue where+    fromString :: String -> JsonValue+    fromString = JsonString . intoRope++instance Num JsonValue where+    fromInteger = JsonNumber . fromInteger+    (+) = error "Sorry, you can't add JsonValues"+    (-) = error "Sorry, you can't negate JsonValues"+    (*) = error "Sorry, you can't multiply JsonValues"+    abs = error "Sorry, not applicable for JsonValues"+    signum = error "Sorry, not applicable for JsonValues"++instance Fractional JsonValue where+    fromRational :: Rational -> JsonValue+    fromRational = JsonNumber . fromRational+    (/) = error "Sorry, you can't do division on JsonValues"+++intoAeson :: JsonValue -> Aeson.Value+intoAeson value = case value of+    JsonObject xm ->+        let+            kvs = fromMap xm+            tvs = fmap (\(k, v) -> (fromRope (coerce k), intoAeson v)) kvs+            tvm :: HashMap T.Text Aeson.Value+            tvm = HashMap.fromList tvs+        in+            Aeson.Object tvm++    JsonArray xs ->+        let+            vs = fmap intoAeson xs+        in+            Aeson.Array (V.fromList vs)++    JsonString x -> Aeson.String (fromRope x)+    JsonNumber x -> Aeson.Number x+    JsonBool x -> Aeson.Bool x+    JsonNull -> Aeson.Null++{-|+    Keys in a JSON object.+-}+newtype JsonKey+    = JsonKey Rope+    deriving (Eq, Show, Generic, IsString, Ord)++instance Hashable JsonKey+instance Key JsonKey+++-- FIXME what is this instance?+instance Aeson.ToJSON Rope where+    toJSON text = Aeson.toJSON (fromRope text :: T.Text) -- BAD++instance Textual JsonKey where+    fromRope t = coerce t+    intoRope x = coerce x+++fromAeson :: Aeson.Value -> JsonValue+fromAeson value = case value of+    Aeson.Object o ->+        let+            tvs = HashMap.toList o+            kvs = fmap (\(k, v) -> (JsonKey (intoRope k), fromAeson v)) tvs++            kvm :: Map JsonKey JsonValue+            kvm = intoMap kvs+        in+            JsonObject kvm++    Aeson.Array v -> JsonArray (fmap fromAeson (V.toList v))+    Aeson.String t -> JsonString (intoRope t)+    Aeson.Number n -> JsonNumber n+    Aeson.Bool x -> JsonBool x+    Aeson.Null -> JsonNull++--+-- Pretty printing+--++data JsonToken+    = SymbolToken+    | QuoteToken+    | KeyToken+    | StringToken+    | EscapeToken+    | NumberToken+    | BooleanToken+    | LiteralToken++instance Render JsonValue where+    type Token JsonValue = JsonToken+    colourize = colourizeJson+    intoDocA = prettyValue++instance Render JsonKey where+    type Token JsonKey = JsonToken+    colourize = colourizeJson+    intoDocA = prettyKey++instance Render Aeson.Value where+    type Token Aeson.Value = JsonToken+    colourize = colourizeJson+    intoDocA = prettyValue . fromAeson++--+--  Ugh. If you want to experiment with narrower output, then:+--+--            . layoutPretty (LayoutOptions {layoutPageWidth = AvailablePerLine 15 1.0}) . prettyValue+--+{-|+Used by the 'Render' instance to turn symbolic annotations into ANSI colours annotations.+If you're curious, the render pipeline looks like:++@+    render = 'intoText' . 'renderStrict' . 'reAnnotateS' 'colourize'+                . 'layoutPretty' 'defaultLayoutOptions' . 'prettyValue'+@+-}+colourizeJson :: JsonToken -> AnsiStyle+colourizeJson token = case token of+    SymbolToken -> color Black+    QuoteToken -> color Black+    KeyToken -> color Blue+    StringToken -> colorDull Cyan+    EscapeToken -> colorDull Yellow+    NumberToken -> colorDull Green+    BooleanToken -> color Magenta+    LiteralToken -> colorDull Blue+++instance Pretty JsonKey where+    pretty = unAnnotate . prettyKey++prettyKey :: JsonKey -> Doc JsonToken+prettyKey (JsonKey t) =+    annotate QuoteToken dquote <>+    annotate KeyToken (pretty (fromRope t :: T.Text)) <>+    annotate QuoteToken dquote++instance Pretty JsonValue where+    pretty = unAnnotate . prettyValue++prettyValue :: JsonValue -> Doc JsonToken+prettyValue value = case value of+    JsonObject xm ->+        let+            pairs = fromMap xm+            entries = fmap (\(k, v) -> (prettyKey k) <> annotate SymbolToken ":" <+> clear v (prettyValue v)) pairs++            clear v doc = case v of+                (JsonObject _)  -> line <> doc+                (JsonArray _)   -> group doc+                _               -> doc+        in+            if length entries == 0+                then annotate SymbolToken (lbrace <> rbrace)+                else annotate SymbolToken lbrace <> line <> indent 4 (vsep (punctuate (annotate SymbolToken comma) entries)) <> line <> annotate SymbolToken rbrace++    JsonArray xs ->+        let+            entries = fmap prettyValue xs+        in+            line' <>+            nest 4 (+                annotate SymbolToken lbracket <>    -- first line not indented+                line' <>+                sep (punctuate (annotate SymbolToken comma) entries)+            ) <>+            line' <>+            annotate SymbolToken rbracket++    JsonString x ->+            annotate QuoteToken dquote <>+            annotate StringToken (escapeText x) <>+            annotate QuoteToken dquote++    JsonNumber x -> annotate NumberToken (viaShow x)++    JsonBool x -> case x of+        True -> annotate BooleanToken "true"+        False -> annotate BooleanToken "false"++    JsonNull -> annotate LiteralToken "null"+{-# INLINEABLE prettyValue #-}++escapeText :: Rope -> Doc JsonToken+escapeText text =+  let+    t = fromRope text :: T.Text+    ts = T.split (== '"') t+    ds = fmap pretty ts+  in+    hcat (punctuate (annotate EscapeToken "\\\"") ds)+{-# INLINEABLE escapeText #-}+