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 = Base.atText
instance AtValueEncode AtString where
atValueEncode = Base.atString
instance AtValueEncode AtInteger where
atValueEncode = Base.atInteger
instance AtValueEncode AtIpV4 where
atValueEncode = Base.atIpV4
type AttributePutM v = Writer (DList (Attribute' v))
exAttribute :: (a -> Put) -> Attribute v a -> AttributePutM v ()
exAttribute vp (Attribute n v) =
tell . pure . Attribute' (untypeNumber n) . runPut $ vp v
attribute :: AtValueEncode a => Attribute v a -> AttributePutM v ()
attribute = exAttribute atValueEncode
tellA :: AtValueEncode a => TypedNumber v a -> a -> AttributePutM v ()
tellA = (attribute .) . Attribute
extractAttributes :: AttributePutM v a -> [Attribute' v]
extractAttributes w = DList.toList dl where
(_, dl) = runWriter w