From d28c5a978b7ebbfc58540e1378949bfc8d2bbc6b Mon Sep 17 00:00:00 2001 From: Tad Doxsee Date: Wed, 4 Jan 2017 09:40:05 -0800 Subject: [PATCH 1/3] add sorting for array of values, initial dev --- Data/Aeson/Encode/Pretty.hs | 200 ++++++++++++++++++++++++++++++++++-- aeson-pretty.cabal | 6 +- cli-tool/Main.hs | 1 + 3 files changed, 198 insertions(+), 9 deletions(-) diff --git a/Data/Aeson/Encode/Pretty.hs b/Data/Aeson/Encode/Pretty.hs index b66a789..edf683b 100644 --- a/Data/Aeson/Encode/Pretty.hs +++ b/Data/Aeson/Encode/Pretty.hs @@ -51,15 +51,19 @@ module Data.Aeson.Encode.Pretty ( compare, -- |Sort keys in their natural order, i.e. by comparing character codes. -- Re-exported from the Prelude and "Data.Ord" - keyOrder + keyOrder, + -- | Sort an array of Values with Null < Bool < Number < String < Array < Object. + -- Objects are compared by considering them as [[(Text, Value)]] + mkBasicValueCompare ) where -import Data.Aeson (Value(..), ToJSON(..)) +import Data.Aeson (Value(..), ToJSON(..), Array, Object) import qualified Data.Aeson.Encode as Aeson import Data.ByteString.Lazy (ByteString) import Data.Function (on) +-- import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as H (toList) -import Data.List (intersperse, sortBy, elemIndex) +import Data.List (intersperse, sort, sortBy, elemIndex) import Data.Maybe (fromMaybe) import Data.Monoid ((<>)) import qualified Data.Scientific as S (Scientific, FPFormat(..)) @@ -68,10 +72,33 @@ import Data.Text (Text) import Data.Text.Lazy.Builder (Builder, toLazyText) import Data.Text.Lazy.Builder.Scientific (formatScientificBuilder) import Data.Text.Lazy.Encoding (encodeUtf8) -import qualified Data.Vector as V (toList) +-- import Data.Vector (Vector) +import qualified Data.Vector as V import Prelude () import Prelude.Compat +-- import Data.Aeson.Encode.OrdValue + +------------------ +{- +-- for tests +import qualified Data.ByteString.Lazy.Char8 as L8 +-- attoparsec +import Data.Attoparsec.ByteString (maybeResult, parse) + +-- aeson +import Data.Aeson ( Value(Array, Number, Null, Object, String), FromJSON, ToJSON + , Result(Error, Success) --, (.=) + , decode, encode, fromJSON, json, object, toJSON) + +import qualified Data.ByteString.Lazy.Char8 as L8 +-} + +----------------------------------- + +type KeySorter = [(Text, Value)] -> [(Text, Value)] +type ListSorter = [Value] -> [Value] + data PState = PState { pLevel :: Int , pIndent :: Builder @@ -79,7 +106,8 @@ data PState = PState { pLevel :: Int , pItemSep :: Builder , pKeyValSep :: Builder , pNumFormat :: NumberFormat - , pSort :: [(Text, Value)] -> [(Text, Value)] + , pSort :: KeySorter + , pListSort :: ListSorter } -- | Indentation per level of nesting. @'Spaces' 0@ removes __all__ whitespace @@ -105,6 +133,8 @@ data Config = Config , confCompare :: Text -> Text -> Ordering -- ^ Function used to sort keys in objects , confNumFormat :: NumberFormat + -- ^ Flag to sort array of values + , confValueCompare :: Value -> Value -> Ordering } -- |Sort keys by their order of appearance in the argument list. @@ -123,7 +153,7 @@ keyOrder ks = comparing $ \k -> fromMaybe maxBound (elemIndex k ks) -- > defConfig = Config { confIndent = Spaces 4, confCompare = mempty, confNumFormat = Generic } defConfig :: Config defConfig = - Config {confIndent = Spaces 4, confCompare = mempty, confNumFormat = Generic} + Config {confIndent = Spaces 4, confCompare = mempty, confNumFormat = Generic, confValueCompare = mempty} -- |A drop-in replacement for aeson's 'Aeson.encode' function, producing -- JSON-ByteStrings for human readers. @@ -149,7 +179,7 @@ encodePrettyToTextBuilder = encodePrettyToTextBuilder' defConfig encodePrettyToTextBuilder' :: ToJSON a => Config -> a -> Builder encodePrettyToTextBuilder' Config{..} = fromValue st . toJSON where - st = PState 0 indent newline itemSep kvSep confNumFormat sortFn + st = PState 0 indent newline itemSep kvSep confNumFormat sortFn arraySortFn indent = case confIndent of Spaces n -> mconcat (replicate n " ") Tab -> "\t" @@ -162,11 +192,14 @@ encodePrettyToTextBuilder' Config{..} = fromValue st . toJSON _ -> ": " sortFn = sortBy (confCompare `on` fst) + arraySortFn = sortBy confValueCompare + fromValue :: PState -> Value -> Builder fromValue st@PState{..} = go where - go (Array v) = fromCompound st ("[","]") fromValue (V.toList v) + -- go (Array v) = fromCompound st ("[","]") fromValue (sortArrayToList pSort v) + go (Array v) = fromCompound st ("[","]") fromValue (pListSort (V.toList v)) go (Object m) = fromCompound st ("{","}") fromPair (pSort (H.toList m)) go (Number x) = fromNumber st x go v = Aeson.encodeToTextBuilder v @@ -201,3 +234,154 @@ fromNumber st x = case pNumFormat st of Scientific -> formatScientificBuilder S.Exponent Nothing x Decimal -> formatScientificBuilder S.Fixed Nothing x Custom f -> f x + + + +data OrdValue = OrdValue KeySorter Value + +toValue :: OrdValue -> Value +toValue (OrdValue _ x) = x + +instance Eq OrdValue where + (OrdValue _ x) == (OrdValue _ y) = x == y + + +instance Ord OrdValue where + compare (OrdValue _ Null) (OrdValue _ Null) = EQ + compare (OrdValue _ Null) _ = LT + compare _ (OrdValue _ Null) = GT + + compare (OrdValue _ (Bool x)) (OrdValue _ (Bool y)) = compare x y + compare (OrdValue _ (Bool _)) _ = LT + compare _ (OrdValue _ (Bool _)) = GT + + compare (OrdValue _ (Number x)) (OrdValue _ (Number y)) = compare x y + compare (OrdValue _ (Number _)) _ = LT + compare _ (OrdValue _ (Number _)) = GT + + compare (OrdValue _ (String x)) (OrdValue _ (String y)) = compare x y + compare (OrdValue _ (String _)) _ = LT + compare _ (OrdValue _ (String _)) = GT + + compare (OrdValue ks (Array x)) (OrdValue _ (Array y)) = compare (fmap (OrdValue ks) x) (fmap (OrdValue ks) y) + compare (OrdValue _ (Array _)) _ = LT + compare _ (OrdValue _ (Array _)) = GT + + compare (OrdValue ks (Object x)) (OrdValue _ (Object y)) = + compare (toListOrderedByKeys ks x) (toListOrderedByKeys ks y) + + +compareValue :: KeySorter -> Value -> Value -> Ordering +compareValue ks x y = compare (OrdValue ks x) (OrdValue ks y) + +{- +compareValuesWith :: ([(Text, Value)] -> [(Text, Value)]) -> Value -> Value -> Ordering +compareValuesWith _ Null Null = EQ +compareValuesWith _ Null _ = LT +compareValuesWith _ _ Null = GT + +compareValuesWith _ (Bool x) (Bool y) = compare x y +compareValuesWith _ (Bool _) _ = LT +compareValuesWith _ _ (Bool _) = GT + +compareValuesWith _ (Number x) (Number y) = compare x y +compareValuesWith _ (Number _) _ = LT +compareValuesWith _ _ (Number _) = GT + +compareValuesWith _ (String x) (String y) = compare x y +compareValuesWith _ (String _) _ = LT +compareValuesWith _ _ (String _) = GT + +compareValuesWith f (Array x) (Array y) = compare (V.toList x) (V.toList y) +compareValuesWith _ (Array _) _ = LT +compareValuesWith _ _ (Array _) = GT + +compareValuesWith keySorter (Object x) (Object y) = + compare (toListOrderedByKeys keySorter x) (toListOrderedByKeys keySorter y) + + +toListOrderedByKeys :: ([(Text, Value)] -> [(Text, Value)]) -> HashMap Text Value -> [(Text, Value)] +toListOrderedByKeys keySorter m = keySorter $ H.toList m +-} + + +toListOrderedByKeys :: KeySorter -> Object -> [(Text, OrdValue)] +toListOrderedByKeys ks obj = + map (\(k, v) -> (k, OrdValue ks v)) $ ks $ H.toList obj + +sortArrayToList :: KeySorter -> Array -> [Value] +-- sortArrayToList ks arr = map toValue $ sort $ V.toList $ fmap (OrdValue ks) arr +sortArrayToList ks arr = sortArrayToList2 (mkListSorter ks) arr + +-- type ListSorter = [Value] -> [Value] + +sortArrayToList2 :: ListSorter -> Array -> [Value] +sortArrayToList2 ls = ls . V.toList + +mkListSorter :: KeySorter -> ListSorter +mkListSorter ks = map toValue . sort . map (OrdValue ks) + +ftn :: (Value -> Value -> Ordering) -> ListSorter +ftn comp vs = sortBy comp vs + + + +mkKeySorter :: (Text -> Text -> Ordering) -> KeySorter +mkKeySorter txtCompare = sortBy (txtCompare `on` fst) + +mkValueCompareOld :: KeySorter -> Value -> Value -> Ordering +mkValueCompareOld ks x y = compare (OrdValue ks x) (OrdValue ks y) + +mkBasicValueCompare :: (Text -> Text -> Ordering) -> Value -> Value -> Ordering +mkBasicValueCompare txtCompare x y = compare (OrdValue ks x) (OrdValue ks y) + where + ks = mkKeySorter txtCompare + + +----------------------------------------- + +{- +-- js4 :: ByteString +js4 = "[{\"key2\":9, \"key1\" : \"x\", \"updated\" : \"fortyTwo\"}, {\"key2\":9, \"key1\" : \"abc\", \"updated\" :45}, 7, 1, \"aaa\"]" + +conf :: Config +conf = defConfig {confCompare = compare} + +v7 :: Value +Just v7 = maybeResult $ parse json js4 :: Maybe Value + +io1 :: IO () +io1 = L8.putStrLn $ encodePretty' conf v7 +-} + +ks0 :: KeySorter +ks0 = undefined + +as0 :: ListSorter +as0 = undefined + +arr0 :: Array +arr0 = undefined + +-- ovs1 :: [OrdValue] +-- ovs1 = V.toList $ ftn ks0 arr0 + +vs1 :: [Value] +vs1 = V.toList arr0 + +vs2 :: [Value] +vs2 = as0 vs1 + +sortOrdValues :: [OrdValue] -> [OrdValue] +sortOrdValues vs = sortBy compare vs + +listSorter :: ListSorter +-- ftn vs = map toValue $ sortOrdValues $ map (\v -> OrdValue ks0 v) vs +-- ftn vs = map toValue $ sortBy compare $ map (\v -> OrdValue ks0 v) vs +-- ftn = map toValue $ sortOrdValues $ map (OrdValue ks0) +-- listSorter vs = map toValue $ sort $ map (\v -> OrdValue ks0 v) vs +listSorter = map toValue . sort . map (OrdValue ks0) + + + +-- vs3 = sortBy $ compare (\v -> OrdValue ks0 v) diff --git a/aeson-pretty.cabal b/aeson-pretty.cabal index 916cd85..fed6c8d 100644 --- a/aeson-pretty.cabal +++ b/aeson-pretty.cabal @@ -1,5 +1,5 @@ name: aeson-pretty -version: 0.8.2 +version: 0.8.3 license: BSD3 license-file: LICENSE category: Text, Web, JSON, Pretty Printer @@ -38,6 +38,9 @@ flag lib-only library exposed-modules: Data.Aeson.Encode.Pretty + Data.Aeson.Encode.OrdValue + + build-depends: aeson >= 0.7, @@ -46,6 +49,7 @@ library bytestring >= 0.9, scientific >= 0.3, vector >= 0.9, +-- vector-algorithms >= 0.7, text >= 0.11, unordered-containers >= 0.1.3.0 diff --git a/cli-tool/Main.hs b/cli-tool/Main.hs index c5499f8..1acd5d1 100644 --- a/cli-tool/Main.hs +++ b/cli-tool/Main.hs @@ -47,6 +47,7 @@ main = do let conf = Config { confIndent = Spaces indent , confCompare = if sort then compare else mempty , confNumFormat = Generic + , confValueCompare = mempty } enc = if compact then encode else encodePretty' conf interact $ unlines . map enc . values From 714cd79a30e751ededc15fa1fdd1dd98dd5a2f91 Mon Sep 17 00:00:00 2001 From: Tad Doxsee Date: Wed, 4 Jan 2017 10:00:50 -0800 Subject: [PATCH 2/3] cleanup --- Data/Aeson/Encode/Pretty.hs | 156 +++++------------------------------- 1 file changed, 19 insertions(+), 137 deletions(-) diff --git a/Data/Aeson/Encode/Pretty.hs b/Data/Aeson/Encode/Pretty.hs index edf683b..3d131e9 100644 --- a/Data/Aeson/Encode/Pretty.hs +++ b/Data/Aeson/Encode/Pretty.hs @@ -52,18 +52,18 @@ module Data.Aeson.Encode.Pretty ( -- |Sort keys in their natural order, i.e. by comparing character codes. -- Re-exported from the Prelude and "Data.Ord" keyOrder, - -- | Sort an array of Values with Null < Bool < Number < String < Array < Object. + -- | Sort an array of Values with + -- Null < Bool < Number < String < Array < Object. -- Objects are compared by considering them as [[(Text, Value)]] mkBasicValueCompare ) where -import Data.Aeson (Value(..), ToJSON(..), Array, Object) +import Data.Aeson (Value(..), ToJSON(..), Object) import qualified Data.Aeson.Encode as Aeson import Data.ByteString.Lazy (ByteString) import Data.Function (on) --- import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as H (toList) -import Data.List (intersperse, sort, sortBy, elemIndex) +import Data.List (intersperse, sortBy, elemIndex) import Data.Maybe (fromMaybe) import Data.Monoid ((<>)) import qualified Data.Scientific as S (Scientific, FPFormat(..)) @@ -72,30 +72,10 @@ import Data.Text (Text) import Data.Text.Lazy.Builder (Builder, toLazyText) import Data.Text.Lazy.Builder.Scientific (formatScientificBuilder) import Data.Text.Lazy.Encoding (encodeUtf8) --- import Data.Vector (Vector) import qualified Data.Vector as V import Prelude () import Prelude.Compat --- import Data.Aeson.Encode.OrdValue - ------------------- -{- --- for tests -import qualified Data.ByteString.Lazy.Char8 as L8 --- attoparsec -import Data.Attoparsec.ByteString (maybeResult, parse) - --- aeson -import Data.Aeson ( Value(Array, Number, Null, Object, String), FromJSON, ToJSON - , Result(Error, Success) --, (.=) - , decode, encode, fromJSON, json, object, toJSON) - -import qualified Data.ByteString.Lazy.Char8 as L8 --} - ------------------------------------ - type KeySorter = [(Text, Value)] -> [(Text, Value)] type ListSorter = [Value] -> [Value] @@ -150,10 +130,15 @@ keyOrder ks = comparing $ \k -> fromMaybe maxBound (elemIndex k ks) -- |The default configuration: indent by four spaces per level of nesting, do -- not sort objects by key. -- --- > defConfig = Config { confIndent = Spaces 4, confCompare = mempty, confNumFormat = Generic } +-- > defConfig = Config { confIndent = Spaces 4 +-- , confCompare = mempty +-- , confNumFormat = Generic +-- , confValueCompare = mempty +-- } defConfig :: Config defConfig = - Config {confIndent = Spaces 4, confCompare = mempty, confNumFormat = Generic, confValueCompare = mempty} + Config {confIndent = Spaces 4, confCompare = mempty + , confNumFormat = Generic, confValueCompare = mempty} -- |A drop-in replacement for aeson's 'Aeson.encode' function, producing -- JSON-ByteStrings for human readers. @@ -179,7 +164,9 @@ encodePrettyToTextBuilder = encodePrettyToTextBuilder' defConfig encodePrettyToTextBuilder' :: ToJSON a => Config -> a -> Builder encodePrettyToTextBuilder' Config{..} = fromValue st . toJSON where - st = PState 0 indent newline itemSep kvSep confNumFormat sortFn arraySortFn + st = PState 0 indent newline itemSep kvSep confNumFormat + sortFn arraySortFn + indent = case confIndent of Spaces n -> mconcat (replicate n " ") Tab -> "\t" @@ -190,15 +177,14 @@ encodePrettyToTextBuilder' Config{..} = fromValue st . toJSON kvSep = case confIndent of Spaces 0 -> ":" _ -> ": " - sortFn = sortBy (confCompare `on` fst) - + + sortFn = mkKeySorter confCompare arraySortFn = sortBy confValueCompare fromValue :: PState -> Value -> Builder fromValue st@PState{..} = go where - -- go (Array v) = fromCompound st ("[","]") fromValue (sortArrayToList pSort v) go (Array v) = fromCompound st ("[","]") fromValue (pListSort (V.toList v)) go (Object m) = fromCompound st ("{","}") fromPair (pSort (H.toList m)) go (Number x) = fromNumber st x @@ -236,12 +222,8 @@ fromNumber st x = case pNumFormat st of Custom f -> f x - data OrdValue = OrdValue KeySorter Value -toValue :: OrdValue -> Value -toValue (OrdValue _ x) = x - instance Eq OrdValue where (OrdValue _ x) == (OrdValue _ y) = x == y @@ -263,7 +245,9 @@ instance Ord OrdValue where compare (OrdValue _ (String _)) _ = LT compare _ (OrdValue _ (String _)) = GT - compare (OrdValue ks (Array x)) (OrdValue _ (Array y)) = compare (fmap (OrdValue ks) x) (fmap (OrdValue ks) y) + compare (OrdValue ks (Array x)) (OrdValue _ (Array y)) = + compare (fmap (OrdValue ks) x) (fmap (OrdValue ks) y) + compare (OrdValue _ (Array _)) _ = LT compare _ (OrdValue _ (Array _)) = GT @@ -271,117 +255,15 @@ instance Ord OrdValue where compare (toListOrderedByKeys ks x) (toListOrderedByKeys ks y) -compareValue :: KeySorter -> Value -> Value -> Ordering -compareValue ks x y = compare (OrdValue ks x) (OrdValue ks y) - -{- -compareValuesWith :: ([(Text, Value)] -> [(Text, Value)]) -> Value -> Value -> Ordering -compareValuesWith _ Null Null = EQ -compareValuesWith _ Null _ = LT -compareValuesWith _ _ Null = GT - -compareValuesWith _ (Bool x) (Bool y) = compare x y -compareValuesWith _ (Bool _) _ = LT -compareValuesWith _ _ (Bool _) = GT - -compareValuesWith _ (Number x) (Number y) = compare x y -compareValuesWith _ (Number _) _ = LT -compareValuesWith _ _ (Number _) = GT - -compareValuesWith _ (String x) (String y) = compare x y -compareValuesWith _ (String _) _ = LT -compareValuesWith _ _ (String _) = GT - -compareValuesWith f (Array x) (Array y) = compare (V.toList x) (V.toList y) -compareValuesWith _ (Array _) _ = LT -compareValuesWith _ _ (Array _) = GT - -compareValuesWith keySorter (Object x) (Object y) = - compare (toListOrderedByKeys keySorter x) (toListOrderedByKeys keySorter y) - - -toListOrderedByKeys :: ([(Text, Value)] -> [(Text, Value)]) -> HashMap Text Value -> [(Text, Value)] -toListOrderedByKeys keySorter m = keySorter $ H.toList m --} - - toListOrderedByKeys :: KeySorter -> Object -> [(Text, OrdValue)] toListOrderedByKeys ks obj = map (\(k, v) -> (k, OrdValue ks v)) $ ks $ H.toList obj -sortArrayToList :: KeySorter -> Array -> [Value] --- sortArrayToList ks arr = map toValue $ sort $ V.toList $ fmap (OrdValue ks) arr -sortArrayToList ks arr = sortArrayToList2 (mkListSorter ks) arr - --- type ListSorter = [Value] -> [Value] - -sortArrayToList2 :: ListSorter -> Array -> [Value] -sortArrayToList2 ls = ls . V.toList - -mkListSorter :: KeySorter -> ListSorter -mkListSorter ks = map toValue . sort . map (OrdValue ks) - -ftn :: (Value -> Value -> Ordering) -> ListSorter -ftn comp vs = sortBy comp vs - - - mkKeySorter :: (Text -> Text -> Ordering) -> KeySorter mkKeySorter txtCompare = sortBy (txtCompare `on` fst) -mkValueCompareOld :: KeySorter -> Value -> Value -> Ordering -mkValueCompareOld ks x y = compare (OrdValue ks x) (OrdValue ks y) - mkBasicValueCompare :: (Text -> Text -> Ordering) -> Value -> Value -> Ordering mkBasicValueCompare txtCompare x y = compare (OrdValue ks x) (OrdValue ks y) where ks = mkKeySorter txtCompare - ------------------------------------------ - -{- --- js4 :: ByteString -js4 = "[{\"key2\":9, \"key1\" : \"x\", \"updated\" : \"fortyTwo\"}, {\"key2\":9, \"key1\" : \"abc\", \"updated\" :45}, 7, 1, \"aaa\"]" - -conf :: Config -conf = defConfig {confCompare = compare} - -v7 :: Value -Just v7 = maybeResult $ parse json js4 :: Maybe Value - -io1 :: IO () -io1 = L8.putStrLn $ encodePretty' conf v7 --} - -ks0 :: KeySorter -ks0 = undefined - -as0 :: ListSorter -as0 = undefined - -arr0 :: Array -arr0 = undefined - --- ovs1 :: [OrdValue] --- ovs1 = V.toList $ ftn ks0 arr0 - -vs1 :: [Value] -vs1 = V.toList arr0 - -vs2 :: [Value] -vs2 = as0 vs1 - -sortOrdValues :: [OrdValue] -> [OrdValue] -sortOrdValues vs = sortBy compare vs - -listSorter :: ListSorter --- ftn vs = map toValue $ sortOrdValues $ map (\v -> OrdValue ks0 v) vs --- ftn vs = map toValue $ sortBy compare $ map (\v -> OrdValue ks0 v) vs --- ftn = map toValue $ sortOrdValues $ map (OrdValue ks0) --- listSorter vs = map toValue $ sort $ map (\v -> OrdValue ks0 v) vs -listSorter = map toValue . sort . map (OrdValue ks0) - - - --- vs3 = sortBy $ compare (\v -> OrdValue ks0 v) From d25fdd460dfc52a6d56059289bb1756dc3068ae6 Mon Sep 17 00:00:00 2001 From: Tad Doxsee Date: Wed, 4 Jan 2017 14:33:33 -0800 Subject: [PATCH 3/3] some documentation --- Data/Aeson/Encode/Pretty.hs | 88 +++++++++++++++++++++++++++++++------ aeson-pretty.cabal | 6 +-- cli-tool/Main.hs | 6 +-- 3 files changed, 79 insertions(+), 21 deletions(-) diff --git a/Data/Aeson/Encode/Pretty.hs b/Data/Aeson/Encode/Pretty.hs index 3d131e9..2604911 100644 --- a/Data/Aeson/Encode/Pretty.hs +++ b/Data/Aeson/Encode/Pretty.hs @@ -44,6 +44,7 @@ module Data.Aeson.Encode.Pretty ( -- > "quux": ..., -- > } -- + -- mempty, -- |Serves as an order-preserving (non-)sort function. Re-exported from @@ -52,9 +53,65 @@ module Data.Aeson.Encode.Pretty ( -- |Sort keys in their natural order, i.e. by comparing character codes. -- Re-exported from the Prelude and "Data.Ord" keyOrder, - -- | Sort an array of Values with - -- Null < Bool < Number < String < Array < Object. - -- Objects are compared by considering them as [[(Text, Value)]] + -- ** Sorting Values in Arrays + -- |In some cases, it is useful to sort values in arrays. To + -- allow user-specified value orders in the pretty-printed JSON, + -- 'encodePretty'' can be configured with a value comparison function + -- having type 'Value' -> 'Value' -> 'Ordering'. + -- + -- The helper function 'mkBasicValueCompare' may be used to create + -- a comparison function that sorts values with + -- 'Null' < 'Bool' < 'Number' < 'String' < 'Array' < 'Object'. + -- If the array contains some objects, then these objects are sorted + -- considering them as + -- [[('Text', 'Value')]], in which the [('Text', 'Value')] is sorted with + -- the given key/text comparison function (the first argument to + -- 'mkBasicValueCompare'). For consistency, this key/text comparison + -- function should be the same comparison function that + -- is used + -- to sort keys within an object. + -- + -- For example given this array of objects + -- + -- > [ + -- > { + -- > "baz" : 10, + -- > "bar" : 20, + -- > "foo" : 30 + -- > } + -- > , + -- > True, + -- > { + -- > "baz" : 1, + -- > "bar" : 2, + -- > "foo" : 3 + -- > } + -- > ] + -- + -- and this configuration + -- + -- > config = defConfig { confCompare = compare + -- > , confValueCompare = mkBasicValueCompare compare} + -- + -- sorting the array results in: + -- + -- > [ + -- > True, + -- > { + -- > "bar" : 2, + -- > "baz" : 1, + -- > "foo" : 3 + -- > } + -- > , + -- > { + -- > "bar" : 20, + -- > "baz" : 10, + -- > "foo" : 30 + -- > } + -- > ] + -- + -- + mkBasicValueCompare ) where @@ -113,8 +170,8 @@ data Config = Config , confCompare :: Text -> Text -> Ordering -- ^ Function used to sort keys in objects , confNumFormat :: NumberFormat - -- ^ Flag to sort array of values , confValueCompare :: Value -> Value -> Ordering + -- ^ Function used to sort values in arrays } -- |Sort keys by their order of appearance in the argument list. @@ -128,13 +185,13 @@ keyOrder ks = comparing $ \k -> fromMaybe maxBound (elemIndex k ks) -- |The default configuration: indent by four spaces per level of nesting, do --- not sort objects by key. +-- not sort objects by key, do not sort values in arrays. -- -- > defConfig = Config { confIndent = Spaces 4 --- , confCompare = mempty --- , confNumFormat = Generic --- , confValueCompare = mempty --- } +-- > , confCompare = mempty +-- > , confNumFormat = Generic +-- > , confValueCompare = mempty +-- > } defConfig :: Config defConfig = Config {confIndent = Spaces 4, confCompare = mempty @@ -182,6 +239,10 @@ encodePrettyToTextBuilder' Config{..} = fromValue st . toJSON arraySortFn = sortBy confValueCompare +mkKeySorter :: (Text -> Text -> Ordering) -> KeySorter +mkKeySorter txtCompare = sortBy (txtCompare `on` fst) + + fromValue :: PState -> Value -> Builder fromValue st@PState{..} = go where @@ -222,12 +283,13 @@ fromNumber st x = case pNumFormat st of Custom f -> f x +-- used to for sorting Values data OrdValue = OrdValue KeySorter Value instance Eq OrdValue where (OrdValue _ x) == (OrdValue _ y) = x == y - +-- OrdValues are sorted by Null < Bool < Number < String < Array < Object instance Ord OrdValue where compare (OrdValue _ Null) (OrdValue _ Null) = EQ compare (OrdValue _ Null) _ = LT @@ -259,9 +321,9 @@ toListOrderedByKeys :: KeySorter -> Object -> [(Text, OrdValue)] toListOrderedByKeys ks obj = map (\(k, v) -> (k, OrdValue ks v)) $ ks $ H.toList obj -mkKeySorter :: (Text -> Text -> Ordering) -> KeySorter -mkKeySorter txtCompare = sortBy (txtCompare `on` fst) - +-- | Given a text comparison function for sorting keys in an object, +-- makes a 'Value' comparison function +-- that may be used to order values in arrays. mkBasicValueCompare :: (Text -> Text -> Ordering) -> Value -> Value -> Ordering mkBasicValueCompare txtCompare x y = compare (OrdValue ks x) (OrdValue ks y) where diff --git a/aeson-pretty.cabal b/aeson-pretty.cabal index fed6c8d..6e90a0c 100644 --- a/aeson-pretty.cabal +++ b/aeson-pretty.cabal @@ -37,10 +37,7 @@ flag lib-only library exposed-modules: - Data.Aeson.Encode.Pretty - Data.Aeson.Encode.OrdValue - - + Data.Aeson.Encode.Pretty build-depends: aeson >= 0.7, @@ -49,7 +46,6 @@ library bytestring >= 0.9, scientific >= 0.3, vector >= 0.9, --- vector-algorithms >= 0.7, text >= 0.11, unordered-containers >= 0.1.3.0 diff --git a/cli-tool/Main.hs b/cli-tool/Main.hs index 1acd5d1..8cad15e 100644 --- a/cli-tool/Main.hs +++ b/cli-tool/Main.hs @@ -44,9 +44,9 @@ info = main :: IO () main = do Opts{..} <- cmdArgs opts - let conf = Config { confIndent = Spaces indent - , confCompare = if sort then compare else mempty - , confNumFormat = Generic + let conf = Config { confIndent = Spaces indent + , confCompare = if sort then compare else mempty + , confNumFormat = Generic , confValueCompare = mempty } enc = if compact then encode else encodePretty' conf