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

module Data.FractalText.From
  ( FromItem(..)
  , FromKey(..)
  , FromItemError'Common(..)
  , FromItemError'Map(..)
  ) where

import Data.FractalText.Type

import Control.Monad (forM)
import Data.Bifunctor (Bifunctor(first))
import Data.Kind (Type)
import qualified Data.Map as M
import qualified Data.Text as TS
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 Lens.Micro.Platform

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 TS.Text where
  type FromItemError TS.Text = FromItemError'Common
  fromItem :: Item -> Either (FromItemError Text) Text
fromItem (Item'List Vector (ListElem Text)
vs)
    | Vector (ListElem Text) -> Int
forall a. Vector a -> Int
V.length Vector (ListElem Text)
vs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = 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
$ Vector (ListElem Text) -> ListElem Text
forall a. Vector a -> a
V.head Vector (ListElem Text)
vs ListElem Text -> Getting Text (ListElem Text) Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text (ListElem Text) Text
forall a1 a2 (f :: * -> *).
Functor f =>
(a1 -> f a2) -> ListElem a1 -> f (ListElem a2)
listElem'value
    | Bool
otherwise = FromItemError'Common -> Either FromItemError'Common Text
forall a b. a -> Either a b
Left FromItemError'Common
FromItemError'Common'InvalidValue
  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'List Vector (ListElem Text)
vs)
    | Vector (ListElem Text) -> Int
forall a. Vector a -> Int
V.length Vector (ListElem Text)
vs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = 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 -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Vector (ListElem Text) -> ListElem Text
forall a. Vector a -> a
V.head Vector (ListElem Text)
vs ListElem Text -> Getting Text (ListElem Text) Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text (ListElem Text) Text
forall a1 a2 (f :: * -> *).
Functor f =>
(a1 -> f a2) -> ListElem a1 -> f (ListElem a2)
listElem'value
    | Bool
otherwise = FromItemError'Common -> Either FromItemError'Common Text
forall a b. a -> Either a b
Left FromItemError'Common
FromItemError'Common'InvalidValue
  fromItem Item
_ = FromItemError'Common -> Either FromItemError'Common Text
forall a b. a -> Either a b
Left FromItemError'Common
FromItemError'Common'InvalidValue

instance a ~ TS.Text => FromItem [a] where
  type FromItemError [a] = FromItemError'Common
  fromItem :: Item -> Either (FromItemError [a]) [a]
fromItem (Item'List Vector (ListElem Text)
xs) = [a] -> Either (FromItemError [a]) [a]
forall a b. b -> Either a b
Right ([a] -> Either (FromItemError [a]) [a])
-> [a] -> Either (FromItemError [a]) [a]
forall a b. (a -> b) -> a -> b
$ Vector a -> [a]
forall a. Vector a -> [a]
V.toList (Vector a -> [a]) -> Vector a -> [a]
forall a b. (a -> b) -> a -> b
$ (ListElem Text -> a) -> Vector (ListElem Text) -> Vector a
forall a b. (a -> b) -> Vector a -> Vector b
V.map (Getting Text (ListElem Text) Text -> ListElem Text -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text (ListElem Text) Text
forall a1 a2 (f :: * -> *).
Functor f =>
(a1 -> f a2) -> ListElem a1 -> f (ListElem a2)
listElem'value) Vector (ListElem Text)
xs
  fromItem Item
_ = FromItemError'Common -> Either FromItemError'Common [a]
forall a b. a -> Either a b
Left FromItemError'Common
FromItemError'Common'InvalidValue
instance a ~ TS.Text => FromItem (V.Vector a) where
  type FromItemError (V.Vector a) = FromItemError'Common
  fromItem :: Item -> Either (FromItemError (Vector a)) (Vector a)
fromItem (Item'List Vector (ListElem Text)
xs) = Vector a -> Either (FromItemError (Vector a)) (Vector a)
forall a b. b -> Either a b
Right (Vector a -> Either (FromItemError (Vector a)) (Vector a))
-> Vector a -> Either (FromItemError (Vector a)) (Vector a)
forall a b. (a -> b) -> a -> b
$ (ListElem Text -> a) -> Vector (ListElem Text) -> Vector a
forall a b. (a -> b) -> Vector a -> Vector b
V.map (Getting Text (ListElem Text) Text -> ListElem Text -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text (ListElem Text) Text
forall a1 a2 (f :: * -> *).
Functor f =>
(a1 -> f a2) -> ListElem a1 -> f (ListElem a2)
listElem'value) Vector (ListElem Text)
xs
  fromItem Item
_ = FromItemError'Common -> Either FromItemError'Common (Vector a)
forall a b. a -> Either a b
Left FromItemError'Common
FromItemError'Common'InvalidValue

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'Dict Vector (DictElem 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
$ [DictElem Item]
-> (DictElem 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 (Vector (DictElem Item) -> [DictElem Item]
forall a. Vector a -> [a]
V.toList Vector (DictElem Item)
dic) ((DictElem Item -> Either (FromItemError (Map k v)) (k, v))
 -> Either (FromItemError (Map k v)) [(k, v)])
-> (DictElem Item -> Either (FromItemError (Map k v)) (k, v))
-> Either (FromItemError (Map k v)) [(k, v)]
forall a b. (a -> b) -> a -> b
$ \DictElem Item
de -> 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 -> Either (FromKeyError k) k)
-> Key -> Either (FromKeyError k) k
forall a b. (a -> b) -> a -> b
$ DictElem Item
de DictElem Item -> Getting Key (DictElem Item) Key -> Key
forall s a. s -> Getting a s a -> a
^. Getting Key (DictElem Item) Key
forall a (f :: * -> *).
Functor f =>
(Key -> f Key) -> DictElem a -> f (DictElem a)
dictElem'key
      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 -> Either (FromItemError v) v)
-> Item -> Either (FromItemError v) v
forall a b. (a -> b) -> a -> b
$ DictElem Item
de DictElem Item -> Getting Item (DictElem Item) Item -> Item
forall s a. s -> Getting a s a -> a
^. Getting Item (DictElem Item) Item
forall a1 a2 (f :: * -> *).
Functor f =>
(a1 -> f a2) -> DictElem a1 -> f (DictElem a2)
dictElem'value
      (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