char and string instances

autodocodec-aeson/src/Autodocodec/Aeson/Decode.hs

@@ -7,6 +7,7 @@ import Autodocodec
 import Control.Applicative
 import Data.Aeson as JSON
 import Data.Aeson.Types as JSON
+import Data.Foldable
 
 parseJSONViaCodec :: HasCodec a => JSON.Value -> JSON.Parser a
 parseJSONViaCodec = parseJSONVia codec
@@ -20,8 +21,14 @@ parseJSONVia = flip go
       BoolCodec -> parseJSON value
       StringCodec -> parseJSON value
       NumberCodec -> parseJSON value
+      ArrayCodec c -> withArray "TODO" (\a -> toList <$> mapM (`go` c) a) value
       ObjectCodec c -> withObject "TODO" (\o -> goObject o c) value
       BimapCodec f _ c -> f <$> go value c
+      EitherCodec f _ c -> do
+        old <- go value c
+        case f old of
+          Left err -> fail err -- TODO better error message location?
+          Right new -> pure new
       SelectCodec c1 c2 -> (Left <$> go value c1) <|> (Right <$> go value c2)
 
     goObject :: JSON.Object -> ObjectCodec void a -> JSON.Parser a

autodocodec-aeson/src/Autodocodec/Aeson/Document.hs

@@ -23,6 +23,7 @@ data JSONSchema
   | BoolSchema
   | StringSchema
   | NumberSchema
+  | ArraySchema JSONSchema
   | ObjectSchema !JSONObjectSchema
   | ChoiceSchema ![JSONSchema]
   deriving (Show, Eq, Generic)
@@ -40,7 +41,7 @@ instance ToJSON JSONSchema where
     BoolSchema -> JSON.object ["type" JSON..= ("boolean" :: Text)]
     StringSchema -> JSON.object ["type" JSON..= ("string" :: Text)]
     NumberSchema -> JSON.object ["type" JSON..= ("number" :: Text)]
-    ChoiceSchema jcs -> JSON.object ["anyOf" JSON..= jcs]
+    ArraySchema s -> JSON.object ["type" JSON..= ("array" :: Text), "items" JSON..= s]
     ObjectSchema os ->
       let go = \case
             AnyObjectSchema -> ([], [])
@@ -62,6 +63,7 @@ instance ToJSON JSONSchema where
                   "properties" JSON..= ps,
                   "required" JSON..= rps
                 ]
+    ChoiceSchema jcs -> JSON.object ["anyOf" JSON..= jcs]
 
 instance FromJSON JSONSchema where
   parseJSON = JSON.withObject "JSONSchema" $ \o -> do
@@ -105,9 +107,11 @@ jsonSchemaVia = go
       BoolCodec -> BoolSchema
       StringCodec -> StringSchema
       NumberCodec -> NumberSchema
+      ArrayCodec c -> ArraySchema (go c)
       ObjectCodec oc -> ObjectSchema (goObject oc)
       BimapCodec _ _ c -> go c
       SelectCodec c1 c2 -> ChoiceSchema [go c1, go c2]
+      EitherCodec _ _ c -> go c
 
     goObject :: ObjectCodec input output -> JSONObjectSchema
     goObject = \case

autodocodec-aeson/src/Autodocodec/Aeson/Encode.hs

@@ -21,8 +21,10 @@ toJSONVia = flip go
       BoolCodec -> toJSON (a :: Bool)
       StringCodec -> toJSON (a :: Text)
       NumberCodec -> toJSON (a :: Scientific)
+      ArrayCodec c -> toJSON (map (`go` c) a)
       ObjectCodec oc -> JSON.Object (goObject a oc)
       BimapCodec _ g c -> go (g a) c
+      EitherCodec _ g c -> go (g a) c
       SelectCodec c1 c2 -> case a of
         Left a1 -> go a1 c1
         Right a2 -> go a2 c2

autodocodec-aeson/test/Autodocodec/Aeson/DocumentSpec.hs

@@ -22,7 +22,9 @@ import Test.Syd.Validity.Utils
 spec :: Spec
 spec = do
   jsonSchemaSpec @Bool "bool"
+  jsonSchemaSpec @Char "char"
   jsonSchemaSpec @Text "text"
+  jsonSchemaSpec @String "string"
   jsonSchemaSpec @Scientific "scientific"
   jsonSchemaSpec @(Either Bool Text) "either-bool-text"
   jsonSchemaSpec @(Either (Either Bool Scientific) Text) "either-either-bool-scientific-text"

autodocodec-aeson/test/Autodocodec/AesonSpec.hs

@@ -12,6 +12,7 @@ import Autodocodec.Aeson
 import Data.Aeson (FromJSON (..), ToJSON (..))
 import qualified Data.Aeson as JSON
 import qualified Data.Aeson.Types as JSON
+import Data.Data
 import Data.GenValidity
 import Data.GenValidity.Scientific ()
 import Data.GenValidity.Text ()
@@ -20,10 +21,14 @@ import Data.Text (Text)
 import GHC.Generics (Generic)
 import Test.Syd
 import Test.Syd.Validity
+import Test.Syd.Validity.Utils
 
 spec :: Spec
 spec = do
   aesonCodecSpec @Bool
+  -- Does not hold
+  -- aesonCodecSpec @Char
+  -- aesonCodecSpec @String
   aesonCodecSpec @Text
   aesonCodecSpec @Scientific
   aesonCodecSpec @(Either Text Bool)
@@ -61,7 +66,7 @@ instance FromJSON Example where
       <$> o JSON..: "text"
       <*> o JSON..: "bool"
 
-aesonCodecSpec :: forall a. (Show a, Eq a, GenValid a, ToJSON a, FromJSON a, HasCodec a) => Spec
+aesonCodecSpec :: forall a. (Show a, Eq a, Typeable a, GenValid a, ToJSON a, FromJSON a, HasCodec a) => Spec
 aesonCodecSpec = do
   it "matches the aeson encoding" $
     forAllValid $ \(a :: a) ->
@@ -72,9 +77,9 @@ aesonCodecSpec = do
        in JSON.parseEither (parseJSONViaCodec @a) encoded `shouldBe` JSON.parseEither (parseJSON @a) encoded
   codecSpec @a
 
-codecSpec :: forall a. (Show a, Eq a, GenValid a, ToJSON a, HasCodec a) => Spec
+codecSpec :: forall a. (Show a, Eq a, Typeable a, GenValid a, ToJSON a, HasCodec a) => Spec
 codecSpec = do
-  it "roundtrips" $
+  it (nameOf @a <> " roundtrips") $
     forAllValid $ \(a :: a) ->
       let encoded = toJSONViaCodec a
           errOrDecoded = JSON.parseEither parseJSONViaCodec encoded

autodocodec-aeson/test_resources/schema/char.json

@@ -0,0 +1,3 @@
+{
+    "type": "string"
+}

autodocodec-aeson/test_resources/schema/string.json

@@ -0,0 +1,3 @@
+{
+    "type": "string"
+}

autodocodec/src/Autodocodec/Class.hs

@@ -1,21 +1,45 @@
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
 
 module Autodocodec.Class where
 
 import Autodocodec.Codec
+import Data.Int
 import Data.Scientific
 import Data.Text (Text)
+import Data.Word
 
 class HasCodec a where
+  -- | A codec for a single value
+  --
+  -- See the sections on helper functions for implementing this for plenty of examples.
   codec :: Codec a a
 
+  -- | A codec for a list of values
+  --
+  -- This is really only useful for cases like 'Char' and 'String'
+  listCodec :: Codec [a] [a]
+  listCodec = ArrayCodec codec
+
 field :: HasCodec output => Text -> ObjectCodec output output
 field k = KeyCodec k codec
 
 instance HasCodec Bool where
   codec = boolCodec
 
+instance HasCodec Char where
+  codec =
+    let parseChar = \case
+          [] -> Left "Expected exactly 1 character, but got none."
+          [c] -> Right c
+          _ -> Left "Expected exactly 1 character, but got more."
+     in EitherCodec parseChar (: []) stringCodec
+  listCodec = stringCodec
+
+instance HasCodec String where
+  codec = listCodec
+
 instance HasCodec Text where
   codec = textCodec
 

autodocodec/src/Autodocodec/Codec.hs

@@ -10,12 +10,15 @@ import Data.List.NonEmpty (NonEmpty (..))
 import qualified Data.List.NonEmpty as NE
 import Data.Scientific
 import Data.Text (Text)
+import qualified Data.Text as T
 
 data Codec input output where
   NullCodec :: Codec () ()
   BoolCodec :: Codec Bool Bool
   StringCodec :: Codec Text Text
   NumberCodec :: Codec Scientific Scientific -- TODO can we do this without scientific?
+  -- TODO use a vector here because that's what aeson uses.
+  ArrayCodec :: Codec input output -> Codec [input] [output]
   ObjectCodec ::
     ObjectCodec value value ->
     Codec value value
@@ -26,6 +29,13 @@ data Codec input output where
     Codec oldInput oldOutput ->
     Codec newInput newOutput
   SelectCodec :: Codec input1 output1 -> Codec input2 output2 -> Codec (Either input1 input2) (Either output1 output2)
+  -- For parsing with potential errors
+  -- TODO: maybe we want to get rid of bimap and implement it in terms of this?
+  EitherCodec ::
+    (oldOutput -> Either String newOutput) ->
+    (newInput -> oldInput) ->
+    Codec oldInput oldOutput ->
+    Codec newInput newOutput
 
 choiceCodec :: NonEmpty (Codec input output) -> Codec input output
 choiceCodec (c1 :| rest) = case NE.nonEmpty rest of
@@ -89,6 +99,9 @@ boolCodec = BoolCodec
 textCodec :: Codec Text Text
 textCodec = StringCodec
 
+stringCodec :: Codec String String
+stringCodec = BimapCodec T.unpack T.pack StringCodec
+
 scientificCodec :: Codec Scientific Scientific
 scientificCodec = NumberCodec