Docs, docs, and more docs

autodocodec-yaml/autodocodec-yaml.cabal

@@ -32,6 +32,7 @@ library
       autodocodec
     , autodocodec-aeson
     , base >=4.7 && <5
+    , bytestring
     , containers
     , mtl
     , safe-coloured-text

autodocodec-yaml/package.yaml

@@ -16,6 +16,7 @@ library:
   dependencies:
   - autodocodec
   - autodocodec-aeson
+  - bytestring
   - containers
   - mtl
   - safe-coloured-text

autodocodec-yaml/src/Autodocodec/Yaml/Document.hs

@@ -9,6 +9,7 @@ module Autodocodec.Yaml.Document where
 import Autodocodec
 import Autodocodec.Aeson
 import Control.Monad.State
+import Data.ByteString (ByteString)
 import Data.List.NonEmpty (NonEmpty (..))
 import Data.Set (Set)
 import qualified Data.Set as S
@@ -19,6 +20,18 @@ import qualified Data.Text.Encoding.Error as TE
 import Data.Yaml as Yaml
 import Text.Colour
 
+renderColouredSchemaViaCodec :: forall a. HasCodec a => ByteString
+renderColouredSchemaViaCodec = renderColouredSchemaVia (codec @a)
+
+renderColouredSchemaVia :: ValueCodec input output -> ByteString
+renderColouredSchemaVia = renderChunksBS With24BitColours . schemaChunksVia
+
+renderPlainSchemaViaCodec :: forall a. HasCodec a => ByteString
+renderPlainSchemaViaCodec = renderPlainSchemaVia (codec @a)
+
+renderPlainSchemaVia :: ValueCodec input output -> ByteString
+renderPlainSchemaVia = renderChunksBS WithoutColours . schemaChunksVia
+
 schemaChunksViaCodec :: forall a. HasCodec a => [Chunk]
 schemaChunksViaCodec = schemaChunksVia (codec @a)
 

autodocodec/src/Autodocodec.hs

@@ -1,31 +1,12 @@
+{-# OPTIONS_GHC -fno-warn-duplicate-exports #-}
+
 module Autodocodec
   ( -- * Codec
     JSONCodec,
-    ValueCodec,
-    ObjectCodec,
     HasCodec (..),
 
     -- * Writing a codec
     object,
-    dimapCodec,
-    (.=),
-    eitherCodec,
-    maybeCodec,
-    (<?>),
-    (<??>),
-    nullCodec,
-    boolCodec,
-    textCodec,
-    stringCodec,
-    scientificCodec,
-    boundedIntegerCodec,
-    literalText,
-    literalTextValue,
-    shownBoundedEnumCodec,
-    stringConstCodec,
-    enumCodec,
-    matchChoicesCodec,
-    matchChoiceCodec,
 
     -- ** Field codecs
     requiredField,
@@ -47,10 +28,41 @@ module Autodocodec
     optionalFieldOrNullWith',
     optionalFieldWithDefaultWith',
 
-    -- * Bare codec
-    Codec (..),
+    -- ** Writing your own value codecs.
+    (<?>),
+    (<??>),
+    (.=),
+    maybeCodec,
+    eitherCodec,
+    arrayCodec,
+    listCodec,
+    valueCodec,
+    nullCodec,
+    boolCodec,
+    textCodec,
+    stringCodec,
+    scientificCodec,
+    boundedIntegerCodec,
+    literalText,
+    literalTextValue,
+
+    -- *** Mapping
     rmapCodec,
     lmapCodec,
+    dimapCodec,
+    bimapCodec,
+
+    -- *** Enums
+    shownBoundedEnumCodec,
+    stringConstCodec,
+    enumCodec,
+    matchChoicesCodec,
+    matchChoiceCodec,
+
+    -- * Bare codec
+    Codec (..),
+    ValueCodec,
+    ObjectCodec,
     pureCodec,
     apCodec,
 

autodocodec/src/Autodocodec/Class.hs

@@ -12,7 +12,6 @@ import Data.Int
 import Data.Scientific
 import Data.Text (Text)
 import qualified Data.Text.Lazy as LT
-import qualified Data.Vector as V
 import Data.Word
 
 class HasCodec a where
@@ -24,8 +23,8 @@ class HasCodec a where
   -- | A codec for a list of values
   --
   -- This is really only useful for cases like 'Char' and 'String'
-  listCodec :: JSONCodec [a]
-  listCodec = dimapCodec V.toList V.fromList $ ArrayCodec Nothing codec
+  listCodecForStringCompatibility :: JSONCodec [a]
+  listCodecForStringCompatibility = listCodec codec
 
   {-# MINIMAL codec #-}
 
@@ -42,7 +41,7 @@ instance HasCodec Char where
           [c] -> Right c
           _ -> Left "Expected exactly 1 character, but got more."
      in MapCodec parseChar (: []) stringCodec
-  listCodec = stringCodec
+  listCodecForStringCompatibility = stringCodec
 
 instance HasCodec Text where
   codec = textCodec
@@ -96,7 +95,7 @@ instance (HasCodec l, HasCodec r) => HasCodec (Either l r) where
       (ObjectCodec Nothing (requiredField' "Right"))
 
 instance HasCodec a => HasCodec [a] where
-  codec = listCodec
+  codec = listCodecForStringCompatibility
 
 -- | A required field
 --

autodocodec/src/Autodocodec/Codec.hs

@@ -16,6 +16,7 @@ import qualified Data.Set as S
 import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Vector (Vector)
+import qualified Data.Vector as V
 
 -- | A Self-documenting encoder and decoder,
 --
@@ -201,6 +202,16 @@ type ValueCodec = Codec JSON.Value
 type ObjectCodec = Codec JSON.Object
 
 -- | A completed autodocodec
+--
+-- Note that a value of this type does nothing by itself.
+-- You will need a companion library to make something happen.
+--
+-- For example:
+--
+-- * Encode values to JSON using 'toJSONViaCodec' from @autodocodec-aeson@
+-- * Decode values from JSON using 'parseJSONViaCodec' from @autodocodec-aeson@
+-- * Produce a JSON Schema using 'jsonSchemaViaCodec' from @autodocodec-aeson@
+-- * Produce a human-readible YAML schema using @renderColouredSchemaViaCodec@ from @autodocodec-yaml@
 type JSONCodec a = ValueCodec a a
 
 -- | Show a codec to a human.
@@ -249,7 +260,7 @@ rmapCodec ::
   (oldOutput -> newOutput) ->
   Codec context input oldOutput ->
   Codec context input newOutput
-rmapCodec f = MapCodec (Right . f) id
+rmapCodec f = dimapCodec f id
 
 instance Functor (Codec context input) where
   fmap = rmapCodec
@@ -266,7 +277,7 @@ lmapCodec ::
   (newInput -> oldInput) ->
   Codec context oldInput output ->
   Codec context newInput output
-lmapCodec g = MapCodec Right g
+lmapCodec g = dimapCodec id g
 
 -- | Infix version of 'lmapCodec'
 --
@@ -297,7 +308,7 @@ dimapCodec ::
   (newInput -> oldInput) ->
   Codec context oldInput oldOutput ->
   Codec context newInput newOutput
-dimapCodec f g = MapCodec (Right . f) g
+dimapCodec f g = bimapCodec (Right . f) g
 
 -- | Forward-compatible version of 'PureCodec'
 --
@@ -315,15 +326,6 @@ instance Applicative (ObjectCodec input) where
   pure = pureCodec
   (<*>) = apCodec
 
--- | Forward-compatible version of 'EitherCodec'
---
--- > eitherCodec = EitherCodec
-eitherCodec ::
-  ValueCodec input1 output1 ->
-  ValueCodec input2 output2 ->
-  ValueCodec (Either input1 input2) (Either output1 output2)
-eitherCodec = EitherCodec
-
 -- | Also allow @null@ during decoding of a 'Maybe' value.
 --
 -- During decoding, also accept a @null@ value as 'Nothing'.
@@ -338,6 +340,33 @@ maybeCodec = dimapCodec f g . EitherCodec nullCodec
       Nothing -> Left ()
       Just r -> Right r
 
+-- | Forward-compatible version of 'EitherCodec'
+--
+-- > eitherCodec = EitherCodec
+eitherCodec ::
+  ValueCodec input1 output1 ->
+  ValueCodec input2 output2 ->
+  ValueCodec (Either input1 input2) (Either output1 output2)
+eitherCodec = EitherCodec
+
+-- | Map a codec's input and output types.
+--
+-- This function allows you to have the parsing fail in a new way.
+bimapCodec ::
+  (oldOutput -> Either String newOutput) ->
+  (newInput -> oldInput) ->
+  Codec context oldInput oldOutput ->
+  Codec context newInput newOutput
+bimapCodec = MapCodec
+
+-- | Forward-compatible version of 'ArrayCodec' without a name
+arrayCodec :: ValueCodec input output -> ValueCodec (Vector input) (Vector output)
+arrayCodec = ArrayCodec Nothing
+
+-- | Build a codec for lists of values from a codec for a single value.
+listCodec :: ValueCodec input output -> ValueCodec [input] [output]
+listCodec = dimapCodec V.toList V.fromList . arrayCodec
+
 -- | A required field
 --
 -- During decoding, the field must be in the object.
@@ -463,6 +492,17 @@ optionalFieldOrNullWith' key c = orNullHelper $ OptionalKeyCodec key (maybeCodec
   ValueCodec input output
 (<??>) c ls = CommentCodec (T.unlines ls) c
 
+-- | Forward-compatible version of 'ValueCodec'
+--
+-- > valueCodec = ValueCodec
+--
+-- This is essentially your escape-hatch for when you would normally need a monad instance for 'Codec'.
+-- You can build monad parsing by using 'valueCodec' together with 'bimapCodec' and supplying your own parsing function.
+--
+-- Note that this _does_ mean that the documentation will just say that you are parsing and rendering a value, so you may want to document the extra parsing further using '<?>'.
+valueCodec :: JSONCodec JSON.Value
+valueCodec = ValueCodec
+
 -- | Forward-compatible version of 'NullCodec'
 --
 -- > nullCodec = NullCodec