{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

module Data.NestedText.To where

import Control.Monad (forM)
import Data.Bifunctor (Bifunctor(first))
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString.Short as SBS
import Data.Kind (Type)
import qualified Data.Map as M
import qualified Data.Text as TS
import qualified Data.Text.Encoding as TE
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Short as ST
import qualified Data.Vector as V
import Data.Void (Void)
import Generic.Data

import Data.NestedText.Type

class ToItem a where
  type ToItemError a :: Type
  toItem :: a -> Either (ToItemError a) Item
class ToKey a where
  type ToKeyError a :: Type
  toKey :: a -> Either (ToKeyError a) Key

instance ToItem Item where
  type ToItemError Item = Void
  toItem :: Item -> Either (ToItemError Item) Item
toItem = Item -> Either Void Item
Item -> Either (ToItemError Item) Item
forall a b. b -> Either a b
Right

data ToItemError'Text
  = ToItemError'Text'Utf8Error
  deriving ((forall x. ToItemError'Text -> Rep ToItemError'Text x)
-> (forall x. Rep ToItemError'Text x -> ToItemError'Text)
-> Generic ToItemError'Text
forall x. Rep ToItemError'Text x -> ToItemError'Text
forall x. ToItemError'Text -> Rep ToItemError'Text x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ToItemError'Text -> Rep ToItemError'Text x
from :: forall x. ToItemError'Text -> Rep ToItemError'Text x
$cto :: forall x. Rep ToItemError'Text x -> ToItemError'Text
to :: forall x. Rep ToItemError'Text x -> ToItemError'Text
Generic, ToItemError'Text -> ToItemError'Text -> Bool
(ToItemError'Text -> ToItemError'Text -> Bool)
-> (ToItemError'Text -> ToItemError'Text -> Bool)
-> Eq ToItemError'Text
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ToItemError'Text -> ToItemError'Text -> Bool
== :: ToItemError'Text -> ToItemError'Text -> Bool
$c/= :: ToItemError'Text -> ToItemError'Text -> Bool
/= :: ToItemError'Text -> ToItemError'Text -> Bool
Eq, Int -> ToItemError'Text -> ShowS
[ToItemError'Text] -> ShowS
ToItemError'Text -> String
(Int -> ToItemError'Text -> ShowS)
-> (ToItemError'Text -> String)
-> ([ToItemError'Text] -> ShowS)
-> Show ToItemError'Text
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ToItemError'Text -> ShowS
showsPrec :: Int -> ToItemError'Text -> ShowS
$cshow :: ToItemError'Text -> String
show :: ToItemError'Text -> String
$cshowList :: [ToItemError'Text] -> ShowS
showList :: [ToItemError'Text] -> ShowS
Show)

instance ToItem BS.ByteString where
  type ToItemError BS.ByteString = ToItemError'Text
  toItem :: ByteString -> Either (ToItemError ByteString) Item
toItem ByteString
bs = (Text -> Item)
-> Either (ToItemError ByteString) Text
-> Either (ToItemError ByteString) Item
forall a b.
(a -> b)
-> Either (ToItemError ByteString) a
-> Either (ToItemError ByteString) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Item
Item'String
    (Either (ToItemError ByteString) Text
 -> Either (ToItemError ByteString) Item)
-> Either (ToItemError ByteString) Text
-> Either (ToItemError ByteString) Item
forall a b. (a -> b) -> a -> b
$ (UnicodeException -> ToItemError ByteString)
-> Either UnicodeException Text
-> Either (ToItemError ByteString) Text
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (ToItemError'Text -> UnicodeException -> ToItemError'Text
forall a b. a -> b -> a
const ToItemError'Text
ToItemError'Text'Utf8Error) (Either UnicodeException Text
 -> Either (ToItemError ByteString) Text)
-> Either UnicodeException Text
-> Either (ToItemError ByteString) Text
forall a b. (a -> b) -> a -> b
$ ByteString -> Either UnicodeException Text
TE.decodeUtf8' ByteString
bs
instance ToItem BL.ByteString where
  type ToItemError BL.ByteString = ToItemError'Text
  toItem :: ByteString -> Either (ToItemError ByteString) Item
toItem ByteString
bs = (Text -> Item)
-> Either (ToItemError ByteString) Text
-> Either (ToItemError ByteString) Item
forall a b.
(a -> b)
-> Either (ToItemError ByteString) a
-> Either (ToItemError ByteString) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Item
Item'String
    (Either (ToItemError ByteString) Text
 -> Either (ToItemError ByteString) Item)
-> Either (ToItemError ByteString) Text
-> Either (ToItemError ByteString) Item
forall a b. (a -> b) -> a -> b
$ (UnicodeException -> ToItemError ByteString)
-> Either UnicodeException Text
-> Either (ToItemError ByteString) Text
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (ToItemError'Text -> UnicodeException -> ToItemError'Text
forall a b. a -> b -> a
const ToItemError'Text
ToItemError'Text'Utf8Error) (Either UnicodeException Text
 -> Either (ToItemError ByteString) Text)
-> Either UnicodeException Text
-> Either (ToItemError ByteString) Text
forall a b. (a -> b) -> a -> b
$ ByteString -> Either UnicodeException Text
TE.decodeUtf8' (ByteString -> Either UnicodeException Text)
-> ByteString -> Either UnicodeException Text
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BL.toStrict ByteString
bs
instance ToItem TS.Text where
  type ToItemError TS.Text = Void
  toItem :: Text -> Either (ToItemError Text) Item
toItem = Item -> Either Void Item
forall a b. b -> Either a b
Right (Item -> Either Void Item)
-> (Text -> Item) -> Text -> Either Void Item
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Item
Item'String
instance ToItem TL.Text where
  type ToItemError TL.Text = Void
  toItem :: Text -> Either (ToItemError Text) Item
toItem = Item -> Either Void Item
forall a b. b -> Either a b
Right (Item -> Either Void Item)
-> (Text -> Item) -> Text -> Either Void Item
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Item
Item'String (Text -> Item) -> (Text -> Text) -> Text -> Item
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
TL.toStrict

data ToItemError'List a
  = ToItemError'List'ElementError (ToItemError a)
  deriving ((forall x. ToItemError'List a -> Rep (ToItemError'List a) x)
-> (forall x. Rep (ToItemError'List a) x -> ToItemError'List a)
-> Generic (ToItemError'List a)
forall x. Rep (ToItemError'List a) x -> ToItemError'List a
forall x. ToItemError'List a -> Rep (ToItemError'List a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (ToItemError'List a) x -> ToItemError'List a
forall a x. ToItemError'List a -> Rep (ToItemError'List a) x
$cfrom :: forall a x. ToItemError'List a -> Rep (ToItemError'List a) x
from :: forall x. ToItemError'List a -> Rep (ToItemError'List a) x
$cto :: forall a x. Rep (ToItemError'List a) x -> ToItemError'List a
to :: forall x. Rep (ToItemError'List a) x -> ToItemError'List a
Generic)
instance Eq (ToItemError a) => Eq (ToItemError'List a) where
  == :: ToItemError'List a -> ToItemError'List a -> Bool
(==) = ToItemError'List a -> ToItemError'List a -> Bool
forall a. (Generic a, Eq (Rep a ())) => a -> a -> Bool
geq
instance Show (ToItemError a) => Show (ToItemError'List a) where
  showsPrec :: Int -> ToItemError'List a -> ShowS
showsPrec = Int -> ToItemError'List a -> ShowS
forall a. (Generic a, GShow0 (Rep a)) => Int -> a -> ShowS
gshowsPrec

instance ToItem a => ToItem [a] where
  type ToItemError [a] = ToItemError'List a
  toItem :: [a] -> Either (ToItemError [a]) Item
toItem [a]
xs = Vector Item -> Item
Item'List (Vector Item -> Item)
-> Either (ToItemError'List a) (Vector Item)
-> Either (ToItemError'List a) Item
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector a
-> (a -> Either (ToItemError'List a) Item)
-> Either (ToItemError'List a) (Vector Item)
forall (m :: * -> *) a b.
Monad m =>
Vector a -> (a -> m b) -> m (Vector b)
V.forM ([a] -> Vector a
forall a. [a] -> Vector a
V.fromList [a]
xs)
   ((ToItemError a -> ToItemError'List a)
-> Either (ToItemError a) Item -> Either (ToItemError'List a) Item
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ToItemError a -> ToItemError'List a
forall a. ToItemError a -> ToItemError'List a
ToItemError'List'ElementError (Either (ToItemError a) Item -> Either (ToItemError'List a) Item)
-> (a -> Either (ToItemError a) Item)
-> a
-> Either (ToItemError'List a) Item
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either (ToItemError a) Item
forall a. ToItem a => a -> Either (ToItemError a) Item
toItem)
instance ToItem a => ToItem (V.Vector a) where
  type ToItemError (V.Vector a) = ToItemError'List a
  toItem :: Vector a -> Either (ToItemError (Vector a)) Item
toItem Vector a
xs = Vector Item -> Item
Item'List (Vector Item -> Item)
-> Either (ToItemError'List a) (Vector Item)
-> Either (ToItemError'List a) Item
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector a
-> (a -> Either (ToItemError'List a) Item)
-> Either (ToItemError'List a) (Vector Item)
forall (m :: * -> *) a b.
Monad m =>
Vector a -> (a -> m b) -> m (Vector b)
V.forM Vector a
xs
   ((ToItemError a -> ToItemError'List a)
-> Either (ToItemError a) Item -> Either (ToItemError'List a) Item
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ToItemError a -> ToItemError'List a
forall a. ToItemError a -> ToItemError'List a
ToItemError'List'ElementError (Either (ToItemError a) Item -> Either (ToItemError'List a) Item)
-> (a -> Either (ToItemError a) Item)
-> a
-> Either (ToItemError'List a) Item
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either (ToItemError a) Item
forall a. ToItem a => a -> Either (ToItemError a) Item
toItem)

data ToKeyError'Text
  = ToKeyError'Text'Utf8Error
  deriving ((forall x. ToKeyError'Text -> Rep ToKeyError'Text x)
-> (forall x. Rep ToKeyError'Text x -> ToKeyError'Text)
-> Generic ToKeyError'Text
forall x. Rep ToKeyError'Text x -> ToKeyError'Text
forall x. ToKeyError'Text -> Rep ToKeyError'Text x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ToKeyError'Text -> Rep ToKeyError'Text x
from :: forall x. ToKeyError'Text -> Rep ToKeyError'Text x
$cto :: forall x. Rep ToKeyError'Text x -> ToKeyError'Text
to :: forall x. Rep ToKeyError'Text x -> ToKeyError'Text
Generic, ToKeyError'Text -> ToKeyError'Text -> Bool
(ToKeyError'Text -> ToKeyError'Text -> Bool)
-> (ToKeyError'Text -> ToKeyError'Text -> Bool)
-> Eq ToKeyError'Text
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ToKeyError'Text -> ToKeyError'Text -> Bool
== :: ToKeyError'Text -> ToKeyError'Text -> Bool
$c/= :: ToKeyError'Text -> ToKeyError'Text -> Bool
/= :: ToKeyError'Text -> ToKeyError'Text -> Bool
Eq, Int -> ToKeyError'Text -> ShowS
[ToKeyError'Text] -> ShowS
ToKeyError'Text -> String
(Int -> ToKeyError'Text -> ShowS)
-> (ToKeyError'Text -> String)
-> ([ToKeyError'Text] -> ShowS)
-> Show ToKeyError'Text
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ToKeyError'Text -> ShowS
showsPrec :: Int -> ToKeyError'Text -> ShowS
$cshow :: ToKeyError'Text -> String
show :: ToKeyError'Text -> String
$cshowList :: [ToKeyError'Text] -> ShowS
showList :: [ToKeyError'Text] -> ShowS
Show)

instance ToKey BS.ByteString where
  type ToKeyError BS.ByteString = ToKeyError'Text
  toKey :: ByteString -> Either (ToKeyError ByteString) Key
toKey ByteString
bs = (Text -> Key)
-> Either (ToKeyError ByteString) Text
-> Either (ToKeyError ByteString) Key
forall a b.
(a -> b)
-> Either (ToKeyError ByteString) a
-> Either (ToKeyError ByteString) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Key
ST.fromText
    (Either (ToKeyError ByteString) Text
 -> Either (ToKeyError ByteString) Key)
-> Either (ToKeyError ByteString) Text
-> Either (ToKeyError ByteString) Key
forall a b. (a -> b) -> a -> b
$ (UnicodeException -> ToKeyError ByteString)
-> Either UnicodeException Text
-> Either (ToKeyError ByteString) Text
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (ToKeyError'Text -> UnicodeException -> ToKeyError'Text
forall a b. a -> b -> a
const ToKeyError'Text
ToKeyError'Text'Utf8Error) (Either UnicodeException Text
 -> Either (ToKeyError ByteString) Text)
-> Either UnicodeException Text
-> Either (ToKeyError ByteString) Text
forall a b. (a -> b) -> a -> b
$ ByteString -> Either UnicodeException Text
TE.decodeUtf8' ByteString
bs
instance ToKey BL.ByteString where
  type ToKeyError BL.ByteString = ToKeyError'Text
  toKey :: ByteString -> Either (ToKeyError ByteString) Key
toKey ByteString
bs = (Text -> Key)
-> Either (ToKeyError ByteString) Text
-> Either (ToKeyError ByteString) Key
forall a b.
(a -> b)
-> Either (ToKeyError ByteString) a
-> Either (ToKeyError ByteString) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Key
ST.fromText
    (Either (ToKeyError ByteString) Text
 -> Either (ToKeyError ByteString) Key)
-> Either (ToKeyError ByteString) Text
-> Either (ToKeyError ByteString) Key
forall a b. (a -> b) -> a -> b
$ (UnicodeException -> ToKeyError ByteString)
-> Either UnicodeException Text
-> Either (ToKeyError ByteString) Text
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (ToKeyError'Text -> UnicodeException -> ToKeyError'Text
forall a b. a -> b -> a
const ToKeyError'Text
ToKeyError'Text'Utf8Error) (Either UnicodeException Text
 -> Either (ToKeyError ByteString) Text)
-> Either UnicodeException Text
-> Either (ToKeyError ByteString) Text
forall a b. (a -> b) -> a -> b
$ ByteString -> Either UnicodeException Text
TE.decodeUtf8' (ByteString -> Either UnicodeException Text)
-> ByteString -> Either UnicodeException Text
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BL.toStrict ByteString
bs
instance ToKey SBS.ShortByteString where
  type ToKeyError SBS.ShortByteString = ToKeyError'Text
  toKey :: ShortByteString -> Either (ToKeyError ShortByteString) Key
toKey ShortByteString
sbs = Either (ToKeyError ShortByteString) Key
-> (Key -> Either (ToKeyError ShortByteString) Key)
-> Maybe Key
-> Either (ToKeyError ShortByteString) Key
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ToKeyError'Text -> Either ToKeyError'Text Key
forall a b. a -> Either a b
Left ToKeyError'Text
ToKeyError'Text'Utf8Error) Key -> Either ToKeyError'Text Key
Key -> Either (ToKeyError ShortByteString) Key
forall a b. b -> Either a b
Right
    (Maybe Key -> Either (ToKeyError ShortByteString) Key)
-> Maybe Key -> Either (ToKeyError ShortByteString) Key
forall a b. (a -> b) -> a -> b
$ ShortByteString -> Maybe Key
ST.fromShortByteString ShortByteString
sbs
instance ToKey TS.Text where
  type ToKeyError TS.Text = Void
  toKey :: Text -> Either (ToKeyError Text) Key
toKey = Key -> Either Void Key
forall a b. b -> Either a b
Right (Key -> Either Void Key)
-> (Text -> Key) -> Text -> Either Void Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Key
ST.fromText
instance ToKey TL.Text where
  type ToKeyError TL.Text = Void
  toKey :: Text -> Either (ToKeyError Text) Key
toKey = Key -> Either Void Key
forall a b. b -> Either a b
Right (Key -> Either Void Key)
-> (Text -> Key) -> Text -> Either Void Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Key
ST.fromText (Text -> Key) -> (Text -> Text) -> Text -> Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
TL.toStrict
instance ToKey ST.ShortText where
  type ToKeyError ST.ShortText = Void
  toKey :: Key -> Either (ToKeyError Key) Key
toKey = Key -> Either Void Key
Key -> Either (ToKeyError Key) Key
forall a b. b -> Either a b
Right

data ToItemError'Map k v
  = ToItemError'Map'KeyError (ToKeyError k)
  | ToItemError'Map'ValueError (ToItemError v)
  deriving ((forall x. ToItemError'Map k v -> Rep (ToItemError'Map k v) x)
-> (forall x. Rep (ToItemError'Map k v) x -> ToItemError'Map k v)
-> Generic (ToItemError'Map k v)
forall x. Rep (ToItemError'Map k v) x -> ToItemError'Map k v
forall x. ToItemError'Map k v -> Rep (ToItemError'Map k v) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall k v x. Rep (ToItemError'Map k v) x -> ToItemError'Map k v
forall k v x. ToItemError'Map k v -> Rep (ToItemError'Map k v) x
$cfrom :: forall k v x. ToItemError'Map k v -> Rep (ToItemError'Map k v) x
from :: forall x. ToItemError'Map k v -> Rep (ToItemError'Map k v) x
$cto :: forall k v x. Rep (ToItemError'Map k v) x -> ToItemError'Map k v
to :: forall x. Rep (ToItemError'Map k v) x -> ToItemError'Map k v
Generic)
instance (Eq (ToKeyError k), Eq (ToItemError v))
  => Eq (ToItemError'Map k v) where
    == :: ToItemError'Map k v -> ToItemError'Map k v -> Bool
(==) = ToItemError'Map k v -> ToItemError'Map k v -> Bool
forall a. (Generic a, Eq (Rep a ())) => a -> a -> Bool
geq
instance (Show (ToKeyError k), Show (ToItemError v))
  => Show (ToItemError'Map k v) where
    showsPrec :: Int -> ToItemError'Map k v -> ShowS
showsPrec = Int -> ToItemError'Map k v -> ShowS
forall a. (Generic a, GShow0 (Rep a)) => Int -> a -> ShowS
gshowsPrec

instance (ToKey k, ToItem v) => ToItem (M.Map k v) where
  type ToItemError (M.Map k v) = ToItemError'Map k v
  toItem :: Map k v -> Either (ToItemError (Map k v)) Item
toItem Map k v
dic = ([(Key, Item)] -> Item)
-> Either (ToItemError (Map k v)) [(Key, Item)]
-> Either (ToItemError (Map k v)) Item
forall a b.
(a -> b)
-> Either (ToItemError (Map k v)) a
-> Either (ToItemError (Map k v)) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Map Key Item -> Item
Item'Dictionary (Map Key Item -> Item)
-> ([(Key, Item)] -> Map Key Item) -> [(Key, Item)] -> Item
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Key, Item)] -> Map Key Item
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList)
    (Either (ToItemError (Map k v)) [(Key, Item)]
 -> Either (ToItemError (Map k v)) Item)
-> Either (ToItemError (Map k v)) [(Key, Item)]
-> Either (ToItemError (Map k v)) Item
forall a b. (a -> b) -> a -> b
$ [(k, v)]
-> ((k, v) -> Either (ToItemError (Map k v)) (Key, Item))
-> Either (ToItemError (Map k v)) [(Key, Item)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (Map k v -> [(k, v)]
forall k a. Map k a -> [(k, a)]
M.toAscList Map k v
dic) (((k, v) -> Either (ToItemError (Map k v)) (Key, Item))
 -> Either (ToItemError (Map k v)) [(Key, Item)])
-> ((k, v) -> Either (ToItemError (Map k v)) (Key, Item))
-> Either (ToItemError (Map k v)) [(Key, Item)]
forall a b. (a -> b) -> a -> b
$ \(k
ks, v
vs) -> do
      Key
kd <- (ToKeyError k -> ToItemError'Map k v)
-> Either (ToKeyError k) Key -> Either (ToItemError'Map k v) Key
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ToKeyError k -> ToItemError'Map k v
forall k v. ToKeyError k -> ToItemError'Map k v
ToItemError'Map'KeyError (Either (ToKeyError k) Key -> Either (ToItemError'Map k v) Key)
-> Either (ToKeyError k) Key -> Either (ToItemError'Map k v) Key
forall a b. (a -> b) -> a -> b
$ k -> Either (ToKeyError k) Key
forall a. ToKey a => a -> Either (ToKeyError a) Key
toKey k
ks
      Item
vd <- (ToItemError v -> ToItemError'Map k v)
-> Either (ToItemError v) Item -> Either (ToItemError'Map k v) Item
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ToItemError v -> ToItemError'Map k v
forall k v. ToItemError v -> ToItemError'Map k v
ToItemError'Map'ValueError (Either (ToItemError v) Item -> Either (ToItemError'Map k v) Item)
-> Either (ToItemError v) Item -> Either (ToItemError'Map k v) Item
forall a b. (a -> b) -> a -> b
$ v -> Either (ToItemError v) Item
forall a. ToItem a => a -> Either (ToItemError a) Item
toItem v
vs
      (Key, Item) -> Either (ToItemError'Map k v) (Key, Item)
forall a. a -> Either (ToItemError'Map k v) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Key
kd, Item
vd)