packages feed

aeson-schemas 1.4.0.1 → 1.4.1.0

raw patch · 32 files changed

+569/−594 lines, 32 filesdep ~template-haskellnew-uploaderPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: template-haskell

API changes (from Hackage documentation)

- Data.Aeson.Schema.Internal: class IsSchemaType schema => HasSchemaResult (schema :: SchemaType)
+ Data.Aeson.Schema.Internal: class (IsSchemaType schema) => HasSchemaResult (schema :: SchemaType)
- Data.Aeson.Schema.Key: class KnownSymbol (FromSchemaKey key) => IsSchemaKey (key :: SchemaKey) where {
+ Data.Aeson.Schema.Key: class (KnownSymbol (FromSchemaKey key)) => IsSchemaKey (key :: SchemaKey) where {

Files

CHANGELOG.md view
@@ -1,3 +1,7 @@+# v1.4.1.0++* Add support for GHC 9.6+ # v1.4.0.1  * Add support for GHC 9.4@@ -51,7 +55,7 @@  Bug fixes: -* Avoid requiring `TypeApplications` when using `get` quasiquoter ([#16](https://github.com/LeapYear/aeson-schemas/issues/16))+* Avoid requiring `TypeApplications` when using `get` quasiquoter ([#16](https://github.com/brandonchinn178/aeson-schemas/issues/16)) * Allow optional quotes around keys, both in getter-expressions and in schema definitions * Allow `//` at the beginning of phantom keys (were previously parsed as comments)
− LICENSE 
@@ -1,11 +0,0 @@-Copyright 2019 LeapYear--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 copyright holder 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 HOLDER 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.
+ LICENSE.md view
@@ -0,0 +1,11 @@+Copyright © 2023-present Brandon Chinn++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 copyright holder 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 HOLDER 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.
README.md view
@@ -1,7 +1,7 @@ # aeson-schemas -[![GitHub Actions](https://img.shields.io/github/workflow/status/LeapYear/aeson-schemas/CI/main)](https://github.com/LeapYear/aeson-schemas/actions?query=branch%3Amain)-[![codecov](https://codecov.io/gh/LeapYear/aeson-schemas/branch/main/graph/badge.svg)](https://codecov.io/gh/LeapYear/aeson-schemas)+[![GitHub Actions](https://img.shields.io/github/actions/workflow/status/brandonchinn178/aeson-schemas/ci.yml?branch=main)](https://github.com/brandonchinn178/aeson-schemas/actions?query=branch%3Amain)+[![codecov](https://codecov.io/gh/brandonchinn178/aeson-schemas/branch/main/graph/badge.svg)](https://codecov.io/gh/brandonchinn178/aeson-schemas) [![Hackage](https://img.shields.io/hackage/v/aeson-schemas)](https://hackage.haskell.org/package/aeson-schemas)  A library that extracts information from JSON input using type-level schemas
aeson-schemas.cabal view
@@ -1,22 +1,22 @@ cabal-version: >= 1.10 --- This file has been generated from package.yaml by hpack version 0.35.0.+-- This file has been generated from package.yaml by hpack version 0.35.2. -- -- see: https://github.com/sol/hpack  name:           aeson-schemas-version:        1.4.0.1+version:        1.4.1.0 synopsis:       Easily consume JSON data on-demand with type-safety description:    Parse JSON data easily and safely without defining new data types. Useful                 for deeply nested JSON data, which is difficult to parse using the default                 FromJSON instances. category:       JSON-homepage:       https://github.com/LeapYear/aeson-schemas#readme-bug-reports:    https://github.com/LeapYear/aeson-schemas/issues-author:         Brandon Chinn <brandon@leapyear.io>-maintainer:     Brandon Chinn <brandon@leapyear.io>+homepage:       https://github.com/brandonchinn178/aeson-schemas#readme+bug-reports:    https://github.com/brandonchinn178/aeson-schemas/issues+author:         Brandon Chinn <brandonchinn178@gmail.com>+maintainer:     Brandon Chinn <brandonchinn178@gmail.com> license:        BSD3-license-file:   LICENSE+license-file:   LICENSE.md build-type:     Simple extra-source-files:     README.md@@ -53,7 +53,7 @@  source-repository head   type: git-  location: https://github.com/LeapYear/aeson-schemas+  location: https://github.com/brandonchinn178/aeson-schemas  flag run-integration-tests   manual: True@@ -88,7 +88,7 @@     , first-class-families >=0.3.0.0 && <0.9     , hashable >=1.2.7.0 && <1.5     , megaparsec >=7 && <10-    , template-haskell >=2.16 && <2.20+    , template-haskell >=2.16 && <2.21     , text >=1.2.2.2 && <2.1     , unordered-containers >=0.2.8.0 && <0.3   default-language: Haskell2010
bench/Benchmarks/Data/Objects.hs view
@@ -1,12 +1,12 @@ {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeInType #-}  module Benchmarks.Data.Objects where @@ -32,13 +32,13 @@   , ToJSON (Object schema)   ) -schemaObject :: forall schema. MockSchema schema => Object schema+schemaObject :: forall schema. (MockSchema schema) => Object schema schemaObject = schemaResult (Proxy @(ToSchemaObject schema)) -schemaValue :: forall schema. MockSchema schema => Value+schemaValue :: forall schema. (MockSchema schema) => Value schemaValue = toJSON $ schemaObject @schema -class Typeable (SchemaResult schema) => MockSchemaResult (schema :: SchemaType) where+class (Typeable (SchemaResult schema)) => MockSchemaResult (schema :: SchemaType) where   schemaResult :: Proxy schema -> SchemaResult schema  instance MockSchemaResult ('SchemaScalar Int) where
bench/Benchmarks/FromJSON.hs view
@@ -44,5 +44,5 @@  {- Orphans -} -instance IsSchema schema => NFData (Object schema) where+instance (IsSchema schema) => NFData (Object schema) where   rnf = rnf . show
bench/Benchmarks/SchemaQQ.hs view
@@ -69,9 +69,8 @@  {- Utilities -} -{- | Apply the given functions the given number of times.-- The first parameter must be >= 0.--}+-- | Apply the given functions the given number of times.+--+--  The first parameter must be >= 0. iterateN :: Int -> (a -> a) -> a -> a iterateN n f x = iterate f x !! n
src/Data/Aeson/Schema.hs view
@@ -1,6 +1,6 @@-{- |+{-| Module      :  Data.Aeson.Schema-Maintainer  :  Brandon Chinn <brandon@leapyear.io>+Maintainer  :  Brandon Chinn <brandonchinn178@gmail.com> Stability   :  experimental Portability :  portable
src/Data/Aeson/Schema/Internal.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DataKinds #-} {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}@@ -7,17 +8,17 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PolyKinds #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilyDependencies #-}-{-# LANGUAGE TypeInType #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} -{- |+{-| Module      :  Data.Aeson.Schema.Internal-Maintainer  :  Brandon Chinn <brandon@leapyear.io>+Maintainer  :  Brandon Chinn <brandonchinn178@gmail.com> Stability   :  experimental Portability :  portable @@ -77,43 +78,40 @@  {- Schema-validated JSON object -} -{- | The object containing JSON data and its schema.-- Has a 'FromJSON' instance, so you can use the usual @Data.Aeson@ decoding functions.-- > obj = decode "{\"a\": 1}" :: Maybe (Object [schema| { a: Int } |])--}+-- | The object containing JSON data and its schema.+--+--  Has a 'FromJSON' instance, so you can use the usual @Data.Aeson@ decoding functions.+--+--  > obj = decode "{\"a\": 1}" :: Maybe (Object [schema| { a: Int } |]) newtype Object (schema :: Schema) = UnsafeObject (KeyMap Dynamic) -instance IsSchema schema => Show (Object schema) where+instance (IsSchema schema) => Show (Object schema) where   showsPrec _ = showValue @(ToSchemaObject schema) -instance IsSchema schema => Eq (Object schema) where+instance (IsSchema schema) => Eq (Object schema) where   a == b = toJSON a == toJSON b -instance IsSchema schema => FromJSON (Object schema) where+instance (IsSchema schema) => FromJSON (Object schema) where   parseJSON = parseValue @(ToSchemaObject schema) [] -instance IsSchema schema => ToJSON (Object schema) where+instance (IsSchema schema) => ToJSON (Object schema) where   toJSON = toValue @(ToSchemaObject schema) -{- | Convert an 'Object' into a 'Aeson.Object', losing the type information in the schema.-- @since 1.3.0--}-toMap :: IsSchema ('Schema schema) => Object ('Schema schema) -> Aeson.Object+-- | Convert an 'Object' into a 'Aeson.Object', losing the type information in the schema.+--+--  @since 1.3.0+toMap :: (IsSchema ('Schema schema)) => Object ('Schema schema) -> Aeson.Object toMap = toValueMap  {- Type-level schema definitions -} -{- | The constraint for most operations involving @Object schema@. If you're writing functions- on general Objects, you should use this constraint. e.g.-- > logObject :: (MonadLogger m, IsSchema schema) => Object schema -> m ()- > logObject = logInfoN . Text.pack . show-- @since 1.3.0--}+-- | The constraint for most operations involving @Object schema@. If you're writing functions+--  on general Objects, you should use this constraint. e.g.+--+--  > logObject :: (MonadLogger m, IsSchema schema) => Object schema -> m ()+--  > logObject = logInfoN . Text.pack . show+--+--  @since 1.3.0 type IsSchema (schema :: Schema) =   ( HasSchemaResult (ToSchemaObject schema)   , All HasSchemaResultPair (FromSchema schema)@@ -121,19 +119,18 @@   , SchemaResult (ToSchemaObject schema) ~ Object schema   ) -{- | Show the given schema.-- Usage:-- > type MySchema = [schema| { a: Int } |]- > showSchema @MySchema--}-showSchema :: forall (schema :: Schema). IsSchema schema => String+-- | Show the given schema.+--+--  Usage:+--+--  > type MySchema = [schema| { a: Int } |]+--  > showSchema @MySchema+showSchema :: forall (schema :: Schema). (IsSchema schema) => String showSchema = "SchemaObject " ++ showSchemaV schema -- TODO: Remove "SchemaObject" prefix? Or rename to "Schema"?   where     schema = toSchemaV $ Proxy @schema -showSchemaType :: forall (schemaType :: SchemaType). HasSchemaResult schemaType => String+showSchemaType :: forall (schemaType :: SchemaType). (HasSchemaResult schemaType) => String showSchemaType = showSchemaTypeV schemaType   where     schemaType = toSchemaTypeV $ Proxy @schemaType@@ -155,19 +152,19 @@   SchemaResultList (x ': xs) = SchemaResult x ': SchemaResultList xs  -- | A type-class for types that can be parsed from JSON for an associated schema type.-class IsSchemaType schema => HasSchemaResult (schema :: SchemaType) where+class (IsSchemaType schema) => HasSchemaResult (schema :: SchemaType) where   parseValue :: [Key] -> Value -> Parser (SchemaResult schema)-  default parseValue :: FromJSON (SchemaResult schema) => [Key] -> Value -> Parser (SchemaResult schema)+  default parseValue :: (FromJSON (SchemaResult schema)) => [Key] -> Value -> Parser (SchemaResult schema)   parseValue path value = parseJSON value <|> parseFail @schema path value    toValue :: SchemaResult schema -> Value-  default toValue :: ToJSON (SchemaResult schema) => SchemaResult schema -> Value+  default toValue :: (ToJSON (SchemaResult schema)) => SchemaResult schema -> Value   toValue = toJSON    -- Note: Using ShowS here instead of just returning String to avoid quadratic performance when   -- using (++)   showValue :: SchemaResult schema -> ShowS-  default showValue :: Show (SchemaResult schema) => SchemaResult schema -> ShowS+  default showValue :: (Show (SchemaResult schema)) => SchemaResult schema -> ShowS   showValue = shows  instance (Show inner, Typeable inner, FromJSON inner, ToJSON inner) => HasSchemaResult ('SchemaScalar inner)@@ -231,7 +228,7 @@       concatShowS :: [ShowS] -> ShowS       concatShowS = foldr (.) id -toValueMap :: forall pairs. All HasSchemaResultPair pairs => Object ('Schema pairs) -> Aeson.Object+toValueMap :: forall pairs. (All HasSchemaResultPair pairs) => Object ('Schema pairs) -> Aeson.Object toValueMap o = Compat.unions $ mapAll @HasSchemaResultPair @pairs (\proxy -> toValuePair proxy o)  class HasSchemaResultPair (a :: (SchemaKey, SchemaType)) where@@ -262,7 +259,7 @@     where       val = unsafeGetKey @inner (Proxy @(FromSchemaKey key)) o -instance IsSchema schema => HasSchemaResult ('SchemaInclude ('Right schema)) where+instance (IsSchema schema) => HasSchemaResult ('SchemaInclude ('Right schema)) where   parseValue = parseValue @(ToSchemaObject schema)   toValue = toValue @(ToSchemaObject schema)   showValue = showValue @(ToSchemaObject schema)@@ -304,24 +301,23 @@           =<< Fcf.Map (Fcf.Bimap UnSchemaKey Fcf.Pure) schema       ) -{- | Get a key from the given 'Data.Aeson.Schema.Internal.Object', returned as the type encoded in- its schema.-- > let o = .. :: Object- >             ( 'SchemaObject- >                '[ '("foo", 'SchemaInt)- >                 , '("bar", 'SchemaObject- >                      '[ '("name", 'SchemaText)- >                       ]- >                 , '("baz", 'SchemaMaybe 'SchemaBool)- >                 ]- >             )- >- > getKey (Proxy @"foo") o                  :: Bool- > getKey (Proxy @"bar") o                  :: Object ('SchemaObject '[ '("name", 'SchemaText) ])- > getKey (Proxy @"name") $ getKey @"bar" o :: Text- > getKey (Proxy @"baz") o                  :: Maybe Bool--}+-- | Get a key from the given 'Data.Aeson.Schema.Internal.Object', returned as the type encoded in+--  its schema.+--+--  > let o = .. :: Object+--  >             ( 'SchemaObject+--  >                '[ '("foo", 'SchemaInt)+--  >                 , '("bar", 'SchemaObject+--  >                      '[ '("name", 'SchemaText)+--  >                       ]+--  >                 , '("baz", 'SchemaMaybe 'SchemaBool)+--  >                 ]+--  >             )+--  >+--  > getKey (Proxy @"foo") o                  :: Bool+--  > getKey (Proxy @"bar") o                  :: Object ('SchemaObject '[ '("name", 'SchemaText) ])+--  > getKey (Proxy @"name") $ getKey @"bar" o :: Text+--  > getKey (Proxy @"baz") o                  :: Maybe Bool getKey ::   forall (key :: Symbol) (schema :: Schema) (endSchema :: SchemaType) result.   ( endSchema ~ LookupSchema key schema@@ -330,17 +326,17 @@   , Typeable result   , Typeable endSchema   ) =>-  Proxy key ->-  Object schema ->-  result+  Proxy key+  -> Object schema+  -> result getKey = unsafeGetKey @endSchema  unsafeGetKey ::   forall (endSchema :: SchemaType) (key :: Symbol) (schema :: Schema).   (KnownSymbol key, Typeable (SchemaResult endSchema)) =>-  Proxy key ->-  Object schema ->-  SchemaResult endSchema+  Proxy key+  -> Object schema+  -> SchemaResult endSchema unsafeGetKey keyProxy (UnsafeObject object) =   fromMaybe (unreachable $ "Could not load key: " ++ key) $     fromDynamic =<< Compat.lookup (fromString key) object
src/Data/Aeson/Schema/Key.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveLift #-}@@ -7,11 +8,10 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeInType #-} -{- |+{-| Module      :  Data.Aeson.Schema.Key-Maintainer  :  Brandon Chinn <brandon@leapyear.io>+Maintainer  :  Brandon Chinn <brandonchinn178@gmail.com> Stability   :  experimental Portability :  portable @@ -61,9 +61,8 @@ showSchemaKeyV (NormalKey key) = show key showSchemaKeyV (PhantomKey key) = "[" ++ key ++ "]" -{- | Given schema `{ key: innerSchema }` for JSON data `{ key: val1 }`, get the JSON- Value that `innerSchema` should parse.--}+-- | Given schema `{ key: innerSchema }` for JSON data `{ key: val1 }`, get the JSON+--  Value that `innerSchema` should parse. getContext :: SchemaKeyV -> Aeson.Object -> Aeson.Value getContext = \case   -- `innerSchema` should parse `val1`@@ -71,9 +70,8 @@   -- `innerSchema` should parse the same object that `key` is in   PhantomKey _ -> Aeson.Object -{- | Given JSON data `val` adhering to `innerSchema`, get the JSON object that should be- merged with the outer JSON object.--}+-- | Given JSON data `val` adhering to `innerSchema`, get the JSON object that should be+--  merged with the outer JSON object. toContext :: SchemaKeyV -> Aeson.Value -> Aeson.Object toContext = \case   -- `val` should be inserted with key `key`@@ -89,20 +87,20 @@ -- | A type-level SchemaKey type SchemaKey = SchemaKey' Symbol -class KnownSymbol (FromSchemaKey key) => IsSchemaKey (key :: SchemaKey) where+class (KnownSymbol (FromSchemaKey key)) => IsSchemaKey (key :: SchemaKey) where   type FromSchemaKey key :: Symbol   toSchemaKeyV :: Proxy key -> SchemaKeyV -instance KnownSymbol key => IsSchemaKey ('NormalKey key) where+instance (KnownSymbol key) => IsSchemaKey ('NormalKey key) where   type FromSchemaKey ('NormalKey key) = key   toSchemaKeyV _ = NormalKey $ symbolVal $ Proxy @key -instance KnownSymbol key => IsSchemaKey ('PhantomKey key) where+instance (KnownSymbol key) => IsSchemaKey ('PhantomKey key) where   type FromSchemaKey ('PhantomKey key) = key   toSchemaKeyV _ = PhantomKey $ symbolVal $ Proxy @key -fromSchemaKey :: forall key. IsSchemaKey key => String+fromSchemaKey :: forall key. (IsSchemaKey key) => String fromSchemaKey = fromSchemaKeyV $ toSchemaKeyV $ Proxy @key -showSchemaKey :: forall key. IsSchemaKey key => String+showSchemaKey :: forall key. (IsSchemaKey key) => String showSchemaKey = showSchemaKeyV $ toSchemaKeyV $ Proxy @key
src/Data/Aeson/Schema/TH.hs view
@@ -1,6 +1,6 @@-{- |+{-| Module      :  Data.Aeson.Schema.TH-Maintainer  :  Brandon Chinn <brandon@leapyear.io>+Maintainer  :  Brandon Chinn <brandonchinn178@gmail.com> Stability   :  experimental Portability :  portable
src/Data/Aeson/Schema/TH/Enum.hs view
@@ -1,9 +1,9 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE TemplateHaskell #-} -{- |+{-| Module      :  Data.Aeson.Schema.TH.Enum-Maintainer  :  Brandon Chinn <brandon@leapyear.io>+Maintainer  :  Brandon Chinn <brandonchinn178@gmail.com> Stability   :  experimental Portability :  portable @@ -23,20 +23,19 @@ import Language.Haskell.TH import Language.Haskell.TH.Syntax (lift) -{- | Make an enum type with the given constructors, that can be parsed from JSON.-- The 'FromJSON' instance will match to a string value matching the constructor name,- case-insensitive.-- @- mkEnum \"State" [\"OPEN", \"CLOSED"]-- -- generates equivalent of:- --   data State = OPEN | CLOSED deriving (...)- --   genFromJSONEnum ''State- --   genToJSONEnum ''State- @--}+-- | Make an enum type with the given constructors, that can be parsed from JSON.+--+--  The 'FromJSON' instance will match to a string value matching the constructor name,+--  case-insensitive.+--+--  @+--  mkEnum \"State" [\"OPEN", \"CLOSED"]+--+--  -- generates equivalent of:+--  --   data State = OPEN | CLOSED deriving (...)+--  --   genFromJSONEnum ''State+--  --   genToJSONEnum ''State+--  @ mkEnum :: String -> [String] -> Q [Dec] mkEnum name vals =   concat@@ -57,57 +56,55 @@       ]     toCon val = normalC val [] -{- | Generate an instance of 'FromJSON' for the given data type.-- Prefer using 'mkEnum'; this function is useful for data types in which you want greater control- over the actual data type.-- The 'FromJSON' instance will match to a string value matching the constructor name,- case-insensitive.-- @- data State = Open | CLOSED deriving (Show,Enum)- genFromJSONEnum ''State-- -- outputs:- --   Just Open- --   Just Open- --   Just CLOSED- --   Just CLOSED- main = mapM_ print-   [ decodeState \"open"-   , decodeState \"OPEN"-   , decodeState \"closed"-   , decodeState \"CLOSED"-   ]-   where-     decodeState :: String -> Maybe State-     decodeState = decode . show- @--}+-- | Generate an instance of 'FromJSON' for the given data type.+--+--  Prefer using 'mkEnum'; this function is useful for data types in which you want greater control+--  over the actual data type.+--+--  The 'FromJSON' instance will match to a string value matching the constructor name,+--  case-insensitive.+--+--  @+--  data State = Open | CLOSED deriving (Show,Enum)+--  genFromJSONEnum ''State+--+--  -- outputs:+--  --   Just Open+--  --   Just Open+--  --   Just CLOSED+--  --   Just CLOSED+--  main = mapM_ print+--    [ decodeState \"open"+--    , decodeState \"OPEN"+--    , decodeState \"closed"+--    , decodeState \"CLOSED"+--    ]+--    where+--      decodeState :: String -> Maybe State+--      decodeState = decode . show+--  @ genFromJSONEnum :: Name -> Q [Dec] genFromJSONEnum name = getEnumConstructors name >>= mkFromJSON name -{- | Generate an instance of 'ToJSON' for the given data type.-- Prefer using 'mkEnum'; this function is useful for data types in which you want greater control- over the actual data type.-- The 'ToJSON' instance will encode the enum as a string matching the constructor name.-- @- data State = Open | CLOSED deriving (Show,Enum)- genToJSONEnum ''State-- -- outputs:- --   \"Open"- --   \"CLOSED"- main = mapM_ print-   [ encode Open-   , encode CLOSED-   ]- @--}+-- | Generate an instance of 'ToJSON' for the given data type.+--+--  Prefer using 'mkEnum'; this function is useful for data types in which you want greater control+--  over the actual data type.+--+--  The 'ToJSON' instance will encode the enum as a string matching the constructor name.+--+--  @+--  data State = Open | CLOSED deriving (Show,Enum)+--  genToJSONEnum ''State+--+--  -- outputs:+--  --   \"Open"+--  --   \"CLOSED"+--  main = mapM_ print+--    [ encode Open+--    , encode CLOSED+--    ]+--  @ genToJSONEnum :: Name -> Q [Dec] genToJSONEnum name = getEnumConstructors name >>= mkToJSON name
src/Data/Aeson/Schema/TH/Get.hs view
@@ -3,9 +3,9 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TemplateHaskell #-} -{- |+{-| Module      :  Data.Aeson.Schema.TH.Get-Maintainer  :  Brandon Chinn <brandon@leapyear.io>+Maintainer  :  Brandon Chinn <brandonchinn178@gmail.com> Stability   :  experimental Portability :  portable @@ -32,59 +32,58 @@  ) import Data.Aeson.Schema.Utils.Sum (fromSumType) -{- | Defines a QuasiQuoter for extracting JSON data.-- Example:-- > let Just result = decode ... :: Maybe (Object MySchema)- >- > [get| result.foo.a |]          :: Int- > [get| result.foo.nodes |]      :: [Object (..)]- > [get| result.foo.nodes[] |]    :: [Object (..)]- > [get| result.foo.nodes[].b |]  :: [Maybe Bool]- > [get| result.foo.nodes[].b! |] :: [Bool] -- runtime error if any values are Nothing- > [get| result.foo.c |]          :: Text- > [get| result.foo.(a,c) |]      :: (Int, Text)- > [get| result.foo.[c,d] |]      :: [Text]- >- > let nodes = [get| result.foo.nodes |]- > flip map nodes $ \node -> fromMaybe ([get| node.num |] == 0) [get| node.b |]- > map [get| .num |] nodes-- Syntax:-- * @x.y@ is only valid if @x@ is an 'Data.Aeson.Schema.Object'. Returns the value of the key @y@.-- * @.y@ returns a function that takes in an 'Data.Aeson.Schema.Object' and returns the value of-   the key @y@.-- * @x.[y,z.a]@ is only valid if @x@ is an 'Data.Aeson.Schema.Object', and if @y@ and @z.a@ have-   the same type. Returns the value of the operations @y@ and @z.a@ as a list.-   MUST be the last operation.-- * @x.(y,z.a)@ is only valid if @x@ is an 'Data.Aeson.Schema.Object'. Returns the value of the-   operations @y@ and @z.a@ as a tuple.-   MUST be the last operation.-- * @x!@ is only valid if @x@ is a 'Maybe'. Unwraps the value of @x@ from a 'Just' value and-   errors (at runtime!) if @x@ is 'Nothing'.-- * @x[]@ is only valid if @x@ is a list. Applies the remaining rules as an 'fmap' over the-   values in the list, e.g.--     * @x[]@ without anything after is equivalent to @x@-     * @x[].y@ gets the key @y@ in all the Objects in @x@-     * @x[]!@ unwraps all 'Just' values in @x@ (and errors if any 'Nothing' values exist in @x@)-- * @x?@ follows the same rules as @x[]@ except it's only valid if @x@ is a 'Maybe'.-- * @x\@#@ is only valid if @x@ is a 'SumType'. If the sum type contains a value at the given-   branch (e.g. @x\@0@ for @Here v@), return 'Just' that value, otherwise 'Nothing'. (added in-   v1.1.0)--   e.g. with the schema @{ a: Int | Bool }@, calling @[get| .a\@0 |]@ will return @Maybe Int@ if-   the sum type contains an 'Int'.--}+-- | Defines a QuasiQuoter for extracting JSON data.+--+--  Example:+--+--  > let Just result = decode ... :: Maybe (Object MySchema)+--  >+--  > [get| result.foo.a |]          :: Int+--  > [get| result.foo.nodes |]      :: [Object (..)]+--  > [get| result.foo.nodes[] |]    :: [Object (..)]+--  > [get| result.foo.nodes[].b |]  :: [Maybe Bool]+--  > [get| result.foo.nodes[].b! |] :: [Bool] -- runtime error if any values are Nothing+--  > [get| result.foo.c |]          :: Text+--  > [get| result.foo.(a,c) |]      :: (Int, Text)+--  > [get| result.foo.[c,d] |]      :: [Text]+--  >+--  > let nodes = [get| result.foo.nodes |]+--  > flip map nodes $ \node -> fromMaybe ([get| node.num |] == 0) [get| node.b |]+--  > map [get| .num |] nodes+--+--  Syntax:+--+--  * @x.y@ is only valid if @x@ is an 'Data.Aeson.Schema.Object'. Returns the value of the key @y@.+--+--  * @.y@ returns a function that takes in an 'Data.Aeson.Schema.Object' and returns the value of+--    the key @y@.+--+--  * @x.[y,z.a]@ is only valid if @x@ is an 'Data.Aeson.Schema.Object', and if @y@ and @z.a@ have+--    the same type. Returns the value of the operations @y@ and @z.a@ as a list.+--    MUST be the last operation.+--+--  * @x.(y,z.a)@ is only valid if @x@ is an 'Data.Aeson.Schema.Object'. Returns the value of the+--    operations @y@ and @z.a@ as a tuple.+--    MUST be the last operation.+--+--  * @x!@ is only valid if @x@ is a 'Maybe'. Unwraps the value of @x@ from a 'Just' value and+--    errors (at runtime!) if @x@ is 'Nothing'.+--+--  * @x[]@ is only valid if @x@ is a list. Applies the remaining rules as an 'fmap' over the+--    values in the list, e.g.+--+--      * @x[]@ without anything after is equivalent to @x@+--      * @x[].y@ gets the key @y@ in all the Objects in @x@+--      * @x[]!@ unwraps all 'Just' values in @x@ (and errors if any 'Nothing' values exist in @x@)+--+--  * @x?@ follows the same rules as @x[]@ except it's only valid if @x@ is a 'Maybe'.+--+--  * @x\@#@ is only valid if @x@ is a 'SumType'. If the sum type contains a value at the given+--    branch (e.g. @x\@0@ for @Here v@), return 'Just' that value, otherwise 'Nothing'. (added in+--    v1.1.0)+--+--    e.g. with the schema @{ a: Int | Bool }@, calling @[get| .a\@0 |]@ will return @Maybe Int@ if+--    the sum type contains an 'Int'. get :: QuasiQuoter get =   QuasiQuoter@@ -128,8 +127,11 @@  {- Runtime helpers -} +{- HLINT ignore fromJust "Redundant bracket" -}+-- https://github.com/ndmitchell/hlint/issues/1503+ -- | fromJust with helpful error message-fromJust :: HasCallStack => String -> Maybe a -> a+fromJust :: (HasCallStack) => String -> Maybe a -> a fromJust expr = Maybe.fromMaybe (error errMsg)   where     errMsg = "Called 'fromJust' on null expression" ++ if null expr then "" else ": " ++ expr@@ -172,7 +174,7 @@       let applyVal expr = appE expr (varE val)       lamE [varP val] $ fromElems $ map (applyVal . resolveGetterOpExps) $ NonEmpty.toList elemOps -showGetterOps :: Foldable t => t GetterOperation -> String+showGetterOps :: (Foldable t) => t GetterOperation -> String showGetterOps = concatMap showGetterOp   where     showGetterOp = \case@@ -188,11 +190,10 @@  {- Utilities -} -{- | Run the given function for each element in the list, providing all elements seen so far.-- e.g. for a list [1,2,3], this will return the result of--   [f [] 1, f [1] 2, f [1,2] 3]--}+-- | Run the given function for each element in the list, providing all elements seen so far.+--+--  e.g. for a list [1,2,3], this will return the result of+--+--    [f [] 1, f [1] 2, f [1,2] 3] mapWithHistory :: ([a] -> a -> b) -> NonEmpty a -> NonEmpty b mapWithHistory f xs = NonEmpty.zipWith f (NonEmpty.inits xs) xs
src/Data/Aeson/Schema/TH/Getter.hs view
@@ -1,9 +1,9 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TemplateHaskell #-} -{- |+{-| Module      :  Data.Aeson.Schema.TH.Getter-Maintainer  :  Brandon Chinn <brandon@leapyear.io>+Maintainer  :  Brandon Chinn <brandonchinn178@gmail.com> Stability   :  experimental Portability :  portable @@ -26,59 +26,58 @@ import Data.Aeson.Schema.TH.Utils (loadSchema, lookupSchema, schemaVToTypeQ) import Data.Aeson.Schema.Utils.NameLike (NameLike (..)) -{- | A helper that generates a 'Data.Aeson.Schema.TH.get' expression and a type alias for the result- of the expression.-- > mkGetter "Node" "getNodes" ''MySchema ".nodes[]"- >- > {\- is equivalent to -\}- >- > -- | Node ~ { b: Maybe Bool }- > type Node = [unwrap| MySchema.nodes[] |]- >- > getNodes :: Object MySchema -> [Node]- > getNodes = [get| .nodes[] |]-- 'mkGetter' takes four arguments:--   [@unwrapName@] The name of the type synonym to store the unwrapped schema as--   [@funcName@] The name of the getter function--   [@startSchema@] The schema to extract/unwrap from--   [@ops@] The operation to pass to the 'Data.Aeson.Schema.TH.get' and-           'Data.Aeson.Schema.TH.unwrap' quasiquoters-- There is one subtlety that occurs from the use of the same @ops@ string for both the- 'Data.Aeson.Schema.TH.unwrap' and 'Data.Aeson.Schema.TH.get' quasiquoters:- 'Data.Aeson.Schema.TH.unwrap' strips out intermediate functors, while 'Data.Aeson.Schema.TH.get'- applies within the functor. So in the above example, @".nodes[]"@ strips out the list when- saving the schema to @Node@, while in the below example, @".nodes"@ doesn't strip out the list- when saving the schema to @Nodes@.-- > mkGetter "Nodes" "getNodes" ''MySchema ".nodes"- >- > {\- is equivalent to -\}- >- > -- | Nodes ~ List { b: Maybe Bool }- > type Nodes = [unwrap| MySchema.nodes |]- >- > getNodes :: Object MySchema -> Nodes- > getNodes = [get| .nodes |]-- As another example,-- > mkGetter "MyName" "getMyName" ''MySchema ".f?[].name"- >- > {\- is equivalent to -\}- >- > -- | MyName ~ Text- > type MyName = [unwrap| MySchema.f?[].name |]- >- > getMyBool :: Object MySchema -> Maybe [MyName]- > getMyBool = [get| .f?[].name |]--}+-- | A helper that generates a 'Data.Aeson.Schema.TH.get' expression and a type alias for the result+--  of the expression.+--+--  > mkGetter "Node" "getNodes" ''MySchema ".nodes[]"+--  >+--  > {\- is equivalent to -\}+--  >+--  > -- | Node ~ { b: Maybe Bool }+--  > type Node = [unwrap| MySchema.nodes[] |]+--  >+--  > getNodes :: Object MySchema -> [Node]+--  > getNodes = [get| .nodes[] |]+--+--  'mkGetter' takes four arguments:+--+--    [@unwrapName@] The name of the type synonym to store the unwrapped schema as+--+--    [@funcName@] The name of the getter function+--+--    [@startSchema@] The schema to extract/unwrap from+--+--    [@ops@] The operation to pass to the 'Data.Aeson.Schema.TH.get' and+--            'Data.Aeson.Schema.TH.unwrap' quasiquoters+--+--  There is one subtlety that occurs from the use of the same @ops@ string for both the+--  'Data.Aeson.Schema.TH.unwrap' and 'Data.Aeson.Schema.TH.get' quasiquoters:+--  'Data.Aeson.Schema.TH.unwrap' strips out intermediate functors, while 'Data.Aeson.Schema.TH.get'+--  applies within the functor. So in the above example, @".nodes[]"@ strips out the list when+--  saving the schema to @Node@, while in the below example, @".nodes"@ doesn't strip out the list+--  when saving the schema to @Nodes@.+--+--  > mkGetter "Nodes" "getNodes" ''MySchema ".nodes"+--  >+--  > {\- is equivalent to -\}+--  >+--  > -- | Nodes ~ List { b: Maybe Bool }+--  > type Nodes = [unwrap| MySchema.nodes |]+--  >+--  > getNodes :: Object MySchema -> Nodes+--  > getNodes = [get| .nodes |]+--+--  As another example,+--+--  > mkGetter "MyName" "getMyName" ''MySchema ".f?[].name"+--  >+--  > {\- is equivalent to -\}+--  >+--  > -- | MyName ~ Text+--  > type MyName = [unwrap| MySchema.f?[].name |]+--  >+--  > getMyBool :: Object MySchema -> Maybe [MyName]+--  > getMyBool = [get| .f?[].name |] mkGetter :: String -> String -> Name -> String -> DecsQ mkGetter unwrapName funcName startSchemaName ops = do   getterExp@GetterExp{..} <- parseGetterExp ops
src/Data/Aeson/Schema/TH/Parse.hs view
@@ -1,9 +1,9 @@ {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE RecordWildCards #-} -{- |+{-| Module      :  Data.Aeson.Schema.TH.Parse-Maintainer  :  Brandon Chinn <brandon@leapyear.io>+Maintainer  :  Brandon Chinn <brandonchinn178@gmail.com> Stability   :  experimental Portability :  portable @@ -25,7 +25,7 @@  type Parser = Parsec Void String -runParserFail :: MonadFail m => Parser a -> String -> m a+runParserFail :: (MonadFail m) => Parser a -> String -> m a runParserFail parser s = either (fail . errorBundlePretty) return $ runParser parser s s  {- SchemaDef -}@@ -50,7 +50,7 @@   | SchemaDefObjKeyPhantom String   deriving (Show) -parseSchemaDef :: MonadFail m => String -> m SchemaDef+parseSchemaDef :: (MonadFail m) => String -> m SchemaDef parseSchemaDef = runParserFail $ do   space   def <- parseSchemaDefWithUnions@@ -101,7 +101,7 @@   }   deriving (Show) -parseGetterExp :: MonadFail m => String -> m GetterExp+parseGetterExp :: (MonadFail m) => String -> m GetterExp parseGetterExp = runParserFail $ do   space   start <- optional $ namespacedIdentifier lowerChar@@ -118,7 +118,7 @@   }   deriving (Show) -parseUnwrapSchema :: MonadFail m => String -> m UnwrapSchema+parseUnwrapSchema :: (MonadFail m) => String -> m UnwrapSchema parseUnwrapSchema = runParserFail $ do   space   startSchema <- namespacedIdentifier upperChar@@ -129,10 +129,9 @@  {- GetterOps -} -{- | A non-empty list of GetterOperations.-- Invariant: Any GetterList/GetterTuple operations MUST be last.--}+-- | A non-empty list of GetterOperations.+--+--  Invariant: Any GetterList/GetterTuple operations MUST be last. type GetterOps = NonEmpty GetterOperation  parseGetterOps :: Parser GetterOps@@ -217,26 +216,25 @@ {- Parsing utilities -}  -- | Same as 'Megaparsec.some', except returns a 'NonEmpty'-some :: MonadPlus f => f a -> f (NonEmpty a)+some :: (MonadPlus f) => f a -> f (NonEmpty a) some p = NonEmpty.fromList <$> Megaparsec.some p  -- | Same as 'Megaparsec.sepBy1', except returns a 'NonEmpty'-sepBy1 :: MonadPlus f => f a -> f sep -> f (NonEmpty a)+sepBy1 :: (MonadPlus f) => f a -> f sep -> f (NonEmpty a) sepBy1 p sep = NonEmpty.fromList <$> Megaparsec.sepBy1 p sep  -- | Same as 'Megaparsec.sepEndBy1', except returns a 'NonEmpty'-sepEndBy1 :: MonadPlus f => f a -> f sep -> f (NonEmpty a)+sepEndBy1 :: (MonadPlus f) => f a -> f sep -> f (NonEmpty a) sepEndBy1 p sep = NonEmpty.fromList <$> Megaparsec.sepEndBy1 p sep -{- | Return a non-empty list containing elements from the given parsers in order.-- i.e. for `someWith [p1, p2, p3]`, elements parsed with `p1` will come before- elements parsed with `p2` and `p3`, etc.-- An individual parser in the list may not parse anything, but at least one parser must return- something.--}-someWith :: MonadParsec e s m => [m a] -> m (NonEmpty a)+-- | Return a non-empty list containing elements from the given parsers in order.+--+--  i.e. for `someWith [p1, p2, p3]`, elements parsed with `p1` will come before+--  elements parsed with `p2` and `p3`, etc.+--+--  An individual parser in the list may not parse anything, but at least one parser must return+--  something.+someWith :: (MonadParsec e s m) => [m a] -> m (NonEmpty a) someWith ps = do   as <- concatMapM (many . try) ps   maybe empty return $ NonEmpty.nonEmpty as
src/Data/Aeson/Schema/TH/Schema.hs view
@@ -6,9 +6,9 @@ {-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeFamilies #-} -{- |+{-| Module      :  Data.Aeson.Schema.TH.Schema-Maintainer  :  Brandon Chinn <brandon@leapyear.io>+Maintainer  :  Brandon Chinn <brandonchinn178@gmail.com> Stability   :  experimental Portability :  portable @@ -45,63 +45,62 @@ import Data.Aeson.Schema.Utils.Invariant (unreachable) import Data.Aeson.Schema.Utils.NameLike (NameLike (..)) -{- | Defines a QuasiQuoter for writing schemas.-- Example:-- > import Data.Aeson.Schema (schema)- >- > type MySchema = [schema|- >   {- >     foo: {- >       a: Int,- >       // you can add comments like this- >       nodes: List {- >         b: Maybe Bool,- >       },- >       c: Text,- >       d: Text,- >       e: MyType,- >       f: Maybe List {- >         name: Text,- >       },- >     },- >   }- > |]-- Syntax:-- * @{ key: \<schema\>, ... }@ corresponds to a JSON 'Data.Aeson.Schema.Object' with the given key-   mapping to the given schema.-- * @Bool@, @Int@, @Double@, and @Text@ correspond to the usual Haskell values.-- * @Maybe \<schema\>@ and @List \<schema\>@ correspond to @Maybe@ and @[]@, containing values-   specified by the provided schema (no parentheses needed).-- * @Try \<schema\>@ corresponds to @Maybe@, where the value will be @Just@ if the given schema-   successfully parses the value, or @Nothing@ otherwise. Different from @Maybe \<schema\>@,-   where parsing @{ "foo": true }@ with @{ foo: Try Int }@ returns @Nothing@, whereas it would-   be a parse error with @{ foo: Maybe Int }@ (added in v1.2.0)-- * Any other uppercase identifier corresponds to the respective type in scope -- requires a-   FromJSON instance.-- Advanced syntax:-- * @\<schema1\> | \<schema2\>@ corresponds to a JSON value that matches one of the given schemas.-   When extracted from an 'Data.Aeson.Schema.Object', it deserializes into a-   'Data.Aeson.Schema.Utils.Sum.JSONSum' object. (added in v1.1.0)-- * @{ [key]: \<schema\> }@ uses the current object to resolve the keys in the given schema. Only-   object schemas are allowed here. (added in v1.2.0)-- * @{ key: #Other, ... }@ maps the given key to the @Other@ schema. The @Other@ schema needs to-   be defined in another module.-- * @{ #Other, ... }@ extends this schema with the @Other@ schema. The @Other@ schema needs to-   be defined in another module.--}+-- | Defines a QuasiQuoter for writing schemas.+--+--  Example:+--+--  > import Data.Aeson.Schema (schema)+--  >+--  > type MySchema = [schema|+--  >   {+--  >     foo: {+--  >       a: Int,+--  >       // you can add comments like this+--  >       nodes: List {+--  >         b: Maybe Bool,+--  >       },+--  >       c: Text,+--  >       d: Text,+--  >       e: MyType,+--  >       f: Maybe List {+--  >         name: Text,+--  >       },+--  >     },+--  >   }+--  > |]+--+--  Syntax:+--+--  * @{ key: \<schema\>, ... }@ corresponds to a JSON 'Data.Aeson.Schema.Object' with the given key+--    mapping to the given schema.+--+--  * @Bool@, @Int@, @Double@, and @Text@ correspond to the usual Haskell values.+--+--  * @Maybe \<schema\>@ and @List \<schema\>@ correspond to @Maybe@ and @[]@, containing values+--    specified by the provided schema (no parentheses needed).+--+--  * @Try \<schema\>@ corresponds to @Maybe@, where the value will be @Just@ if the given schema+--    successfully parses the value, or @Nothing@ otherwise. Different from @Maybe \<schema\>@,+--    where parsing @{ "foo": true }@ with @{ foo: Try Int }@ returns @Nothing@, whereas it would+--    be a parse error with @{ foo: Maybe Int }@ (added in v1.2.0)+--+--  * Any other uppercase identifier corresponds to the respective type in scope -- requires a+--    FromJSON instance.+--+--  Advanced syntax:+--+--  * @\<schema1\> | \<schema2\>@ corresponds to a JSON value that matches one of the given schemas.+--    When extracted from an 'Data.Aeson.Schema.Object', it deserializes into a+--    'Data.Aeson.Schema.Utils.Sum.JSONSum' object. (added in v1.1.0)+--+--  * @{ [key]: \<schema\> }@ uses the current object to resolve the keys in the given schema. Only+--    object schemas are allowed here. (added in v1.2.0)+--+--  * @{ key: #Other, ... }@ maps the given key to the @Other@ schema. The @Other@ schema needs to+--    be defined in another module.+--+--  * @{ #Other, ... }@ extends this schema with the @Other@ schema. The @Other@ schema needs to+--    be defined in another module. schema :: QuasiQuoter schema =   QuasiQuoter@@ -128,9 +127,8 @@    either fail return $ resolveKeys schemaObjectMaps -{- | Get the SchemaObjectMapV for the given SchemaDefObjItem, along with where the SchemaObjectMapV- came from.--}+-- | Get the SchemaObjectMapV for the given SchemaDefObjItem, along with where the SchemaObjectMapV+--  came from. getSchemaObjectMap :: SchemaDefObjItem -> Q (SchemaObjectMapV, KeySource) getSchemaObjectMap = \case   SchemaDefObjPair (schemaDefKey, schemaDefType) -> do@@ -158,13 +156,12 @@       SchemaInclude _ -> True       _ -> False -{- | Resolve the given keys with the following rules:-- 1. Any explicitly provided keys shadow/overwrite imported keys- 2. Fail if duplicate keys are both explicitly provided- 3. Fail if duplicate keys are both imported--}-resolveKeys :: forall a. Show a => LookupMap SchemaKeyV (KeySource, a) -> Either String (LookupMap SchemaKeyV a)+-- | Resolve the given keys with the following rules:+--+--  1. Any explicitly provided keys shadow/overwrite imported keys+--  2. Fail if duplicate keys are both explicitly provided+--  3. Fail if duplicate keys are both imported+resolveKeys :: forall a. (Show a) => LookupMap SchemaKeyV (KeySource, a) -> Either String (LookupMap SchemaKeyV a) resolveKeys = mapM (uncurry resolveKey) . groupByKeyWith fromSchemaKeyV   where     resolveKey :: SchemaKeyV -> [(KeySource, a)] -> Either String (SchemaKeyV, a)@@ -203,13 +200,12 @@ distribute :: LookupMap k v -> a -> LookupMap k (a, v) distribute lookupMap a = map (fmap (a,)) lookupMap -{- | Find all values with the same key (according to the given function) and group them.-- Invariants:- * [v] has length > 0- * If the first occurence of k1 is before the first occurence of k2, k1 is before k2-   in the result--}+-- | Find all values with the same key (according to the given function) and group them.+--+--  Invariants:+--  * [v] has length > 0+--  * If the first occurence of k1 is before the first occurence of k2, k1 is before k2+--    in the result groupByKeyWith :: (Eq a, Hashable a) => (k -> a) -> LookupMap k v -> LookupMap k [v] groupByKeyWith f pairs = map (\key -> (key, groups HashMap.! f key)) distinctKeys   where@@ -220,5 +216,5 @@  {- Utilities -} -lookupAll :: Eq a => a -> [(a, b)] -> [b]+lookupAll :: (Eq a) => a -> [(a, b)] -> [b] lookupAll a = map snd . filter ((== a) . fst)
src/Data/Aeson/Schema/TH/Unwrap.hs view
@@ -2,9 +2,9 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TemplateHaskell #-} -{- |+{-| Module      :  Data.Aeson.Schema.TH.Unwrap-Maintainer  :  Brandon Chinn <brandon@leapyear.io>+Maintainer  :  Brandon Chinn <brandonchinn178@gmail.com> Stability   :  experimental Portability :  portable @@ -41,38 +41,37 @@   toSchemaObjectV,  ) -{- | Defines a QuasiQuoter to extract a schema within the given schema.-- The base schema needs to be defined in a separate module.-- For example:-- > -- | MyFoo ~ Object [schema| { b: Maybe Bool } |]- > type MyFoo = [unwrap| MySchema.foo.nodes[] |]-- If the schema is imported qualified, you can use parentheses to distinguish it from the- expression:-- > type MyFoo = [unwrap| (MyModule.Schema).foo.nodes[] |]-- You can then use the type alias as usual:-- > parseBar :: MyFoo -> String- > parseBar = maybe "null" show . [get| .b |]- >- > foo = map parseBar [get| result.foo.nodes[] |]-- The syntax is mostly the same as 'Data.Aeson.Schema.TH.get', except the operations run on the- type itself, instead of the values. Differences from 'Data.Aeson.Schema.TH.get':-- * @x!@ is only valid if @x@ is a @Maybe a@ type. Returns @a@, the type wrapped in the 'Maybe'.-- * @x?@ is the same as @x!@.-- * @x[]@ is only valid if @x@ is a @[a]@ type. Returns @a@, the type contained in the list.-- * @x\@#@ is only valid if @x@ is a @SumType@. Returns the type at that branch in the sum type.--}+-- | Defines a QuasiQuoter to extract a schema within the given schema.+--+--  The base schema needs to be defined in a separate module.+--+--  For example:+--+--  > -- | MyFoo ~ Object [schema| { b: Maybe Bool } |]+--  > type MyFoo = [unwrap| MySchema.foo.nodes[] |]+--+--  If the schema is imported qualified, you can use parentheses to distinguish it from the+--  expression:+--+--  > type MyFoo = [unwrap| (MyModule.Schema).foo.nodes[] |]+--+--  You can then use the type alias as usual:+--+--  > parseBar :: MyFoo -> String+--  > parseBar = maybe "null" show . [get| .b |]+--  >+--  > foo = map parseBar [get| result.foo.nodes[] |]+--+--  The syntax is mostly the same as 'Data.Aeson.Schema.TH.get', except the operations run on the+--  type itself, instead of the values. Differences from 'Data.Aeson.Schema.TH.get':+--+--  * @x!@ is only valid if @x@ is a @Maybe a@ type. Returns @a@, the type wrapped in the 'Maybe'.+--+--  * @x?@ is the same as @x!@.+--+--  * @x[]@ is only valid if @x@ is a @[a]@ type. Returns @a@, the type contained in the list.+--+--  * @x\@#@ is only valid if @x@ is a @SumType@. Returns the type at that branch in the sum type. unwrap :: QuasiQuoter unwrap =   QuasiQuoter
src/Data/Aeson/Schema/TH/Utils.hs view
@@ -7,9 +7,9 @@ {-# LANGUAGE TypeOperators #-} {-# LANGUAGE ViewPatterns #-} -{- |+{-| Module      :  Data.Aeson.Schema.TH.Utils-Maintainer  :  Brandon Chinn <brandon@leapyear.io>+Maintainer  :  Brandon Chinn <brandonchinn178@gmail.com> Stability   :  experimental Portability :  portable -}@@ -51,9 +51,8 @@   , reifiedSchemaType :: TypeWithoutKinds   } -{- | Look up a schema with the given name. Errors if the name doesn't exist or if the name does- not refer to a schema.--}+-- | Look up a schema with the given name. Errors if the name doesn't exist or if the name does+--  not refer to a schema. lookupSchema :: NameLike -> Q ReifiedSchema lookupSchema nameLike = do   name <- lookupSchemaName nameLike@@ -176,11 +175,10 @@  {- TH utilities -} -{- | Same as 'Type' except without any kind signatures or applications at any depth.-- Provides no actual guarantees. The caller is responsible for making sure the value- has been run through 'stripKinds' at one point.--}+-- | Same as 'Type' except without any kind signatures or applications at any depth.+--+--  Provides no actual guarantees. The caller is responsible for making sure the value+--  has been run through 'stripKinds' at one point. type TypeWithoutKinds = Type  {- FOURMOLU_DISABLE -}
src/Data/Aeson/Schema/Type.hs view
@@ -1,16 +1,16 @@ {-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeInType #-} {-# LANGUAGE UndecidableInstances #-} -{- |+{-| Module      :  Data.Aeson.Schema.Type-Maintainer  :  Brandon Chinn <brandon@leapyear.io>+Maintainer  :  Brandon Chinn <brandonchinn178@gmail.com> Stability   :  experimental Portability :  portable @@ -122,13 +122,12 @@  {- Type-level schema types -} -{- | The kind of schemas that may be used with Object; e.g.-- > data Payload (schema :: Schema) = Payload- >   { getPayload :: Object schema- >   , timestamp  :: UTCTime- >   }--}+-- | The kind of schemas that may be used with Object; e.g.+--+--  > data Payload (schema :: Schema) = Payload+--  >   { getPayload :: Object schema+--  >   , timestamp  :: UTCTime+--  >   } type Schema = Schema' Symbol Type  type SchemaType = SchemaType' Symbol Type@@ -141,34 +140,34 @@ type family FromSchema (schema :: Schema) :: SchemaObjectMap where   FromSchema ('Schema schema) = schema -toSchemaV :: forall schema. IsSchemaObjectMap (FromSchema schema) => Proxy schema -> SchemaV+toSchemaV :: forall schema. (IsSchemaObjectMap (FromSchema schema)) => Proxy schema -> SchemaV toSchemaV _ = Schema $ toSchemaTypeMapV $ Proxy @(FromSchema schema) -toSchemaTypeMapV :: forall pairs. IsSchemaObjectMap pairs => Proxy pairs -> SchemaObjectMapV+toSchemaTypeMapV :: forall pairs. (IsSchemaObjectMap pairs) => Proxy pairs -> SchemaObjectMapV toSchemaTypeMapV _ = mapAll @IsSchemaObjectPair @pairs toSchemaTypePairV  class IsSchemaType (schemaType :: SchemaType) where   toSchemaTypeV :: Proxy schemaType -> SchemaTypeV -instance Typeable inner => IsSchemaType ('SchemaScalar inner) where+instance (Typeable inner) => IsSchemaType ('SchemaScalar inner) where   toSchemaTypeV _ = SchemaScalar (NameRef $ tyConName $ typeRepTyCon $ typeRep $ Proxy @inner) -instance IsSchemaType inner => IsSchemaType ('SchemaMaybe inner) where+instance (IsSchemaType inner) => IsSchemaType ('SchemaMaybe inner) where   toSchemaTypeV _ = SchemaMaybe (toSchemaTypeV $ Proxy @inner) -instance IsSchemaType inner => IsSchemaType ('SchemaTry inner) where+instance (IsSchemaType inner) => IsSchemaType ('SchemaTry inner) where   toSchemaTypeV _ = SchemaTry (toSchemaTypeV $ Proxy @inner) -instance IsSchemaType inner => IsSchemaType ('SchemaList inner) where+instance (IsSchemaType inner) => IsSchemaType ('SchemaList inner) where   toSchemaTypeV _ = SchemaList (toSchemaTypeV $ Proxy @inner) -instance All IsSchemaType schemas => IsSchemaType ('SchemaUnion schemas) where+instance (All IsSchemaType schemas) => IsSchemaType ('SchemaUnion schemas) where   toSchemaTypeV _ = SchemaUnion (mapAll @IsSchemaType @schemas toSchemaTypeV) -instance IsSchemaObjectMap pairs => IsSchemaType ('SchemaObject pairs) where+instance (IsSchemaObjectMap pairs) => IsSchemaType ('SchemaObject pairs) where   toSchemaTypeV _ = SchemaObject (toSchemaTypeMapV $ Proxy @pairs) -instance IsSchemaObjectMap (FromSchema schema) => IsSchemaType ('SchemaInclude ('Right schema)) where+instance (IsSchemaObjectMap (FromSchema schema)) => IsSchemaType ('SchemaInclude ('Right schema)) where   toSchemaTypeV _ = toSchemaObjectV $ toSchemaV $ Proxy @schema  type IsSchemaObjectMap (pairs :: SchemaObjectMap) = All IsSchemaObjectPair pairs
src/Data/Aeson/Schema/Utils/All.hs view
@@ -17,13 +17,13 @@  -- | A type family for traversing a type-level list. class All f xs where-  mapAll :: forall a. (forall x. f x => Proxy x -> a) -> [a]+  mapAll :: forall a. (forall x. (f x) => Proxy x -> a) -> [a]   mapAll f = foldrAll @f @xs f' []     where-      f' :: forall x. f x => Proxy x -> [a] -> [a]+      f' :: forall x. (f x) => Proxy x -> [a] -> [a]       f' proxy acc = f proxy : acc -  foldrAll :: (forall x. f x => Proxy x -> a -> a) -> a -> a+  foldrAll :: (forall x. (f x) => Proxy x -> a -> a) -> a -> a  instance All f '[] where   foldrAll _ acc = acc
src/Data/Aeson/Schema/Utils/Invariant.hs view
@@ -2,13 +2,12 @@   unreachable, ) where -{- | An error function to indicate that a branch is unreachable. Provides a useful error message- if it ends up happening, pointing users to write a bug report.--}+-- | An error function to indicate that a branch is unreachable. Provides a useful error message+--  if it ends up happening, pointing users to write a bug report. unreachable :: String -> a unreachable msg =   error $     unlines       [ "`aeson-schemas` internal error: " ++ msg-      , "Please file a bug report at https://github.com/LeapYear/aeson-schemas/issues/"+      , "Please file a bug report at https://github.com/brandonchinn178/aeson-schemas/issues/"       ]
src/Data/Aeson/Schema/Utils/Sum.hs view
@@ -13,9 +13,9 @@ {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} -{- |+{-| Module      :  Data.Aeson.Schema.Utils.Sum-Maintainer  :  Brandon Chinn <brandon@leapyear.io>+Maintainer  :  Brandon Chinn <brandonchinn178@gmail.com> Stability   :  experimental Portability :  portable @@ -33,30 +33,29 @@ import Data.Proxy (Proxy (..)) import GHC.TypeLits (ErrorMessage (..), Nat, TypeError, type (-)) -{- | Represents a sum type.-- Loads the first type that successfully parses the JSON value.-- Example:-- @- data Owl = Owl- data Cat = Cat- data Toad = Toad- type Animal = SumType '[Owl, Cat, Toad]-- Here Owl                         :: Animal- There (Here Cat)                 :: Animal- There (There (Here Toad))        :: Animal-- {\- Fails at compile-time- Here True                        :: Animal- Here Cat                         :: Animal- There (Here Owl)                 :: Animal- There (There (There (Here Owl))) :: Animal- -\}- @--}+-- | Represents a sum type.+--+--  Loads the first type that successfully parses the JSON value.+--+--  Example:+--+--  @+--  data Owl = Owl+--  data Cat = Cat+--  data Toad = Toad+--  type Animal = SumType '[Owl, Cat, Toad]+--+--  Here Owl                         :: Animal+--  There (Here Cat)                 :: Animal+--  There (There (Here Toad))        :: Animal+--+--  {\- Fails at compile-time+--  Here True                        :: Animal+--  Here Cat                         :: Animal+--  There (Here Owl)                 :: Animal+--  There (There (There (Here Owl))) :: Animal+--  -\}+--  @ data SumType (types :: [Type]) where   Here :: forall x xs. x -> SumType (x ': xs)   There :: forall x xs. SumType xs -> SumType (x ': xs)@@ -90,7 +89,7 @@ {- Extracting sum type branches -}  class FromSumType (n :: Nat) (types :: [Type]) (x :: Type) where-  fromSumType' :: 'Just x ~ GetIndex n types => proxy1 n -> SumType types -> Maybe x+  fromSumType' :: ('Just x ~ GetIndex n types) => proxy1 n -> SumType types -> Maybe x  instance {-# OVERLAPPING #-} FromSumType 0 (x ': xs) x where   fromSumType' _ = \case@@ -108,30 +107,29 @@     Here _ -> Nothing     There xs -> fromSumType' (Proxy @(n - 1)) xs -{- | Extract a value from a 'SumType'-- Example:-- @- type Animal = SumType '[Owl, Cat, Toad]- let someAnimal = ... :: Animal-- fromSumType (Proxy :: Proxy 0) someAnimal :: Maybe Owl- fromSumType (Proxy :: Proxy 1) someAnimal :: Maybe Cat- fromSumType (Proxy :: Proxy 2) someAnimal :: Maybe Toad-- -- Compile-time error- -- fromSumType (Proxy :: Proxy 3) someAnimal- @--}+-- | Extract a value from a 'SumType'+--+--  Example:+--+--  @+--  type Animal = SumType '[Owl, Cat, Toad]+--  let someAnimal = ... :: Animal+--+--  fromSumType (Proxy :: Proxy 0) someAnimal :: Maybe Owl+--  fromSumType (Proxy :: Proxy 1) someAnimal :: Maybe Cat+--  fromSumType (Proxy :: Proxy 2) someAnimal :: Maybe Toad+--+--  -- Compile-time error+--  -- fromSumType (Proxy :: Proxy 3) someAnimal+--  @ fromSumType ::   ( IsInRange n types   , 'Just result ~ GetIndex n types   , FromSumType n types result   ) =>-  proxy n ->-  SumType types ->-  Maybe result+  proxy n+  -> SumType types+  -> Maybe result fromSumType = fromSumType'  {- Helpers -}
test/TestUtils.hs view
@@ -51,13 +51,13 @@ class ShowSchemaResult a where   showSchemaResult :: String -instance IsSchema schema => ShowSchemaResult (Object schema) where+instance (IsSchema schema) => ShowSchemaResult (Object schema) where   showSchemaResult = "Object (" ++ Internal.showSchema @schema ++ ")" -instance ShowSchemaResult a => ShowSchemaResult [a] where+instance (ShowSchemaResult a) => ShowSchemaResult [a] where   showSchemaResult = "[" ++ showSchemaResult @a ++ "]" -instance {-# OVERLAPPABLE #-} Typeable a => ShowSchemaResult a where+instance {-# OVERLAPPABLE #-} (Typeable a) => ShowSchemaResult a where   showSchemaResult = show $ typeRep (Proxy @a)  {- Loading JSON data -}@@ -65,10 +65,10 @@ json :: QuasiQuoter json = mkExpQQ $ \s -> [|(either error id . eitherDecode . fromString) s|] -parseValue :: FromJSON a => Value -> a+parseValue :: (FromJSON a) => Value -> a parseValue = either error id . parseEither parseJSON -parseProxy :: FromJSON a => Proxy a -> Value -> Either String a+parseProxy :: (FromJSON a) => Proxy a -> Value -> Either String a parseProxy _ = parseEither parseJSON  parseObject :: String -> ExpQ
test/TestUtils/Arbitrary.hs view
@@ -1,9 +1,11 @@ {-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveLift #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-}+{-# LANGUAGE PolyKinds #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-}@@ -11,7 +13,6 @@ {-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeInType #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wno-orphans #-}@@ -61,11 +62,11 @@  data ArbitraryObject where   ArbitraryObject ::-    IsSchema schema =>-    Proxy (Object schema) ->-    Value ->-    SchemaV ->-    ArbitraryObject+    (IsSchema schema) =>+    Proxy (Object schema)+    -> Value+    -> SchemaV+    -> ArbitraryObject  -- Show the value and schema as something that could be copied/pasted into GHCi. instance Show ArbitraryObject where@@ -76,12 +77,11 @@       , "  [schema| " ++ showSchemaV schemaV ++ " |]"       ] -{- | A Template Haskell function to generate a splice for QuickCheck tests to generate arbitrary- objects with arbitrary schemas.-- Note that for repeated runs of the test suite, the schemas will be the same, with the actual- JSON values generated randomly. You need to recompile in order to generate different schemas.--}+-- | A Template Haskell function to generate a splice for QuickCheck tests to generate arbitrary+--  objects with arbitrary schemas.+--+--  Note that for repeated runs of the test suite, the schemas will be the same, with the actual+--  JSON values generated randomly. You need to recompile in order to generate different schemas. arbitraryObject :: ExpQ arbitraryObject = do   arbitrarySchemas <- runIO $ genSchemaTypes 20@@ -92,12 +92,11 @@       let schemaType = quoteType schema $ showSchemaV schemaV        in [|genSchema' (Proxy :: Proxy (Object $schemaType)) schemaV|] -{- |-Splices to a 'forAll' with 'arbitraryObject', outputting information about the object-generated, to ensure we get good generation.-->>> $(forAllArbitraryObjects) :: Testable prop => ArbitraryObject -> prop--}+-- |+-- Splices to a 'forAll' with 'arbitraryObject', outputting information about the object+-- generated, to ensure we get good generation.+--+-- >>> $(forAllArbitraryObjects) :: Testable prop => ArbitraryObject -> prop forAllArbitraryObjects :: ExpQ forAllArbitraryObjects = [|forAllArbitraryObjects' $arbitraryObject|] @@ -121,9 +120,9 @@   ( ArbitrarySchema ('SchemaObject schema)   , IsSchema ('Schema schema)   ) =>-  Proxy (Object ('Schema schema)) ->-  SchemaV ->-  Gen ArbitraryObject+  Proxy (Object ('Schema schema))+  -> SchemaV+  -> Gen ArbitraryObject genSchema' proxy schemaV = do   v <- genSchema @('SchemaObject schema)   return $ ArbitraryObject proxy v schemaV@@ -191,14 +190,14 @@ instance (Arbitrary inner, ToJSON inner, Typeable inner) => ArbitrarySchema ('SchemaScalar inner) where   genSchema = toJSON <$> arbitrary @inner -instance ArbitrarySchema inner => ArbitrarySchema ('SchemaMaybe inner) where+instance (ArbitrarySchema inner) => ArbitrarySchema ('SchemaMaybe inner) where   genSchema =     frequency       [ (3, genSchema @inner)       , (1, pure Null)       ] -instance ArbitrarySchema inner => ArbitrarySchema ('SchemaTry inner) where+instance (ArbitrarySchema inner) => ArbitrarySchema ('SchemaTry inner) where   genSchema =     frequency       [ (3, genSchema @inner)@@ -213,22 +212,22 @@           , String . Text.pack <$> arbitrary           ] -instance ArbitrarySchema inner => ArbitrarySchema ('SchemaList inner) where+instance (ArbitrarySchema inner) => ArbitrarySchema ('SchemaList inner) where   genSchema = Array . fromList <$> listOf (genSchema @inner) -instance All ArbitrarySchema schemas => ArbitrarySchema ('SchemaUnion schemas) where+instance (All ArbitrarySchema schemas) => ArbitrarySchema ('SchemaUnion schemas) where   genSchema = oneof $ mapAll @ArbitrarySchema @schemas genSchemaElem     where-      genSchemaElem :: forall schema. ArbitrarySchema schema => Proxy schema -> Gen Value+      genSchemaElem :: forall schema. (ArbitrarySchema schema) => Proxy schema -> Gen Value       genSchemaElem _ = genSchema @schema -instance All ArbitraryObjectPair pairs => ArbitrarySchema ('SchemaObject (pairs :: [(SchemaKey, SchemaType)])) where+instance (All ArbitraryObjectPair pairs) => ArbitrarySchema ('SchemaObject (pairs :: [(SchemaKey, SchemaType)])) where   genSchema = Object . Compat.unions <$> genSchemaPairs     where       genSchemaPairs :: Gen [Aeson.Object]       genSchemaPairs = sequence $ mapAll @ArbitraryObjectPair @pairs genSchemaPair -class IsSchemaKey (Fst pair) => ArbitraryObjectPair (pair :: (SchemaKey, SchemaType)) where+class (IsSchemaKey (Fst pair)) => ArbitraryObjectPair (pair :: (SchemaKey, SchemaType)) where   genSchemaPair :: Proxy pair -> Gen Aeson.Object   genSchemaPair _ = toContext schemaKey <$> genInnerSchema @pair     where@@ -284,14 +283,13 @@ instance Arbitrary SchemaV where   arbitrary = Schema <$> sized genSchemaObject -{- | Generate an arbitrary schema.-- SchemaType is a recursive definition, so we want to make sure that generating a schema will- terminate, and also not take too long. The ways we account for that are:-  * Providing an upper bound on the depth of any object schemas in the current object (n / 2)-  * Providing an upper bound on the number of keys in the current object (n / 3)-  * Providing an upper bound on the number of schemas in a union (n / 5)--}+-- | Generate an arbitrary schema.+--+--  SchemaType is a recursive definition, so we want to make sure that generating a schema will+--  terminate, and also not take too long. The ways we account for that are:+--   * Providing an upper bound on the depth of any object schemas in the current object (n / 2)+--   * Providing an upper bound on the number of keys in the current object (n / 3)+--   * Providing an upper bound on the number of schemas in a union (n / 5) genSchemaObject :: Int -> Gen SchemaObjectMapV genSchemaObject n = do   keys <- genUniqList1 (n `div` 3) genKey@@ -346,17 +344,15 @@     -- avoid generating big unions by scaling list length     genSchemaUnion gen = SchemaUnion <$> genUniqList1 (n `div` 5) gen -{- | Generate a valid JSON key- See Data.Aeson.Schema.TH.Parse.jsonKey'--}+-- | Generate a valid JSON key+--  See Data.Aeson.Schema.TH.Parse.jsonKey' genKey :: Gen String genKey = listOf1 $ arbitraryPrintableChar `suchThat` (`notElem` " \"\\!?[](),.@:{}#") -{- | Generate a non-empty and unique list of the given generator.-- Takes in the max size of the list.--}-genUniqList1 :: Eq a => Int -> Gen a -> Gen [a]+-- | Generate a non-empty and unique list of the given generator.+--+--  Takes in the max size of the list.+genUniqList1 :: (Eq a) => Int -> Gen a -> Gen [a] genUniqList1 n gen = do   k <- choose (1, max 1 n)   take k . nub <$> infiniteListOf gen
test/Tests/GetQQ.hs view
@@ -393,6 +393,7 @@         [getErr| o.[a,b].foo |]     ] +{- HLINT ignore testCompileTimeErrors "Evaluate" -} testCompileTimeErrors :: TestTree testCompileTimeErrors =   testGroup "Compile-time errors" . map mkIntegrationTest $
test/Tests/GetQQ/TH.hs view
@@ -31,10 +31,9 @@     , reifyInfo = []     } -{- | Run the `get` quasiquoter at both runtime and compile-time, to get coverage.-- The `get` Quasiquoter doesn't reify anything, so this should work.--}+-- | Run the `get` quasiquoter at both runtime and compile-time, to get coverage.+--+--  The `get` Quasiquoter doesn't reify anything, so this should work. runGet :: QuasiQuoter runGet = mkExpQQ $ \s -> [|runTestQ qState (quoteExp get s) `deepseq` $(quoteExp get s)|]
test/Tests/Object/FromJSON.hs view
@@ -157,24 +157,24 @@ data FromJSONTestCase where   CheckValid ::     (Arbitrary a, Show a, FromJSON (Object schema)) =>-    -- | Name of test case-    TestName ->-    -- | The schema to parse with-    Proxy (Object schema) ->-    -- | A function that builds a Value that should satisfy the schema-    (a -> Value) ->-    FromJSONTestCase+    TestName+    -- ^ Name of test case+    -> Proxy (Object schema)+    -- ^ The schema to parse with+    -> (a -> Value)+    -- ^ A function that builds a Value that should satisfy the schema+    -> FromJSONTestCase   CheckError ::     (FromJSON (Object schema), Show (Object schema)) =>-    -- | Name of test case-    TestName ->-    -- | Name of golden file-    String ->-    -- | The schema to parse with-    Proxy (Object schema) ->-    -- | The value that should fail parsing the given schema-    Value ->-    FromJSONTestCase+    TestName+    -- ^ Name of test case+    -> String+    -- ^ Name of golden file+    -> Proxy (Object schema)+    -- ^ The schema to parse with+    -> Value+    -- ^ The value that should fail parsing the given schema+    -> FromJSONTestCase  runTestCase :: FromJSONTestCase -> TestTree runTestCase = \case@@ -189,5 +189,5 @@         Right o -> error $ "Unexpectedly parsed: " ++ show o         Left e -> e -parse :: FromJSON a => Proxy a -> Value -> Either String a+parse :: (FromJSON a) => Proxy a -> Value -> Either String a parse _ = parseEither parseJSON
test/Tests/Object/ToJSON.hs view
@@ -26,10 +26,10 @@ {- Realizing Aeson.Parser -}  -- We're defining two Parsers to be equivalent if they evaluate to the same result.-instance Eq a => Eq (Aeson.Parser a) where+instance (Eq a) => Eq (Aeson.Parser a) where   a == b = runParser a == runParser b -instance Show a => Show (Aeson.Parser a) where+instance (Show a) => Show (Aeson.Parser a) where   show = show . runParser  runParser :: Aeson.Parser a -> Aeson.Result a
test/Tests/SchemaQQ/TH.hs view
@@ -73,10 +73,9 @@          )     } -{- | A quasiquoter for generating the string representation of a schema.-- Also runs the `schema` quasiquoter at runtime, to get coverage information.--}+-- | A quasiquoter for generating the string representation of a schema.+--+--  Also runs the `schema` quasiquoter at runtime, to get coverage information. schemaRep :: QuasiQuoter schemaRep = mkExpQQ $ \s ->   let schemaType = quoteType schema s
test/Tests/SumType.hs view
@@ -17,10 +17,10 @@  type SpecialJSON = SumType '[Bool, Int, [String]] -toSpecialJSON :: ToJSON a => a -> SpecialJSON+toSpecialJSON :: (ToJSON a) => a -> SpecialJSON toSpecialJSON = either (error . ("Invalid SpecialJSON: " ++) . show) id . toSpecialJSON' -toSpecialJSON' :: ToJSON a => a -> Either String SpecialJSON+toSpecialJSON' :: (ToJSON a) => a -> Either String SpecialJSON toSpecialJSON' = eitherDecode . encode  {- Tests -}
test/Tests/UnwrapQQ/TH.hs view
@@ -91,10 +91,9 @@          )     } -{- | A quasiquoter for generating the string representation of an unwrapped schema.-- Also runs the `unwrap` quasiquoter at runtime, to get coverage information.--}+-- | A quasiquoter for generating the string representation of an unwrapped schema.+--+--  Also runs the `unwrap` quasiquoter at runtime, to get coverage information. unwrapRep :: QuasiQuoter unwrapRep = mkExpQQ $ \s ->   let showSchemaResultQ = appTypeE [|showSchemaResult|] (quoteType unwrap s)