module Data.Radius.StreamPut.Monadic (
AttributePutM, extractAttributes,
tellA,
AtValueEncode,
exAttribute, attribute,
) where
import Control.Applicative (pure)
import Control.Monad.Trans.Writer (Writer, runWriter, tell)
import Data.DList (DList)
import qualified Data.DList as DList
import Data.Serialize.Put (Put, runPut)
import Data.Radius.Scalar (AtText, AtString, AtInteger, AtIpV4)
import Data.Radius.Attribute
(Attribute (..), untypeNumber, TypedNumber, Attribute' (..))
import qualified Data.Radius.StreamPut.Base as Base
class AtValueEncode a where
atValueEncode :: a -> Put
instance AtValueEncode AtText where
atValueEncode :: AtText -> Put
atValueEncode = AtText -> Put
Base.atText
instance AtValueEncode AtString where
atValueEncode :: AtString -> Put
atValueEncode = AtString -> Put
Base.atString
instance AtValueEncode AtInteger where
atValueEncode :: AtInteger -> Put
atValueEncode = AtInteger -> Put
Base.atInteger
instance AtValueEncode AtIpV4 where
atValueEncode :: AtIpV4 -> Put
atValueEncode = AtIpV4 -> Put
Base.atIpV4
type AttributePutM v = Writer (DList (Attribute' v))
exAttribute :: (a -> Put) -> Attribute v a -> AttributePutM v ()
exAttribute :: forall a v. (a -> Put) -> Attribute v a -> AttributePutM v ()
exAttribute a -> Put
vp (Attribute TypedNumber v a
n a
v) =
DList (Attribute' v) -> WriterT (DList (Attribute' v)) Identity ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
tell (DList (Attribute' v)
-> WriterT (DList (Attribute' v)) Identity ())
-> (Put -> DList (Attribute' v))
-> Put
-> WriterT (DList (Attribute' v)) Identity ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attribute' v -> DList (Attribute' v)
forall a. a -> DList a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Attribute' v -> DList (Attribute' v))
-> (Put -> Attribute' v) -> Put -> DList (Attribute' v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NumberAbstract v -> ByteString -> Attribute' v
forall v. NumberAbstract v -> ByteString -> Attribute' v
Attribute' (TypedNumber v a -> NumberAbstract v
forall v a. TypedNumber v a -> NumberAbstract v
untypeNumber TypedNumber v a
n) (ByteString -> Attribute' v)
-> (Put -> ByteString) -> Put -> Attribute' v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPut (Put -> WriterT (DList (Attribute' v)) Identity ())
-> Put -> WriterT (DList (Attribute' v)) Identity ()
forall a b. (a -> b) -> a -> b
$ a -> Put
vp a
v
attribute :: AtValueEncode a => Attribute v a -> AttributePutM v ()
attribute :: forall a v. AtValueEncode a => Attribute v a -> AttributePutM v ()
attribute = (a -> Put) -> Attribute v a -> AttributePutM v ()
forall a v. (a -> Put) -> Attribute v a -> AttributePutM v ()
exAttribute a -> Put
forall a. AtValueEncode a => a -> Put
atValueEncode
tellA :: AtValueEncode a => TypedNumber v a -> a -> AttributePutM v ()
tellA :: forall a v.
AtValueEncode a =>
TypedNumber v a -> a -> AttributePutM v ()
tellA = (Attribute v a -> AttributePutM v ()
forall a v. AtValueEncode a => Attribute v a -> AttributePutM v ()
attribute (Attribute v a -> AttributePutM v ())
-> (a -> Attribute v a) -> a -> AttributePutM v ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((a -> Attribute v a) -> a -> AttributePutM v ())
-> (TypedNumber v a -> a -> Attribute v a)
-> TypedNumber v a
-> a
-> AttributePutM v ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypedNumber v a -> a -> Attribute v a
forall v a. TypedNumber v a -> a -> Attribute v a
Attribute
extractAttributes :: AttributePutM v a -> [Attribute' v]
AttributePutM v a
w = DList (Attribute' v) -> [Attribute' v]
forall a. DList a -> [a]
DList.toList DList (Attribute' v)
dl where
(a
_, DList (Attribute' v)
dl) = AttributePutM v a -> (a, DList (Attribute' v))
forall w a. Writer w a -> (a, w)
runWriter AttributePutM v a
w