module Data.Radius.StreamGet.Monadic (
  -- * DSL to get typed attributes from packet
  TypedAttributes, takeTyped', takeTyped,

  Attributes, extractAttributes,
  tellT,

  -- * low-level definitions
  AttributeGetWT, attributeGetWT, runAttributeGetWT,

  decodeAsText, decodeAsString, decodeAsInteger, decodeAsIpV4,
  ) where

import Control.Applicative ((<$>), pure, (<*), (<|>))
import Control.Monad (liftM, MonadPlus, guard, msum)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Maybe (MaybeT (..))
import Control.Monad.Trans.Writer (WriterT (..), tell)
import Data.Monoid (mempty)
import Data.DList (DList)
import qualified Data.DList as DList
import qualified Data.ByteString as BS
import Data.Functor.Identity (runIdentity)
import Data.Serialize.Get (runGet)

import Data.Radius.Scalar (AtText (..), AtString (..), AtInteger (..), AtIpV4 (..))
import Data.Radius.Attribute
  (Attribute (..), Attribute' (..),
   TypedNumber, typed, value, TypedNumberSets (..), )
import qualified Data.Radius.StreamGet.Base as Base


type AtList v at = DList (Attribute v at)
type AtWriterT v at = WriterT (AtList v at)

{-
-- May switch to simple Sum type structure
-- AIpV4 ... | AText ... | AInteger ... | AString ...
 -}

type AttributeGetWT' v m =
  AtWriterT v AtIpV4
  (AtWriterT v AtText
   (AtWriterT v AtInteger
    (AtWriterT v AtString m)))

attributeGetWT' :: m ((((a, AtList v AtIpV4), AtList v AtText), AtList v AtInteger), AtList v AtString)
                 -> AttributeGetWT' v m a
attributeGetWT' :: forall (m :: * -> *) a v.
m ((((a, AtList v AtIpV4), AtList v AtText), AtList v AtInteger),
   AtList v AtString)
-> AttributeGetWT' v m a
attributeGetWT' = AtWriterT
  v
  AtText
  (AtWriterT v AtInteger (AtWriterT v AtString m))
  (a, AtList v AtIpV4)
-> WriterT
     (AtList v AtIpV4)
     (AtWriterT
        v AtText (AtWriterT v AtInteger (AtWriterT v AtString m)))
     a
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
WriterT (AtWriterT
   v
   AtText
   (AtWriterT v AtInteger (AtWriterT v AtString m))
   (a, AtList v AtIpV4)
 -> WriterT
      (AtList v AtIpV4)
      (AtWriterT
         v AtText (AtWriterT v AtInteger (AtWriterT v AtString m)))
      a)
-> (m ((((a, AtList v AtIpV4), AtList v AtText),
        AtList v AtInteger),
       AtList v AtString)
    -> AtWriterT
         v
         AtText
         (AtWriterT v AtInteger (AtWriterT v AtString m))
         (a, AtList v AtIpV4))
-> m ((((a, AtList v AtIpV4), AtList v AtText),
       AtList v AtInteger),
      AtList v AtString)
-> WriterT
     (AtList v AtIpV4)
     (AtWriterT
        v AtText (AtWriterT v AtInteger (AtWriterT v AtString m)))
     a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AtWriterT
  v
  AtInteger
  (AtWriterT v AtString m)
  ((a, AtList v AtIpV4), AtList v AtText)
-> AtWriterT
     v
     AtText
     (AtWriterT v AtInteger (AtWriterT v AtString m))
     (a, AtList v AtIpV4)
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
WriterT (AtWriterT
   v
   AtInteger
   (AtWriterT v AtString m)
   ((a, AtList v AtIpV4), AtList v AtText)
 -> AtWriterT
      v
      AtText
      (AtWriterT v AtInteger (AtWriterT v AtString m))
      (a, AtList v AtIpV4))
-> (m ((((a, AtList v AtIpV4), AtList v AtText),
        AtList v AtInteger),
       AtList v AtString)
    -> AtWriterT
         v
         AtInteger
         (AtWriterT v AtString m)
         ((a, AtList v AtIpV4), AtList v AtText))
-> m ((((a, AtList v AtIpV4), AtList v AtText),
       AtList v AtInteger),
      AtList v AtString)
-> AtWriterT
     v
     AtText
     (AtWriterT v AtInteger (AtWriterT v AtString m))
     (a, AtList v AtIpV4)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AtWriterT
  v
  AtString
  m
  (((a, AtList v AtIpV4), AtList v AtText), AtList v AtInteger)
-> AtWriterT
     v
     AtInteger
     (AtWriterT v AtString m)
     ((a, AtList v AtIpV4), AtList v AtText)
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
WriterT (AtWriterT
   v
   AtString
   m
   (((a, AtList v AtIpV4), AtList v AtText), AtList v AtInteger)
 -> AtWriterT
      v
      AtInteger
      (AtWriterT v AtString m)
      ((a, AtList v AtIpV4), AtList v AtText))
-> (m ((((a, AtList v AtIpV4), AtList v AtText),
        AtList v AtInteger),
       AtList v AtString)
    -> AtWriterT
         v
         AtString
         m
         (((a, AtList v AtIpV4), AtList v AtText), AtList v AtInteger))
-> m ((((a, AtList v AtIpV4), AtList v AtText),
       AtList v AtInteger),
      AtList v AtString)
-> AtWriterT
     v
     AtInteger
     (AtWriterT v AtString m)
     ((a, AtList v AtIpV4), AtList v AtText)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m ((((a, AtList v AtIpV4), AtList v AtText), AtList v AtInteger),
   AtList v AtString)
-> AtWriterT
     v
     AtString
     m
     (((a, AtList v AtIpV4), AtList v AtText), AtList v AtInteger)
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
WriterT
                   {- coercible operation ^^ -}

runAttributeGetWT' :: AttributeGetWT' v m a
                    -> m ((((a, AtList v AtIpV4), AtList v AtText), AtList v AtInteger), AtList v AtString)
runAttributeGetWT' :: forall v (m :: * -> *) a.
AttributeGetWT' v m a
-> m ((((a, AtList v AtIpV4), AtList v AtText),
       AtList v AtInteger),
      AtList v AtString)
runAttributeGetWT' = WriterT
  (AtList v AtString)
  m
  (((a, AtList v AtIpV4), AtList v AtText), AtList v AtInteger)
-> m ((((a, AtList v AtIpV4), AtList v AtText),
       AtList v AtInteger),
      AtList v AtString)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT (WriterT
   (AtList v AtString)
   m
   (((a, AtList v AtIpV4), AtList v AtText), AtList v AtInteger)
 -> m ((((a, AtList v AtIpV4), AtList v AtText),
        AtList v AtInteger),
       AtList v AtString))
-> (AttributeGetWT' v m a
    -> WriterT
         (AtList v AtString)
         m
         (((a, AtList v AtIpV4), AtList v AtText), AtList v AtInteger))
-> AttributeGetWT' v m a
-> m ((((a, AtList v AtIpV4), AtList v AtText),
       AtList v AtInteger),
      AtList v AtString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterT
  (AtList v AtInteger)
  (WriterT (AtList v AtString) m)
  ((a, AtList v AtIpV4), AtList v AtText)
-> WriterT
     (AtList v AtString)
     m
     (((a, AtList v AtIpV4), AtList v AtText), AtList v AtInteger)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT (WriterT
   (AtList v AtInteger)
   (WriterT (AtList v AtString) m)
   ((a, AtList v AtIpV4), AtList v AtText)
 -> WriterT
      (AtList v AtString)
      m
      (((a, AtList v AtIpV4), AtList v AtText), AtList v AtInteger))
-> (AttributeGetWT' v m a
    -> WriterT
         (AtList v AtInteger)
         (WriterT (AtList v AtString) m)
         ((a, AtList v AtIpV4), AtList v AtText))
-> AttributeGetWT' v m a
-> WriterT
     (AtList v AtString)
     m
     (((a, AtList v AtIpV4), AtList v AtText), AtList v AtInteger)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterT
  (AtList v AtText)
  (WriterT (AtList v AtInteger) (WriterT (AtList v AtString) m))
  (a, AtList v AtIpV4)
-> WriterT
     (AtList v AtInteger)
     (WriterT (AtList v AtString) m)
     ((a, AtList v AtIpV4), AtList v AtText)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT (WriterT
   (AtList v AtText)
   (WriterT (AtList v AtInteger) (WriterT (AtList v AtString) m))
   (a, AtList v AtIpV4)
 -> WriterT
      (AtList v AtInteger)
      (WriterT (AtList v AtString) m)
      ((a, AtList v AtIpV4), AtList v AtText))
-> (AttributeGetWT' v m a
    -> WriterT
         (AtList v AtText)
         (WriterT (AtList v AtInteger) (WriterT (AtList v AtString) m))
         (a, AtList v AtIpV4))
-> AttributeGetWT' v m a
-> WriterT
     (AtList v AtInteger)
     (WriterT (AtList v AtString) m)
     ((a, AtList v AtIpV4), AtList v AtText)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AttributeGetWT' v m a
-> WriterT
     (AtList v AtText)
     (WriterT (AtList v AtInteger) (WriterT (AtList v AtString) m))
     (a, AtList v AtIpV4)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT
                      {- coercible operation ^^ -}

liftAW :: Monad m => m a -> AttributeGetWT' v m a
liftAW :: forall (m :: * -> *) a v. Monad m => m a -> AttributeGetWT' v m a
liftAW = AtWriterT
  v AtText (AtWriterT v AtInteger (AtWriterT v AtString m)) a
-> WriterT
     (AtList v AtIpV4)
     (AtWriterT
        v AtText (AtWriterT v AtInteger (AtWriterT v AtString m)))
     a
forall (m :: * -> *) a.
Monad m =>
m a -> WriterT (AtList v AtIpV4) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (AtWriterT
   v AtText (AtWriterT v AtInteger (AtWriterT v AtString m)) a
 -> WriterT
      (AtList v AtIpV4)
      (AtWriterT
         v AtText (AtWriterT v AtInteger (AtWriterT v AtString m)))
      a)
-> (m a
    -> AtWriterT
         v AtText (AtWriterT v AtInteger (AtWriterT v AtString m)) a)
-> m a
-> WriterT
     (AtList v AtIpV4)
     (AtWriterT
        v AtText (AtWriterT v AtInteger (AtWriterT v AtString m)))
     a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AtWriterT v AtInteger (AtWriterT v AtString m) a
-> AtWriterT
     v AtText (AtWriterT v AtInteger (AtWriterT v AtString m)) a
forall (m :: * -> *) a.
Monad m =>
m a -> WriterT (AtList v AtText) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (AtWriterT v AtInteger (AtWriterT v AtString m) a
 -> AtWriterT
      v AtText (AtWriterT v AtInteger (AtWriterT v AtString m)) a)
-> (m a -> AtWriterT v AtInteger (AtWriterT v AtString m) a)
-> m a
-> AtWriterT
     v AtText (AtWriterT v AtInteger (AtWriterT v AtString m)) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AtWriterT v AtString m a
-> AtWriterT v AtInteger (AtWriterT v AtString m) a
forall (m :: * -> *) a.
Monad m =>
m a -> WriterT (AtList v AtInteger) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (AtWriterT v AtString m a
 -> AtWriterT v AtInteger (AtWriterT v AtString m) a)
-> (m a -> AtWriterT v AtString m a)
-> m a
-> AtWriterT v AtInteger (AtWriterT v AtString m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> AtWriterT v AtString m a
forall (m :: * -> *) a.
Monad m =>
m a -> WriterT (AtList v AtString) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

type AttributeGetWT v m = AttributeGetWT' v (WriterT (DList (Attribute' v)) m)


decodeAsText :: (TypedNumberSets v, Ord v)
             => Attribute' v
             -> MaybeT (Either String) (Attribute v AtText)
decodeAsText :: forall v.
(TypedNumberSets v, Ord v) =>
Attribute' v -> MaybeT (Either String) (Attribute v AtText)
decodeAsText   a :: Attribute' v
a@(Attribute' NumberAbstract v
_ ByteString
bs) = TypedNumberSet v AtText
-> (ByteString -> Either String AtText)
-> Attribute' v
-> MaybeT (Either String) (Attribute v AtText)
forall (m :: * -> *) v a b.
(Monad m, Functor m, Ord v) =>
TypedNumberSet v a
-> (ByteString -> m b) -> Attribute' v -> MaybeT m (Attribute v b)
typed TypedNumberSet v AtText
forall v. TypedNumberSets v => TypedNumberSet v AtText
attributeNumbersText    (Get AtText -> ByteString -> Either String AtText
forall a. Get a -> ByteString -> Either String a
runGet (Get AtText -> ByteString -> Either String AtText)
-> (Int -> Get AtText) -> Int -> ByteString -> Either String AtText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Get AtText
Base.atText (Int -> ByteString -> Either String AtText)
-> Int -> ByteString -> Either String AtText
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
BS.length ByteString
bs)   Attribute' v
a

decodeAsString :: (TypedNumberSets v, Ord v)
               => Attribute' v
               -> MaybeT (Either String) (Attribute v AtString)
decodeAsString :: forall v.
(TypedNumberSets v, Ord v) =>
Attribute' v -> MaybeT (Either String) (Attribute v AtString)
decodeAsString a :: Attribute' v
a@(Attribute' NumberAbstract v
_ ByteString
bs) = TypedNumberSet v AtString
-> (ByteString -> Either String AtString)
-> Attribute' v
-> MaybeT (Either String) (Attribute v AtString)
forall (m :: * -> *) v a b.
(Monad m, Functor m, Ord v) =>
TypedNumberSet v a
-> (ByteString -> m b) -> Attribute' v -> MaybeT m (Attribute v b)
typed TypedNumberSet v AtString
forall v. TypedNumberSets v => TypedNumberSet v AtString
attributeNumbersString  (Get AtString -> ByteString -> Either String AtString
forall a. Get a -> ByteString -> Either String a
runGet (Get AtString -> ByteString -> Either String AtString)
-> (Int -> Get AtString)
-> Int
-> ByteString
-> Either String AtString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Get AtString
Base.atString (Int -> ByteString -> Either String AtString)
-> Int -> ByteString -> Either String AtString
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
BS.length ByteString
bs) Attribute' v
a

decodeAsInteger :: (TypedNumberSets v, Ord v)
                => Attribute' v
                -> MaybeT (Either String) (Attribute v AtInteger)
decodeAsInteger :: forall v.
(TypedNumberSets v, Ord v) =>
Attribute' v -> MaybeT (Either String) (Attribute v AtInteger)
decodeAsInteger = TypedNumberSet v AtInteger
-> (ByteString -> Either String AtInteger)
-> Attribute' v
-> MaybeT (Either String) (Attribute v AtInteger)
forall (m :: * -> *) v a b.
(Monad m, Functor m, Ord v) =>
TypedNumberSet v a
-> (ByteString -> m b) -> Attribute' v -> MaybeT m (Attribute v b)
typed TypedNumberSet v AtInteger
forall v. TypedNumberSets v => TypedNumberSet v AtInteger
attributeNumbersInteger (Get AtInteger -> ByteString -> Either String AtInteger
forall a. Get a -> ByteString -> Either String a
runGet (Get AtInteger -> ByteString -> Either String AtInteger)
-> Get AtInteger -> ByteString -> Either String AtInteger
forall a b. (a -> b) -> a -> b
$ Get AtInteger
Base.atInteger Get AtInteger -> Get () -> Get AtInteger
forall a b. Get a -> Get b -> Get a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Get ()
Base.eof)

decodeAsIpV4 :: (TypedNumberSets v, Ord v)
             => Attribute' v
             -> MaybeT (Either String) (Attribute v AtIpV4)
decodeAsIpV4 :: forall v.
(TypedNumberSets v, Ord v) =>
Attribute' v -> MaybeT (Either String) (Attribute v AtIpV4)
decodeAsIpV4    = TypedNumberSet v AtIpV4
-> (ByteString -> Either String AtIpV4)
-> Attribute' v
-> MaybeT (Either String) (Attribute v AtIpV4)
forall (m :: * -> *) v a b.
(Monad m, Functor m, Ord v) =>
TypedNumberSet v a
-> (ByteString -> m b) -> Attribute' v -> MaybeT m (Attribute v b)
typed TypedNumberSet v AtIpV4
forall v. TypedNumberSets v => TypedNumberSet v AtIpV4
attributeNumbersIpV4    (Get AtIpV4 -> ByteString -> Either String AtIpV4
forall a. Get a -> ByteString -> Either String a
runGet (Get AtIpV4 -> ByteString -> Either String AtIpV4)
-> Get AtIpV4 -> ByteString -> Either String AtIpV4
forall a b. (a -> b) -> a -> b
$ Get AtIpV4
Base.atIpV4    Get AtIpV4 -> Get () -> Get AtIpV4
forall a b. Get a -> Get b -> Get a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Get ()
Base.eof)

-- | Decode untyped attribute into monadic context.
--   When typed-value decode error found, either typed context makes sense.
tellT :: (TypedNumberSets v, Ord v)
      => Attribute' v -> AttributeGetWT v (Either String) ()
tellT :: forall v.
(TypedNumberSets v, Ord v) =>
Attribute' v -> AttributeGetWT v (Either String) ()
tellT Attribute' v
a =
  let emptyW :: (((((), AtList v AtIpV4), AtList v AtText), AtList v AtInteger),
 AtList v AtString)
emptyW = Identity
  (((((), AtList v AtIpV4), AtList v AtText), AtList v AtInteger),
   AtList v AtString)
-> (((((), AtList v AtIpV4), AtList v AtText), AtList v AtInteger),
    AtList v AtString)
forall a. Identity a -> a
runIdentity (Identity
   (((((), AtList v AtIpV4), AtList v AtText), AtList v AtInteger),
    AtList v AtString)
 -> (((((), AtList v AtIpV4), AtList v AtText), AtList v AtInteger),
     AtList v AtString))
-> (AttributeGetWT' v Identity ()
    -> Identity
         (((((), AtList v AtIpV4), AtList v AtText), AtList v AtInteger),
          AtList v AtString))
-> AttributeGetWT' v Identity ()
-> (((((), AtList v AtIpV4), AtList v AtText), AtList v AtInteger),
    AtList v AtString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AttributeGetWT' v Identity ()
-> Identity
     (((((), AtList v AtIpV4), AtList v AtText), AtList v AtInteger),
      AtList v AtString)
forall v (m :: * -> *) a.
AttributeGetWT' v m a
-> m ((((a, AtList v AtIpV4), AtList v AtText),
       AtList v AtInteger),
      AtList v AtString)
runAttributeGetWT' (AttributeGetWT' v Identity ()
 -> (((((), AtList v AtIpV4), AtList v AtText), AtList v AtInteger),
     AtList v AtString))
-> AttributeGetWT' v Identity ()
-> (((((), AtList v AtIpV4), AtList v AtText), AtList v AtInteger),
    AtList v AtString)
forall a b. (a -> b) -> a -> b
$ () -> AttributeGetWT' v Identity ()
forall a.
a
-> WriterT
     (AtList v AtIpV4)
     (AtWriterT
        v AtText (AtWriterT v AtInteger (AtWriterT v AtString Identity)))
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure () in
  {-- Not recoverable context type,
      AttributeGetWT' v (Writer (DList Attribute')) == AttributeGetWT v --}
  WriterT
  (DList (Attribute' v))
  (Either String)
  (((((), AtList v AtIpV4), AtList v AtText), AtList v AtInteger),
   DList (Attribute v AtString))
-> AttributeGetWT'
     v (WriterT (DList (Attribute' v)) (Either String)) ()
forall (m :: * -> *) a v.
m ((((a, AtList v AtIpV4), AtList v AtText), AtList v AtInteger),
   AtList v AtString)
-> AttributeGetWT' v m a
attributeGetWT' (WriterT
   (DList (Attribute' v))
   (Either String)
   (((((), AtList v AtIpV4), AtList v AtText), AtList v AtInteger),
    DList (Attribute v AtString))
 -> AttributeGetWT'
      v (WriterT (DList (Attribute' v)) (Either String)) ())
-> (AttributeGetWT' v (MaybeT (Either String)) ()
    -> WriterT
         (DList (Attribute' v))
         (Either String)
         (((((), AtList v AtIpV4), AtList v AtText), AtList v AtInteger),
          DList (Attribute v AtString)))
-> AttributeGetWT' v (MaybeT (Either String)) ()
-> AttributeGetWT'
     v (WriterT (DList (Attribute' v)) (Either String)) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either
  String
  ((((((), AtList v AtIpV4), AtList v AtText), AtList v AtInteger),
    DList (Attribute v AtString)),
   DList (Attribute' v))
-> WriterT
     (DList (Attribute' v))
     (Either String)
     (((((), AtList v AtIpV4), AtList v AtText), AtList v AtInteger),
      DList (Attribute v AtString))
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
WriterT (Either
   String
   ((((((), AtList v AtIpV4), AtList v AtText), AtList v AtInteger),
     DList (Attribute v AtString)),
    DList (Attribute' v))
 -> WriterT
      (DList (Attribute' v))
      (Either String)
      (((((), AtList v AtIpV4), AtList v AtText), AtList v AtInteger),
       DList (Attribute v AtString)))
-> (AttributeGetWT' v (MaybeT (Either String)) ()
    -> Either
         String
         ((((((), AtList v AtIpV4), AtList v AtText), AtList v AtInteger),
           DList (Attribute v AtString)),
          DList (Attribute' v)))
-> AttributeGetWT' v (MaybeT (Either String)) ()
-> WriterT
     (DList (Attribute' v))
     (Either String)
     (((((), AtList v AtIpV4), AtList v AtText), AtList v AtInteger),
      DList (Attribute v AtString))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (((((((), AtList v AtIpV4), AtList v AtText), AtList v AtInteger),
  DList (Attribute v AtString)),
 DList (Attribute' v))
-> ((((((), AtList v AtIpV4), AtList v AtText),
      AtList v AtInteger),
     DList (Attribute v AtString))
    -> ((((((), AtList v AtIpV4), AtList v AtText),
          AtList v AtInteger),
         DList (Attribute v AtString)),
        DList (Attribute' v)))
-> Maybe
     (((((), AtList v AtIpV4), AtList v AtText), AtList v AtInteger),
      DList (Attribute v AtString))
-> ((((((), AtList v AtIpV4), AtList v AtText),
      AtList v AtInteger),
     DList (Attribute v AtString)),
    DList (Attribute' v))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ((((((), AtList v AtIpV4), AtList v AtText), AtList v AtInteger),
 DList (Attribute v AtString))
forall {v}.
(((((), AtList v AtIpV4), AtList v AtText), AtList v AtInteger),
 AtList v AtString)
emptyW, Attribute' v -> DList (Attribute' v)
forall a. a -> DList a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Attribute' v
a) (\(((((), AtList v AtIpV4), AtList v AtText), AtList v AtInteger),
 DList (Attribute v AtString))
x -> ((((((), AtList v AtIpV4), AtList v AtText), AtList v AtInteger),
 DList (Attribute v AtString))
x, DList (Attribute' v)
forall a. Monoid a => a
mempty)) (Maybe
   (((((), AtList v AtIpV4), AtList v AtText), AtList v AtInteger),
    DList (Attribute v AtString))
 -> ((((((), AtList v AtIpV4), AtList v AtText),
       AtList v AtInteger),
      DList (Attribute v AtString)),
     DList (Attribute' v)))
-> Either
     String
     (Maybe
        (((((), AtList v AtIpV4), AtList v AtText), AtList v AtInteger),
         DList (Attribute v AtString)))
-> Either
     String
     ((((((), AtList v AtIpV4), AtList v AtText), AtList v AtInteger),
       DList (Attribute v AtString)),
      DList (Attribute' v))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Either
   String
   (Maybe
      (((((), AtList v AtIpV4), AtList v AtText), AtList v AtInteger),
       DList (Attribute v AtString)))
 -> Either
      String
      ((((((), AtList v AtIpV4), AtList v AtText), AtList v AtInteger),
        DList (Attribute v AtString)),
       DList (Attribute' v)))
-> (AttributeGetWT' v (MaybeT (Either String)) ()
    -> Either
         String
         (Maybe
            (((((), AtList v AtIpV4), AtList v AtText), AtList v AtInteger),
             DList (Attribute v AtString))))
-> AttributeGetWT' v (MaybeT (Either String)) ()
-> Either
     String
     ((((((), AtList v AtIpV4), AtList v AtText), AtList v AtInteger),
       DList (Attribute v AtString)),
      DList (Attribute' v))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MaybeT
  (Either String)
  (((((), AtList v AtIpV4), AtList v AtText), AtList v AtInteger),
   DList (Attribute v AtString))
-> Either
     String
     (Maybe
        (((((), AtList v AtIpV4), AtList v AtText), AtList v AtInteger),
         DList (Attribute v AtString)))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT
   (Either String)
   (((((), AtList v AtIpV4), AtList v AtText), AtList v AtInteger),
    DList (Attribute v AtString))
 -> Either
      String
      (Maybe
         (((((), AtList v AtIpV4), AtList v AtText), AtList v AtInteger),
          DList (Attribute v AtString))))
-> (AttributeGetWT' v (MaybeT (Either String)) ()
    -> MaybeT
         (Either String)
         (((((), AtList v AtIpV4), AtList v AtText), AtList v AtInteger),
          DList (Attribute v AtString)))
-> AttributeGetWT' v (MaybeT (Either String)) ()
-> Either
     String
     (Maybe
        (((((), AtList v AtIpV4), AtList v AtText), AtList v AtInteger),
         DList (Attribute v AtString)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  {-- un-maybe with default untyped value  --}
  AttributeGetWT' v (MaybeT (Either String)) ()
-> MaybeT
     (Either String)
     (((((), AtList v AtIpV4), AtList v AtText), AtList v AtInteger),
      DList (Attribute v AtString))
forall v (m :: * -> *) a.
AttributeGetWT' v m a
-> m ((((a, AtList v AtIpV4), AtList v AtText),
       AtList v AtInteger),
      AtList v AtString)
runAttributeGetWT' (AttributeGetWT' v (MaybeT (Either String)) ()
 -> AttributeGetWT'
      v (WriterT (DList (Attribute' v)) (Either String)) ())
-> AttributeGetWT' v (MaybeT (Either String)) ()
-> AttributeGetWT'
     v (WriterT (DList (Attribute' v)) (Either String)) ()
forall a b. (a -> b) -> a -> b
$

  {-- recoverable context type, AttributeGetWT' (MaybeT (Either String)) --}
  do Attribute v AtString
ta <- MaybeT (Either String) (Attribute v AtString)
-> AttributeGetWT'
     v (MaybeT (Either String)) (Attribute v AtString)
forall (m :: * -> *) a v. Monad m => m a -> AttributeGetWT' v m a
liftAW (MaybeT (Either String) (Attribute v AtString)
 -> AttributeGetWT'
      v (MaybeT (Either String)) (Attribute v AtString))
-> MaybeT (Either String) (Attribute v AtString)
-> AttributeGetWT'
     v (MaybeT (Either String)) (Attribute v AtString)
forall a b. (a -> b) -> a -> b
$ Attribute' v -> MaybeT (Either String) (Attribute v AtString)
forall v.
(TypedNumberSets v, Ord v) =>
Attribute' v -> MaybeT (Either String) (Attribute v AtString)
decodeAsString  Attribute' v
a
     Attribute v AtString
ta Attribute v AtString
-> AttributeGetWT' v (MaybeT (Either String)) ()
-> AttributeGetWT' v (MaybeT (Either String)) ()
forall a b. a -> b -> b
`seq` AtWriterT
  v
  AtText
  (AtWriterT
     v AtInteger (AtWriterT v AtString (MaybeT (Either String))))
  ()
-> AttributeGetWT' v (MaybeT (Either String)) ()
forall (m :: * -> *) a.
Monad m =>
m a -> WriterT (AtList v AtIpV4) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (AtWriterT
   v
   AtText
   (AtWriterT
      v AtInteger (AtWriterT v AtString (MaybeT (Either String))))
   ()
 -> AttributeGetWT' v (MaybeT (Either String)) ())
-> (DList (Attribute v AtString)
    -> AtWriterT
         v
         AtText
         (AtWriterT
            v AtInteger (AtWriterT v AtString (MaybeT (Either String))))
         ())
-> DList (Attribute v AtString)
-> AttributeGetWT' v (MaybeT (Either String)) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AtWriterT
  v AtInteger (AtWriterT v AtString (MaybeT (Either String))) ()
-> AtWriterT
     v
     AtText
     (AtWriterT
        v AtInteger (AtWriterT v AtString (MaybeT (Either String))))
     ()
forall (m :: * -> *) a.
Monad m =>
m a -> WriterT (AtList v AtText) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (AtWriterT
   v AtInteger (AtWriterT v AtString (MaybeT (Either String))) ()
 -> AtWriterT
      v
      AtText
      (AtWriterT
         v AtInteger (AtWriterT v AtString (MaybeT (Either String))))
      ())
-> (DList (Attribute v AtString)
    -> AtWriterT
         v AtInteger (AtWriterT v AtString (MaybeT (Either String))) ())
-> DList (Attribute v AtString)
-> AtWriterT
     v
     AtText
     (AtWriterT
        v AtInteger (AtWriterT v AtString (MaybeT (Either String))))
     ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AtWriterT v AtString (MaybeT (Either String)) ()
-> AtWriterT
     v AtInteger (AtWriterT v AtString (MaybeT (Either String))) ()
forall (m :: * -> *) a.
Monad m =>
m a -> WriterT (AtList v AtInteger) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (AtWriterT v AtString (MaybeT (Either String)) ()
 -> AtWriterT
      v AtInteger (AtWriterT v AtString (MaybeT (Either String))) ())
-> (DList (Attribute v AtString)
    -> AtWriterT v AtString (MaybeT (Either String)) ())
-> DList (Attribute v AtString)
-> AtWriterT
     v AtInteger (AtWriterT v AtString (MaybeT (Either String))) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DList (Attribute v AtString)
-> AtWriterT v AtString (MaybeT (Either String)) ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
tell (DList (Attribute v AtString)
 -> AttributeGetWT' v (MaybeT (Either String)) ())
-> DList (Attribute v AtString)
-> AttributeGetWT' v (MaybeT (Either String)) ()
forall a b. (a -> b) -> a -> b
$ Attribute v AtString -> DList (Attribute v AtString)
forall a. a -> DList a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Attribute v AtString
ta
  AttributeGetWT' v (MaybeT (Either String)) ()
-> AttributeGetWT' v (MaybeT (Either String)) ()
-> AttributeGetWT' v (MaybeT (Either String)) ()
forall a.
WriterT
  (AtList v AtIpV4)
  (AtWriterT
     v
     AtText
     (AtWriterT
        v AtInteger (AtWriterT v AtString (MaybeT (Either String)))))
  a
-> WriterT
     (AtList v AtIpV4)
     (AtWriterT
        v
        AtText
        (AtWriterT
           v AtInteger (AtWriterT v AtString (MaybeT (Either String)))))
     a
-> WriterT
     (AtList v AtIpV4)
     (AtWriterT
        v
        AtText
        (AtWriterT
           v AtInteger (AtWriterT v AtString (MaybeT (Either String)))))
     a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  do Attribute v AtInteger
ta <- MaybeT (Either String) (Attribute v AtInteger)
-> AttributeGetWT'
     v (MaybeT (Either String)) (Attribute v AtInteger)
forall (m :: * -> *) a v. Monad m => m a -> AttributeGetWT' v m a
liftAW (MaybeT (Either String) (Attribute v AtInteger)
 -> AttributeGetWT'
      v (MaybeT (Either String)) (Attribute v AtInteger))
-> MaybeT (Either String) (Attribute v AtInteger)
-> AttributeGetWT'
     v (MaybeT (Either String)) (Attribute v AtInteger)
forall a b. (a -> b) -> a -> b
$ Attribute' v -> MaybeT (Either String) (Attribute v AtInteger)
forall v.
(TypedNumberSets v, Ord v) =>
Attribute' v -> MaybeT (Either String) (Attribute v AtInteger)
decodeAsInteger Attribute' v
a
     Attribute v AtInteger
ta Attribute v AtInteger
-> AttributeGetWT' v (MaybeT (Either String)) ()
-> AttributeGetWT' v (MaybeT (Either String)) ()
forall a b. a -> b -> b
`seq` AtWriterT
  v
  AtText
  (AtWriterT
     v AtInteger (AtWriterT v AtString (MaybeT (Either String))))
  ()
-> AttributeGetWT' v (MaybeT (Either String)) ()
forall (m :: * -> *) a.
Monad m =>
m a -> WriterT (AtList v AtIpV4) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (AtWriterT
   v
   AtText
   (AtWriterT
      v AtInteger (AtWriterT v AtString (MaybeT (Either String))))
   ()
 -> AttributeGetWT' v (MaybeT (Either String)) ())
-> (AtList v AtInteger
    -> AtWriterT
         v
         AtText
         (AtWriterT
            v AtInteger (AtWriterT v AtString (MaybeT (Either String))))
         ())
-> AtList v AtInteger
-> AttributeGetWT' v (MaybeT (Either String)) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AtWriterT
  v AtInteger (AtWriterT v AtString (MaybeT (Either String))) ()
-> AtWriterT
     v
     AtText
     (AtWriterT
        v AtInteger (AtWriterT v AtString (MaybeT (Either String))))
     ()
forall (m :: * -> *) a.
Monad m =>
m a -> WriterT (AtList v AtText) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (AtWriterT
   v AtInteger (AtWriterT v AtString (MaybeT (Either String))) ()
 -> AtWriterT
      v
      AtText
      (AtWriterT
         v AtInteger (AtWriterT v AtString (MaybeT (Either String))))
      ())
-> (AtList v AtInteger
    -> AtWriterT
         v AtInteger (AtWriterT v AtString (MaybeT (Either String))) ())
-> AtList v AtInteger
-> AtWriterT
     v
     AtText
     (AtWriterT
        v AtInteger (AtWriterT v AtString (MaybeT (Either String))))
     ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AtList v AtInteger
-> AtWriterT
     v AtInteger (AtWriterT v AtString (MaybeT (Either String))) ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
tell (AtList v AtInteger
 -> AttributeGetWT' v (MaybeT (Either String)) ())
-> AtList v AtInteger
-> AttributeGetWT' v (MaybeT (Either String)) ()
forall a b. (a -> b) -> a -> b
$ Attribute v AtInteger -> AtList v AtInteger
forall a. a -> DList a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Attribute v AtInteger
ta
  AttributeGetWT' v (MaybeT (Either String)) ()
-> AttributeGetWT' v (MaybeT (Either String)) ()
-> AttributeGetWT' v (MaybeT (Either String)) ()
forall a.
WriterT
  (AtList v AtIpV4)
  (AtWriterT
     v
     AtText
     (AtWriterT
        v AtInteger (AtWriterT v AtString (MaybeT (Either String)))))
  a
-> WriterT
     (AtList v AtIpV4)
     (AtWriterT
        v
        AtText
        (AtWriterT
           v AtInteger (AtWriterT v AtString (MaybeT (Either String)))))
     a
-> WriterT
     (AtList v AtIpV4)
     (AtWriterT
        v
        AtText
        (AtWriterT
           v AtInteger (AtWriterT v AtString (MaybeT (Either String)))))
     a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  do Attribute v AtText
ta <- MaybeT (Either String) (Attribute v AtText)
-> AttributeGetWT' v (MaybeT (Either String)) (Attribute v AtText)
forall (m :: * -> *) a v. Monad m => m a -> AttributeGetWT' v m a
liftAW (MaybeT (Either String) (Attribute v AtText)
 -> AttributeGetWT' v (MaybeT (Either String)) (Attribute v AtText))
-> MaybeT (Either String) (Attribute v AtText)
-> AttributeGetWT' v (MaybeT (Either String)) (Attribute v AtText)
forall a b. (a -> b) -> a -> b
$ Attribute' v -> MaybeT (Either String) (Attribute v AtText)
forall v.
(TypedNumberSets v, Ord v) =>
Attribute' v -> MaybeT (Either String) (Attribute v AtText)
decodeAsText    Attribute' v
a
     Attribute v AtText
ta Attribute v AtText
-> AttributeGetWT' v (MaybeT (Either String)) ()
-> AttributeGetWT' v (MaybeT (Either String)) ()
forall a b. a -> b -> b
`seq` AtWriterT
  v
  AtText
  (AtWriterT
     v AtInteger (AtWriterT v AtString (MaybeT (Either String))))
  ()
-> AttributeGetWT' v (MaybeT (Either String)) ()
forall (m :: * -> *) a.
Monad m =>
m a -> WriterT (AtList v AtIpV4) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (AtWriterT
   v
   AtText
   (AtWriterT
      v AtInteger (AtWriterT v AtString (MaybeT (Either String))))
   ()
 -> AttributeGetWT' v (MaybeT (Either String)) ())
-> (AtList v AtText
    -> AtWriterT
         v
         AtText
         (AtWriterT
            v AtInteger (AtWriterT v AtString (MaybeT (Either String))))
         ())
-> AtList v AtText
-> AttributeGetWT' v (MaybeT (Either String)) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AtList v AtText
-> AtWriterT
     v
     AtText
     (AtWriterT
        v AtInteger (AtWriterT v AtString (MaybeT (Either String))))
     ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
tell (AtList v AtText -> AttributeGetWT' v (MaybeT (Either String)) ())
-> AtList v AtText -> AttributeGetWT' v (MaybeT (Either String)) ()
forall a b. (a -> b) -> a -> b
$ Attribute v AtText -> AtList v AtText
forall a. a -> DList a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Attribute v AtText
ta
  AttributeGetWT' v (MaybeT (Either String)) ()
-> AttributeGetWT' v (MaybeT (Either String)) ()
-> AttributeGetWT' v (MaybeT (Either String)) ()
forall a.
WriterT
  (AtList v AtIpV4)
  (AtWriterT
     v
     AtText
     (AtWriterT
        v AtInteger (AtWriterT v AtString (MaybeT (Either String)))))
  a
-> WriterT
     (AtList v AtIpV4)
     (AtWriterT
        v
        AtText
        (AtWriterT
           v AtInteger (AtWriterT v AtString (MaybeT (Either String)))))
     a
-> WriterT
     (AtList v AtIpV4)
     (AtWriterT
        v
        AtText
        (AtWriterT
           v AtInteger (AtWriterT v AtString (MaybeT (Either String)))))
     a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  do Attribute v AtIpV4
ta <- MaybeT (Either String) (Attribute v AtIpV4)
-> AttributeGetWT' v (MaybeT (Either String)) (Attribute v AtIpV4)
forall (m :: * -> *) a v. Monad m => m a -> AttributeGetWT' v m a
liftAW (MaybeT (Either String) (Attribute v AtIpV4)
 -> AttributeGetWT' v (MaybeT (Either String)) (Attribute v AtIpV4))
-> MaybeT (Either String) (Attribute v AtIpV4)
-> AttributeGetWT' v (MaybeT (Either String)) (Attribute v AtIpV4)
forall a b. (a -> b) -> a -> b
$ Attribute' v -> MaybeT (Either String) (Attribute v AtIpV4)
forall v.
(TypedNumberSets v, Ord v) =>
Attribute' v -> MaybeT (Either String) (Attribute v AtIpV4)
decodeAsIpV4    Attribute' v
a
     Attribute v AtIpV4
ta Attribute v AtIpV4
-> AttributeGetWT' v (MaybeT (Either String)) ()
-> AttributeGetWT' v (MaybeT (Either String)) ()
forall a b. a -> b -> b
`seq` AtList v AtIpV4 -> AttributeGetWT' v (MaybeT (Either String)) ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
tell (AtList v AtIpV4 -> AttributeGetWT' v (MaybeT (Either String)) ())
-> AtList v AtIpV4 -> AttributeGetWT' v (MaybeT (Either String)) ()
forall a b. (a -> b) -> a -> b
$ Attribute v AtIpV4 -> AtList v AtIpV4
forall a. a -> DList a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Attribute v AtIpV4
ta

attributeGetWT :: m (((((a, AtList v AtIpV4), AtList v AtText), AtList v AtInteger), AtList v AtString), DList (Attribute' v))
                 -> AttributeGetWT v m a
attributeGetWT :: forall (m :: * -> *) a v.
m (((((a, AtList v AtIpV4), AtList v AtText), AtList v AtInteger),
    AtList v AtString),
   DList (Attribute' v))
-> AttributeGetWT v m a
attributeGetWT = WriterT
  (DList (Attribute' v))
  m
  ((((a, AtList v AtIpV4), AtList v AtText), AtList v AtInteger),
   AtList v AtString)
-> AttributeGetWT' v (WriterT (DList (Attribute' v)) m) a
forall (m :: * -> *) a v.
m ((((a, AtList v AtIpV4), AtList v AtText), AtList v AtInteger),
   AtList v AtString)
-> AttributeGetWT' v m a
attributeGetWT' (WriterT
   (DList (Attribute' v))
   m
   ((((a, AtList v AtIpV4), AtList v AtText), AtList v AtInteger),
    AtList v AtString)
 -> AttributeGetWT' v (WriterT (DList (Attribute' v)) m) a)
-> (m (((((a, AtList v AtIpV4), AtList v AtText),
         AtList v AtInteger),
        AtList v AtString),
       DList (Attribute' v))
    -> WriterT
         (DList (Attribute' v))
         m
         ((((a, AtList v AtIpV4), AtList v AtText), AtList v AtInteger),
          AtList v AtString))
-> m (((((a, AtList v AtIpV4), AtList v AtText),
        AtList v AtInteger),
       AtList v AtString),
      DList (Attribute' v))
-> AttributeGetWT' v (WriterT (DList (Attribute' v)) m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (((((a, AtList v AtIpV4), AtList v AtText), AtList v AtInteger),
    AtList v AtString),
   DList (Attribute' v))
-> WriterT
     (DList (Attribute' v))
     m
     ((((a, AtList v AtIpV4), AtList v AtText), AtList v AtInteger),
      AtList v AtString)
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
WriterT

runAttributeGetWT :: AttributeGetWT v m a
                    -> m (((((a, AtList v AtIpV4), AtList v AtText), AtList v AtInteger), AtList v AtString), DList (Attribute' v))
runAttributeGetWT :: forall v (m :: * -> *) a.
AttributeGetWT v m a
-> m (((((a, AtList v AtIpV4), AtList v AtText),
        AtList v AtInteger),
       AtList v AtString),
      DList (Attribute' v))
runAttributeGetWT = WriterT
  (DList (Attribute' v))
  m
  ((((a, AtList v AtIpV4), AtList v AtText), AtList v AtInteger),
   AtList v AtString)
-> m (((((a, AtList v AtIpV4), AtList v AtText),
        AtList v AtInteger),
       AtList v AtString),
      DList (Attribute' v))
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT (WriterT
   (DList (Attribute' v))
   m
   ((((a, AtList v AtIpV4), AtList v AtText), AtList v AtInteger),
    AtList v AtString)
 -> m (((((a, AtList v AtIpV4), AtList v AtText),
         AtList v AtInteger),
        AtList v AtString),
       DList (Attribute' v)))
-> (AttributeGetWT v m a
    -> WriterT
         (DList (Attribute' v))
         m
         ((((a, AtList v AtIpV4), AtList v AtText), AtList v AtInteger),
          AtList v AtString))
-> AttributeGetWT v m a
-> m (((((a, AtList v AtIpV4), AtList v AtText),
        AtList v AtInteger),
       AtList v AtString),
      DList (Attribute' v))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AttributeGetWT v m a
-> WriterT
     (DList (Attribute' v))
     m
     ((((a, AtList v AtIpV4), AtList v AtText), AtList v AtInteger),
      AtList v AtString)
forall v (m :: * -> *) a.
AttributeGetWT' v m a
-> m ((((a, AtList v AtIpV4), AtList v AtText),
       AtList v AtInteger),
      AtList v AtString)
runAttributeGetWT'


-- | Type to express typed attribute set
data Attributes v =
  Attributes
  { forall v. Attributes v -> [Attribute v AtText]
textAttributes     :: ![Attribute v AtText]
  , forall v. Attributes v -> [Attribute v AtString]
stringAttributes   :: ![Attribute v AtString]
  , forall v. Attributes v -> [Attribute v AtInteger]
integerAttributes  :: ![Attribute v AtInteger]
  , forall v. Attributes v -> [Attribute v AtIpV4]
ipV4Attributes     :: ![Attribute v AtIpV4]
  , forall v. Attributes v -> [Attribute' v]
untypedAttributes  :: ![Attribute' v]
  }

-- | Extract typed attributes.
--   For example, use like this: /extractAttributes . mapM tellT/
extractAttributes :: Monad m => AttributeGetWT v m a -> m (Attributes v)
extractAttributes :: forall (m :: * -> *) v a.
Monad m =>
AttributeGetWT v m a -> m (Attributes v)
extractAttributes AttributeGetWT v m a
w = do
  (((((a
_, AtList v AtIpV4
ips), AtList v AtText
txts), AtList v AtInteger
ints), AtList v AtString
strs), DList (Attribute' v)
utys)  <- AttributeGetWT v m a
-> m (((((a, AtList v AtIpV4), AtList v AtText),
        AtList v AtInteger),
       AtList v AtString),
      DList (Attribute' v))
forall v (m :: * -> *) a.
AttributeGetWT v m a
-> m (((((a, AtList v AtIpV4), AtList v AtText),
        AtList v AtInteger),
       AtList v AtString),
      DList (Attribute' v))
runAttributeGetWT AttributeGetWT v m a
w
  Attributes v -> m (Attributes v)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Attributes v -> m (Attributes v))
-> Attributes v -> m (Attributes v)
forall a b. (a -> b) -> a -> b
$
    Attributes
    { textAttributes :: [Attribute v AtText]
textAttributes     =  AtList v AtText -> [Attribute v AtText]
forall a. DList a -> [a]
DList.toList AtList v AtText
txts
    , stringAttributes :: [Attribute v AtString]
stringAttributes   =  AtList v AtString -> [Attribute v AtString]
forall a. DList a -> [a]
DList.toList AtList v AtString
strs
    , integerAttributes :: [Attribute v AtInteger]
integerAttributes  =  AtList v AtInteger -> [Attribute v AtInteger]
forall a. DList a -> [a]
DList.toList AtList v AtInteger
ints
    , ipV4Attributes :: [Attribute v AtIpV4]
ipV4Attributes     =  AtList v AtIpV4 -> [Attribute v AtIpV4]
forall a. DList a -> [a]
DList.toList AtList v AtIpV4
ips
    , untypedAttributes :: [Attribute' v]
untypedAttributes  =  DList (Attribute' v) -> [Attribute' v]
forall a. DList a -> [a]
DList.toList DList (Attribute' v)
utys
    }

-- | Type class to generalize typed attribute param
class TypedAttributes a where
  typedAttributes :: Attributes v -> [Attribute v a]

instance TypedAttributes AtText where
  typedAttributes :: forall v. Attributes v -> [Attribute v AtText]
typedAttributes = Attributes v -> [Attribute v AtText]
forall v. Attributes v -> [Attribute v AtText]
textAttributes

instance TypedAttributes AtString where
  typedAttributes :: forall v. Attributes v -> [Attribute v AtString]
typedAttributes = Attributes v -> [Attribute v AtString]
forall v. Attributes v -> [Attribute v AtString]
stringAttributes

instance TypedAttributes AtInteger where
  typedAttributes :: forall v. Attributes v -> [Attribute v AtInteger]
typedAttributes = Attributes v -> [Attribute v AtInteger]
forall v. Attributes v -> [Attribute v AtInteger]
integerAttributes

instance TypedAttributes AtIpV4 where
  typedAttributes :: forall v. Attributes v -> [Attribute v AtIpV4]
typedAttributes = Attributes v -> [Attribute v AtIpV4]
forall v. Attributes v -> [Attribute v AtIpV4]
ipV4Attributes

-- | Get typed attribute from attribute set.
{-# SPECIALIZE takeTyped' :: (TypedAttributes a, Eq v) => Attributes v -> TypedNumber v a -> Maybe (Attribute v a) #-}
{-# SPECIALIZE takeTyped' :: (TypedAttributes a, Eq v) => Attributes v -> TypedNumber v a -> [Attribute v a] #-}
takeTyped' :: (MonadPlus m, TypedAttributes a, Eq v)
           => Attributes v
           -> TypedNumber v a
           -> m (Attribute v a)
takeTyped' :: forall (m :: * -> *) a v.
(MonadPlus m, TypedAttributes a, Eq v) =>
Attributes v -> TypedNumber v a -> m (Attribute v a)
takeTyped' Attributes v
attrs TypedNumber v a
tn0 =
    [m (Attribute v a)] -> m (Attribute v a)
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum [ Attribute v a -> m (Attribute v a)
forall {m :: * -> *}.
(Monad m, Alternative m) =>
Attribute v a -> m (Attribute v a)
testA Attribute v a
a | Attribute v a
a <- Attributes v -> [Attribute v a]
forall a v. TypedAttributes a => Attributes v -> [Attribute v a]
forall v. Attributes v -> [Attribute v a]
typedAttributes Attributes v
attrs ]
  where
    testA :: Attribute v a -> m (Attribute v a)
testA a :: Attribute v a
a@(Attribute TypedNumber v a
tn a
_) = do
      Bool -> m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> m ()) -> Bool -> m ()
forall a b. (a -> b) -> a -> b
$ TypedNumber v a
tn TypedNumber v a -> TypedNumber v a -> Bool
forall a. Eq a => a -> a -> Bool
== TypedNumber v a
tn0
      Attribute v a -> m (Attribute v a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Attribute v a
a

-- | Get typed attribute value from attribute set.
{-# SPECIALIZE takeTyped :: (TypedAttributes a, Eq v) => Attributes v -> TypedNumber v a -> Maybe a #-}
{-# SPECIALIZE takeTyped :: (TypedAttributes a, Eq v) => Attributes v -> TypedNumber v a -> [a] #-}
takeTyped :: (MonadPlus m, TypedAttributes a, Eq v)
          => Attributes v
          -> TypedNumber v a
          -> m a
takeTyped :: forall (m :: * -> *) a v.
(MonadPlus m, TypedAttributes a, Eq v) =>
Attributes v -> TypedNumber v a -> m a
takeTyped Attributes v
attrs = (Attribute v a -> a) -> m (Attribute v a) -> m a
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Attribute v a -> a
forall v a. Attribute v a -> a
value (m (Attribute v a) -> m a)
-> (TypedNumber v a -> m (Attribute v a)) -> TypedNumber v a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attributes v -> TypedNumber v a -> m (Attribute v a)
forall (m :: * -> *) a v.
(MonadPlus m, TypedAttributes a, Eq v) =>
Attributes v -> TypedNumber v a -> m (Attribute v a)
takeTyped' Attributes v
attrs