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

module Data.NestedText.From where

import Control.Monad (forM)
import Data.Bifunctor (Bifunctor(first))
import qualified Data.Binary.Builder as BB
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 FromItem a where
  type FromItemError a :: Type
  fromItem :: Item -> Either (FromItemError a) a
class Ord a => FromKey a where
  type FromKeyError a :: Type
  fromKey :: Key -> Either (FromKeyError a) a

instance FromItem Item where
  type FromItemError Item = Void
  fromItem :: Item -> Either (FromItemError Item) Item
fromItem = Item -> Either Void Item
Item -> Either (FromItemError Item) Item
forall a b. b -> Either a b
Right

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

instance FromItem BS.ByteString where
  type FromItemError BS.ByteString = FromItemError'Common
  fromItem :: Item -> Either (FromItemError ByteString) ByteString
fromItem (Item'String Text
t) = ByteString -> Either (FromItemError ByteString) ByteString
forall a b. b -> Either a b
Right (ByteString -> Either (FromItemError ByteString) ByteString)
-> ByteString -> Either (FromItemError ByteString) ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
TE.encodeUtf8 Text
t
  fromItem Item
_ = FromItemError'Common -> Either FromItemError'Common ByteString
forall a b. a -> Either a b
Left FromItemError'Common
FromItemError'Common'InvalidValue
instance FromItem BL.ByteString where
  type FromItemError BL.ByteString = FromItemError'Common
  fromItem :: Item -> Either (FromItemError ByteString) ByteString
fromItem (Item'String Text
t) = ByteString -> Either (FromItemError ByteString) ByteString
forall a b. b -> Either a b
Right (ByteString -> Either (FromItemError ByteString) ByteString)
-> ByteString -> Either (FromItemError ByteString) ByteString
forall a b. (a -> b) -> a -> b
$ Builder -> ByteString
BB.toLazyByteString (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> Builder
TE.encodeUtf8Builder Text
t
  fromItem Item
_ = FromItemError'Common -> Either FromItemError'Common ByteString
forall a b. a -> Either a b
Left FromItemError'Common
FromItemError'Common'InvalidValue
instance FromItem TS.Text where
  type FromItemError TS.Text = FromItemError'Common
  fromItem :: Item -> Either (FromItemError Text) Text
fromItem (Item'String Text
t) = Text -> Either FromItemError'Common Text
forall a b. b -> Either a b
Right Text
t
  fromItem Item
_ = FromItemError'Common -> Either FromItemError'Common Text
forall a b. a -> Either a b
Left FromItemError'Common
FromItemError'Common'InvalidValue
instance FromItem TL.Text where
  type FromItemError TL.Text = FromItemError'Common
  fromItem :: Item -> Either (FromItemError Text) Text
fromItem (Item'String Text
t) = Text -> Either (FromItemError Text) Text
forall a b. b -> Either a b
Right (Text -> Either (FromItemError Text) Text)
-> Text -> Either (FromItemError Text) Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
TL.fromStrict Text
t
  fromItem Item
_ = FromItemError'Common -> Either FromItemError'Common Text
forall a b. a -> Either a b
Left FromItemError'Common
FromItemError'Common'InvalidValue

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

instance FromItem a => FromItem [a] where
  type FromItemError [a] = FromItemError'List a
  fromItem :: Item -> Either (FromItemError [a]) [a]
fromItem (Item'List Vector Item
xs) = (Vector a -> [a])
-> Either (FromItemError [a]) (Vector a)
-> Either (FromItemError [a]) [a]
forall a b.
(a -> b)
-> Either (FromItemError [a]) a -> Either (FromItemError [a]) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Vector a -> [a]
forall a. Vector a -> [a]
V.toList (Either (FromItemError [a]) (Vector a)
 -> Either (FromItemError [a]) [a])
-> Either (FromItemError [a]) (Vector a)
-> Either (FromItemError [a]) [a]
forall a b. (a -> b) -> a -> b
$ Vector Item
-> (Item -> Either (FromItemError [a]) a)
-> Either (FromItemError [a]) (Vector a)
forall (m :: * -> *) a b.
Monad m =>
Vector a -> (a -> m b) -> m (Vector b)
V.forM Vector Item
xs ((Item -> Either (FromItemError [a]) a)
 -> Either (FromItemError [a]) (Vector a))
-> (Item -> Either (FromItemError [a]) a)
-> Either (FromItemError [a]) (Vector a)
forall a b. (a -> b) -> a -> b
$ \Item
x ->
    (FromItemError a -> FromItemError [a])
-> Either (FromItemError a) a -> Either (FromItemError [a]) a
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 FromItemError a -> FromItemError'List a
FromItemError a -> FromItemError [a]
forall a. FromItemError a -> FromItemError'List a
FromItemError'List'ElementError (Either (FromItemError a) a -> Either (FromItemError [a]) a)
-> Either (FromItemError a) a -> Either (FromItemError [a]) a
forall a b. (a -> b) -> a -> b
$ Item -> Either (FromItemError a) a
forall a. FromItem a => Item -> Either (FromItemError a) a
fromItem Item
x
  fromItem Item
_ = FromItemError'List a -> Either (FromItemError'List a) [a]
forall a b. a -> Either a b
Left FromItemError'List a
forall a. FromItemError'List a
FromItemError'List'InvalidValue
instance FromItem a => FromItem (V.Vector a) where
  type FromItemError (V.Vector a) = FromItemError'List a
  fromItem :: Item -> Either (FromItemError (Vector a)) (Vector a)
fromItem (Item'List Vector Item
xs) = Vector Item
-> (Item -> Either (FromItemError (Vector a)) a)
-> Either (FromItemError (Vector a)) (Vector a)
forall (m :: * -> *) a b.
Monad m =>
Vector a -> (a -> m b) -> m (Vector b)
V.forM Vector Item
xs ((Item -> Either (FromItemError (Vector a)) a)
 -> Either (FromItemError (Vector a)) (Vector a))
-> (Item -> Either (FromItemError (Vector a)) a)
-> Either (FromItemError (Vector a)) (Vector a)
forall a b. (a -> b) -> a -> b
$ \Item
x ->
    (FromItemError a -> FromItemError (Vector a))
-> Either (FromItemError a) a
-> Either (FromItemError (Vector a)) a
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 FromItemError a -> FromItemError'List a
FromItemError a -> FromItemError (Vector a)
forall a. FromItemError a -> FromItemError'List a
FromItemError'List'ElementError (Either (FromItemError a) a -> Either (FromItemError (Vector a)) a)
-> Either (FromItemError a) a
-> Either (FromItemError (Vector a)) a
forall a b. (a -> b) -> a -> b
$ Item -> Either (FromItemError a) a
forall a. FromItem a => Item -> Either (FromItemError a) a
fromItem Item
x
  fromItem Item
_ = FromItemError'List a -> Either (FromItemError'List a) (Vector a)
forall a b. a -> Either a b
Left FromItemError'List a
forall a. FromItemError'List a
FromItemError'List'InvalidValue

instance FromKey BS.ByteString where
  type FromKeyError BS.ByteString = Void
  fromKey :: Key -> Either (FromKeyError ByteString) ByteString
fromKey Key
st = ByteString -> Either (FromKeyError ByteString) ByteString
forall a b. b -> Either a b
Right (ByteString -> Either (FromKeyError ByteString) ByteString)
-> ByteString -> Either (FromKeyError ByteString) ByteString
forall a b. (a -> b) -> a -> b
$ Key -> ByteString
ST.toByteString Key
st
instance FromKey BL.ByteString where
  type FromKeyError BL.ByteString = Void
  fromKey :: Key -> Either (FromKeyError ByteString) ByteString
fromKey Key
st = ByteString -> Either (FromKeyError ByteString) ByteString
forall a b. b -> Either a b
Right (ByteString -> Either (FromKeyError ByteString) ByteString)
-> ByteString -> Either (FromKeyError ByteString) ByteString
forall a b. (a -> b) -> a -> b
$ Builder -> ByteString
BB.toLazyByteString (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ Key -> Builder
ST.toBuilder Key
st
instance FromKey SBS.ShortByteString where
  type FromKeyError SBS.ShortByteString = Void
  fromKey :: Key -> Either (FromKeyError ShortByteString) ShortByteString
fromKey Key
st = ShortByteString
-> Either (FromKeyError ShortByteString) ShortByteString
forall a b. b -> Either a b
Right (ShortByteString
 -> Either (FromKeyError ShortByteString) ShortByteString)
-> ShortByteString
-> Either (FromKeyError ShortByteString) ShortByteString
forall a b. (a -> b) -> a -> b
$ Key -> ShortByteString
ST.toShortByteString Key
st
instance FromKey TS.Text where
  type FromKeyError TS.Text = Void
  fromKey :: Key -> Either (FromKeyError Text) Text
fromKey Key
st = Text -> Either (FromKeyError Text) Text
forall a b. b -> Either a b
Right (Text -> Either (FromKeyError Text) Text)
-> Text -> Either (FromKeyError Text) Text
forall a b. (a -> b) -> a -> b
$ Key -> Text
ST.toText Key
st
instance FromKey TL.Text where
  type FromKeyError TL.Text = Void
  fromKey :: Key -> Either (FromKeyError Text) Text
fromKey Key
st = Text -> Either (FromKeyError Text) Text
forall a b. b -> Either a b
Right (Text -> Either (FromKeyError Text) Text)
-> Text -> Either (FromKeyError Text) Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
TL.fromStrict (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Key -> Text
ST.toText Key
st
instance FromKey ST.ShortText where
  type FromKeyError ST.ShortText = Void
  fromKey :: Key -> Either (FromKeyError Key) Key
fromKey = Key -> Either Void Key
Key -> Either (FromKeyError Key) Key
forall a b. b -> Either a b
Right

data FromItemError'Map k v
  = FromItemError'Map'InvalidValue
  | FromItemError'Map'KeyError (FromKeyError k)
  | FromItemError'Map'ValueError (FromItemError v)
  deriving ((forall x. FromItemError'Map k v -> Rep (FromItemError'Map k v) x)
-> (forall x.
    Rep (FromItemError'Map k v) x -> FromItemError'Map k v)
-> Generic (FromItemError'Map k v)
forall x. Rep (FromItemError'Map k v) x -> FromItemError'Map k v
forall x. FromItemError'Map k v -> Rep (FromItemError'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 (FromItemError'Map k v) x -> FromItemError'Map k v
forall k v x.
FromItemError'Map k v -> Rep (FromItemError'Map k v) x
$cfrom :: forall k v x.
FromItemError'Map k v -> Rep (FromItemError'Map k v) x
from :: forall x. FromItemError'Map k v -> Rep (FromItemError'Map k v) x
$cto :: forall k v x.
Rep (FromItemError'Map k v) x -> FromItemError'Map k v
to :: forall x. Rep (FromItemError'Map k v) x -> FromItemError'Map k v
Generic)
instance (Eq (FromKeyError k), Eq (FromItemError v))
  => Eq (FromItemError'Map k v) where
    == :: FromItemError'Map k v -> FromItemError'Map k v -> Bool
(==) = FromItemError'Map k v -> FromItemError'Map k v -> Bool
forall a. (Generic a, Eq (Rep a ())) => a -> a -> Bool
geq
instance (Show (FromKeyError k), Show (FromItemError v))
  => Show (FromItemError'Map k v) where
    showsPrec :: Int -> FromItemError'Map k v -> ShowS
showsPrec = Int -> FromItemError'Map k v -> ShowS
forall a. (Generic a, GShow0 (Rep a)) => Int -> a -> ShowS
gshowsPrec

instance (FromKey k, FromItem v) => FromItem (M.Map k v) where
  type FromItemError (M.Map k v) = FromItemError'Map k v
  fromItem :: Item -> Either (FromItemError (Map k v)) (Map k v)
fromItem (Item'Dictionary Map Key Item
dic) =
    ([(k, v)] -> Map k v)
-> Either (FromItemError (Map k v)) [(k, v)]
-> Either (FromItemError (Map k v)) (Map k v)
forall a b.
(a -> b)
-> Either (FromItemError (Map k v)) a
-> Either (FromItemError (Map k v)) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(k, v)] -> Map k v
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList (Either (FromItemError (Map k v)) [(k, v)]
 -> Either (FromItemError (Map k v)) (Map k v))
-> Either (FromItemError (Map k v)) [(k, v)]
-> Either (FromItemError (Map k v)) (Map k v)
forall a b. (a -> b) -> a -> b
$ [(Key, Item)]
-> ((Key, Item) -> Either (FromItemError (Map k v)) (k, v))
-> Either (FromItemError (Map k v)) [(k, v)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (Map Key Item -> [(Key, Item)]
forall k a. Map k a -> [(k, a)]
M.toAscList Map Key Item
dic) (((Key, Item) -> Either (FromItemError (Map k v)) (k, v))
 -> Either (FromItemError (Map k v)) [(k, v)])
-> ((Key, Item) -> Either (FromItemError (Map k v)) (k, v))
-> Either (FromItemError (Map k v)) [(k, v)]
forall a b. (a -> b) -> a -> b
$ \(Key
ks, Item
vs) -> do
      k
kd <- (FromKeyError k -> FromItemError'Map k v)
-> Either (FromKeyError k) k -> Either (FromItemError'Map k v) k
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 FromKeyError k -> FromItemError'Map k v
forall k v. FromKeyError k -> FromItemError'Map k v
FromItemError'Map'KeyError (Either (FromKeyError k) k -> Either (FromItemError'Map k v) k)
-> Either (FromKeyError k) k -> Either (FromItemError'Map k v) k
forall a b. (a -> b) -> a -> b
$ Key -> Either (FromKeyError k) k
forall a. FromKey a => Key -> Either (FromKeyError a) a
fromKey Key
ks
      v
vd <- (FromItemError v -> FromItemError'Map k v)
-> Either (FromItemError v) v -> Either (FromItemError'Map k v) v
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 FromItemError v -> FromItemError'Map k v
forall k v. FromItemError v -> FromItemError'Map k v
FromItemError'Map'ValueError (Either (FromItemError v) v -> Either (FromItemError'Map k v) v)
-> Either (FromItemError v) v -> Either (FromItemError'Map k v) v
forall a b. (a -> b) -> a -> b
$ Item -> Either (FromItemError v) v
forall a. FromItem a => Item -> Either (FromItemError a) a
fromItem Item
vs
      (k, v) -> Either (FromItemError'Map k v) (k, v)
forall a. a -> Either (FromItemError'Map k v) a
forall (m :: * -> *) a. Monad m => a -> m a
return (k
kd, v
vd)
  fromItem Item
_ = FromItemError'Map k v -> Either (FromItemError'Map k v) (Map k v)
forall a b. a -> Either a b
Left FromItemError'Map k v
forall k v. FromItemError'Map k v
FromItemError'Map'InvalidValue