module Data.Serialize.Describe.Class(
Describe, Context, describe,
field, isoField
) where
import GHC.Generics
import GHC.Exts
import GHC.TypeNats
import Data.Profunctor
import Control.Monad
import qualified Data.Vector.Fixed as V
import Data.Serialize.Get
import Data.Serialize.Put
import Data.Vector.Fixed.Boxed (Vec)
import Data.Char
import Data.Int
import Data.Proxy
import Data.Word
import Control.Lens (view)
import Control.Lens.Iso (Iso')
import qualified Control.Lens.Iso as I
import Control.Monad.Trans.Class
import Control.Monad.Trans.Identity
import Data.Serialize.Describe.Internal.Descriptor
import Data.Serialize.Describe.Isomorphisms
class Describe a where
type Context (m :: (* -> *) -> * -> *) a :: Constraint
type Context m a = ()
describe :: (MonadTrans m, forall x. Monad x => Monad (m x), Context m a) => DescriptorM m a a
default describe :: ( Generic a
, GDescribe (Rep a)
, MonadTrans m
, forall x. Monad x => Monad (m x)
) => DescriptorM m a a
describe = morphTransformer (lift . runIdentityT) $ dimap from to gdescribe
field :: forall a m s. ( Describe a
, MonadTrans m
, forall x. Monad x => Monad (m x)
, Context m a
)
=> (s -> a)
-> DescriptorM m s a
field f = morphRef f describe
isoField :: (Describe b, MonadTrans m, forall x. Monad x => Monad (m x), Context m b)
=> Iso' a b
-> (s -> a)
-> DescriptorM m s a
isoField i f = view (I.from i) <$> morphRef (view i . f) describe
class GDescribe f where
gdescribe :: Descriptor (f a) (f a)
instance GDescribe U1 where
gdescribe = pure U1
instance (GDescribe a, GDescribe b) => GDescribe (a :*: b) where
gdescribe = liftM2 (:*:) (lmap l gdescribe) (lmap r gdescribe)
where
l (a :*: _) = a
r (_ :*: b) = b
instance (GDescribe a) => GDescribe (M1 i c a) where
gdescribe = M1 <$> lmap extract gdescribe
where
extract (M1 x) = x
instance (Describe a, Context IdentityT a) => GDescribe (K1 i a) where
gdescribe = K1 <$> lmap extract describe
where
extract (K1 x) = x
instance Describe () where
describe = pure ()
instance Describe Bool where
describe = toEnum . fromIntegral <$> field (fromIntegral @_ @Word8 . fromEnum)
instance Describe Char where
describe = chr . fromIntegral <$> field @Word8 (fromIntegral . ord)
instance Describe Word8 where
describe = mkDescriptor fi (const 1) getWord8 putWord8
instance Describe Int8 where
describe = mkDescriptor fi (const 1) getWord8 putWord8
instance
( Describe a
, V.Arity n
, V.Vector (Vec n) a
, KnownNat n
) => Describe (Vec n a) where
type Context m (Vec n a) = Context m a
describe =
V.fromList <$> forM [0..fromIntegral (natVal (Proxy :: Proxy n))-1]
(\i -> field (V.! i))