core-data 0.2.1.8 → 0.2.1.9

raw patch · 5 files changed

+478/−502 lines, 5 filesdep −prettyprinter-ansi-terminaldep ~core-textdep ~prettyprinterPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies removed: prettyprinter-ansi-terminal

Dependency ranges changed: core-text, prettyprinter

API changes (from Hackage documentation)

Files

• core-data.cabal +5/−6
• lib/Core/Data.hs +19/−21
• lib/Core/Data/Structures.hs +196/−207
• lib/Core/Encoding.hs +18/−21
• lib/Core/Encoding/Json.hs +240/−247

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 5d521b5fb71438aae3360db9b1e59766f97c85fcae21b87e0a2ae9809a866820+-- hash: 3017ab753798627f979cfcb7b7382d12e5839ce8fdbd76a0e71c9673521ff98a  name:           core-data-version:        0.2.1.8+version:        0.2.1.9 synopsis:       Convenience wrappers around common data structures and encodings description:    Wrappers around common data structures and encodings.                 .@@ -26,7 +26,7 @@ copyright:      © 2018-2020 Athae Eredh Siniath and Others license:        BSD3 license-file:   LICENSE-tested-with:    GHC == 8.8.3+tested-with:    GHC == 8.8.4 build-type:     Simple  source-repository head@@ -47,10 +47,9 @@     , base >=4.11 && <5     , bytestring     , containers-    , core-text >=0.2.2+    , core-text >=0.3.0     , hashable >=1.2 && <1.4-    , prettyprinter >=1.2.1.1 && <1.8-    , prettyprinter-ansi-terminal+    , prettyprinter >=1.6.2     , scientific     , text     , unordered-containers

@@ -1,26 +1,24 @@ {-# 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.--}+-- |+-- 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+  ( -- * Wrappers -import Core.Data.Structures+    -- |+    -- Exposes 'Map', a wrapper around a dictionary type, and 'Set', for+    -- collections of elements.+    module Core.Data.Structures,+  )+where +import Core.Data.Structures

@@ -1,181 +1,176 @@-{-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeSynonymInstances #-} {-# 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.--}+-- |+-- 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+  ( -- * Map type+    Map,+    emptyMap,+    singletonMap,+    insertKeyValue,+    containsKey,+    lookupKeyValue, -      {-* Conversions -}-    , Dictionary(K, V, fromMap, intoMap)+    -- * Conversions+    Dictionary (K, V, fromMap, intoMap), -      {-* Set type -}-    , Set-    , emptySet-    , singletonSet-    , insertElement-    , containsElement+    -- * Set type+    Set,+    emptySet,+    singletonSet,+    insertElement,+    containsElement, -      {-* Conversions -}-    , Collection(E, fromSet, intoSet)+    -- * Conversions+    Collection (E, fromSet, intoSet), -      {-* Internals -}-    , Key-    , unMap-    , unSet-)+    -- * Internals+    Key,+    unMap,+    unSet,+  ) where +import Core.Text.Bytes (Bytes)+import Core.Text.Rope (Rope) import qualified Data.ByteString as B (ByteString)-import Data.Foldable (Foldable(..))-import Data.Hashable (Hashable) import qualified Data.HashMap.Strict as HashMap import qualified Data.HashSet as HashSet+import Data.Hashable (Hashable) 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)+import qualified GHC.Exts as Exts (IsList (..))  -- 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)--}+-- |+-- 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)+  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.--}+-- |+-- 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 Key B.ByteString  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+  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.--}+-- |+-- A dictionary with no key/value mappings. emptyMap :: Map κ ν emptyMap = Map (HashMap.empty) -{-|-Construct a dictionary with only a single key/value pair.--}+-- |+-- 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.--}+-- |+-- 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.--}+-- |+-- 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?--}+-- |+-- 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)+  (<>) (Map u1) (Map u2) = Map (HashMap.union u1 u2)  instance Key κ => Monoid (Map κ ν) where-    mempty = emptyMap-    mappend = (<>)+  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+  type Item (Map κ ν) = (κ, ν)+  fromList pairs = Map (HashMap.fromList pairs)+  toList (Map u) = HashMap.toList u -    list :: [('Rope','Int')]-    list = 'fromMap' answers-@+-- |+-- 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. -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@@ -189,137 +184,131 @@ -- Many thanks for an elegant solution to the problem. -- class Dictionary α where-    type K α :: *-    type V α :: *-    fromMap :: Map (K α) (V α) -> α-    intoMap :: α -> Map (K α) (V α)+  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+  type K (Map κ ν) = κ+  type V (Map κ ν) = ν+  fromMap = id+  intoMap = id -{-| from "Data.HashMap.Strict" (and .Lazy) -}+-- | 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+  type K (HashMap.HashMap κ ν) = κ+  type V (HashMap.HashMap κ ν) = ν+  fromMap (Map u) = u+  intoMap u = Map u -{-| from "Data.Map.Strict" (and .Lazy) -}+-- | 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.+  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) -To convert to other collection types see 'fromSet' below.+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) -(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)--}+-- |+-- 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)+  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+  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)+  (<>) (Set u1) (Set u2) = Set (HashSet.union u1 u2)  instance Key ε => Monoid (Set ε) where-    mempty = emptySet-    mappend = (<>)+  mempty = emptySet+  mappend = (<>) -{-|-An empty collection. This is used for example as an inital value when-building up a 'Set' using a fold.--}+-- |+-- 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.--}+-- |+-- 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.--}+-- |+-- 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?--}+-- |+-- 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.--}+-- |+-- 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 α)+  type E α :: *+  fromSet :: Set (E α) -> α+  intoSet :: α -> Set (E α)  instance Key ε => Collection (Set ε) where-    type E (Set ε) = ε-    fromSet = id-    intoSet = id+  type E (Set ε) = ε+  fromSet = id+  intoSet = id -{-| from "Data.HashSet" -}+-- | from "Data.HashSet" instance Key ε => Collection (HashSet.HashSet ε) where-    type E (HashSet.HashSet ε) = ε-    fromSet (Set u) = u-    intoSet u = Set u+  type E (HashSet.HashSet ε) = ε+  fromSet (Set u) = u+  intoSet u = Set u -{-| from "Data.Set" -}+-- | 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)+  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)+  type E [ε] = ε+  fromSet (Set u) = OrdSet.toList (HashSet.foldr OrdSet.insert OrdSet.empty u)+  intoSet es = Set (HashSet.fromList es)

@@ -1,26 +1,23 @@ {-# 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.---}+-- |+-- 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+  ( module Core.Encoding.Json,+  )+where  import Core.Encoding.Json-

@@ -1,48 +1,11 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE StrictData #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE StrictData #-} {-# 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@@ -50,95 +13,149 @@ -- 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:+-- |+-- 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.+module Core.Encoding.Json+  ( -- * Encoding and Decoding+    encodeToUTF8,+    decodeFromUTF8,+    JsonValue (..),+    JsonKey (..), -@-23:46:04Z (00000.007) j =-{-    "answer": 42.0-}-@+    -- * Syntax highlighting --}-      , JsonToken(..)-      , colourizeJson-      , prettyKey-      , prettyValue-    ) where+    -- |+    -- 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 Core.Data.Structures (Key, Map, fromMap, intoMap)+import Core.Text.Bytes (Bytes, fromBytes, intoBytes)+import Core.Text.Rope (Rope, Textual, fromRope, intoRope)+import Core.Text.Utilities+    ( brightBlue,+      brightGrey,+      brightMagenta,+      dullBlue,+      dullCyan,+      dullGreen,+      dullYellow,+      AnsiColour,+      Render(Token, highlight, colourize) ) 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 Data.String (IsString (..)) import qualified Data.Text as T+import Data.Text.Prettyprint.Doc+  ( Doc,+    Pretty (..),+    annotate,+    comma,+    dquote,+    group,+    hcat,+    indent,+    lbrace,+    lbracket,+    line,+    line',+    nest,+    punctuate,+    rbrace,+    rbracket,+    sep,+    unAnnotate,+    viaShow,+    vsep,+    (<+>),+  ) 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.--}+-- |+-- 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.--}+-- |+-- 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+  let x :: Maybe Aeson.Value+      x = Aeson.decodeStrict' (fromBytes b)+   in fmap fromAeson x -{-|-A JSON value.--}+-- |+-- A JSON value. data JsonValue-    = JsonObject (Map JsonKey JsonValue)-    | JsonArray [JsonValue]-    | JsonString Rope-    | JsonNumber Scientific-    | JsonBool Bool-    | JsonNull-    deriving (Eq, Show, Generic)+  = 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@@ -147,200 +164,176 @@ -- literals. -- instance IsString JsonValue where-    fromString :: String -> JsonValue-    fromString = JsonString . intoRope+  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"+  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"-+  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+  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.--}+-- |+--    Keys in a JSON object. newtype JsonKey-    = JsonKey Rope-    deriving (Eq, Show, Generic, IsString, Ord)+  = JsonKey Rope+  deriving (Eq, Show, Generic, IsString, Ord)  instance Hashable JsonKey-instance Key JsonKey +instance Key JsonKey  -- FIXME what is this instance? instance Aeson.ToJSON Rope where-    toJSON text = Aeson.toJSON (fromRope text :: T.Text) -- BAD+  toJSON text = Aeson.toJSON (fromRope text :: T.Text) -- BAD  instance Textual JsonKey where-    fromRope t = coerce t-    intoRope x = coerce x-+  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.Object o ->+    let tvs = HashMap.toList o+        kvs = fmap (\(k, v) -> (JsonKey (intoRope k), fromAeson v)) tvs -    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+        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+  = SymbolToken+  | QuoteToken+  | KeyToken+  | StringToken+  | EscapeToken+  | NumberToken+  | BooleanToken+  | LiteralToken  instance Render JsonValue where-    type Token JsonValue = JsonToken-    colourize = colourizeJson-    intoDocA = prettyValue+  type Token JsonValue = JsonToken+  colourize = colourizeJson+  highlight = prettyValue  instance Render JsonKey where-    type Token JsonKey = JsonToken-    colourize = colourizeJson-    intoDocA = prettyKey+  type Token JsonKey = JsonToken+  colourize = colourizeJson+  highlight = prettyKey  instance Render Aeson.Value where-    type Token Aeson.Value = JsonToken-    colourize = colourizeJson-    intoDocA = prettyValue . fromAeson+  type Token Aeson.Value = JsonToken+  colourize = colourizeJson+  highlight = 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+-- |+-- 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 -> AnsiColour 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-+  SymbolToken -> brightGrey+  QuoteToken -> brightGrey+  KeyToken -> brightBlue+  StringToken -> dullCyan+  EscapeToken -> dullYellow+  NumberToken -> dullGreen+  BooleanToken -> brightMagenta+  LiteralToken -> dullBlue  instance Pretty JsonKey where-    pretty = unAnnotate . prettyKey+  pretty = unAnnotate . prettyKey  prettyKey :: JsonKey -> Doc JsonToken prettyKey (JsonKey t) =-    annotate QuoteToken dquote <>-    annotate KeyToken (pretty (fromRope t :: T.Text)) <>-    annotate QuoteToken dquote+  annotate QuoteToken dquote+    <> annotate KeyToken (pretty (fromRope t :: T.Text))+    <> annotate QuoteToken dquote  instance Pretty JsonValue where-    pretty = unAnnotate . prettyValue+  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"+  JsonObject xm ->+    let pairs = fromMap xm+        entries = fmap (\(k, v) -> (prettyKey k) <> annotate SymbolToken ":" <+> clear v (prettyValue v)) pairs -    JsonNull -> annotate LiteralToken "null"+        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+                <> line' -- first line not indented+                <> 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)+  let t = fromRope text :: T.Text+      ts = T.split (== '"') t+      ds = fmap pretty ts+   in hcat (punctuate (annotate EscapeToken "\\\"") ds) {-# INLINEABLE escapeText #-}-