module PlotTypes ( Channel(..)
, PbPrim(..)
, PbTree(..)
, PbTree'(..)
, XAxisType(..)
, pbTreeToTree
) where
import Control.Concurrent ( MVar, ThreadId )
import qualified Data.ByteString.Lazy as BSL
import Data.Sequence ( Seq )
import Data.Time ( NominalDiffTime )
import Data.Tree ( Tree(..) )
import qualified Text.ProtocolBuffers.Header as P'
import Data.Functor.Compose
import Data.Functor.Identity
data XAxisType a = XAxisTime
| XAxisCounter
| XAxisStaticCounter
| XAxisFun (String, a -> PbPrim)
data Channel = forall a. Channel { chanName :: String
, chanGetters :: Tree (String, String, Maybe (a -> PbPrim))
, chanSeq :: MVar (Seq (a,Int,NominalDiffTime))
, chanMaxHist :: MVar Int
, chanServerThreadId :: ThreadId
, chanGetByteStrings :: IO [(BSL.ByteString, Int, NominalDiffTime)]
}
data PbTree a where
PbtGetter :: (a -> PbPrim) -> PbTree a
PbtStruct :: [(String,PbTree a)] -> PbTree a
PbtFunctor :: Functor g => (g PbPrim -> PbPrim) -> (a -> g b) -> PbTree b -> (String -> String) -> PbTree a
data PbTree' a = PbtGetter' (a -> PbPrim)
| PbtStruct' [(String,PbTree' a)]
| PbtFunctor' (PbTree' a) (String -> String)
pbTreeToTree :: String -> PbTree a -> Tree (String, String, Maybe (a -> PbPrim))
pbTreeToTree name tree = pbTreeToTree' "" name (please tree)
cat :: String -> String -> String
cat [] y = y
cat x y = x ++ "." ++ y
pbTreeToTree' :: String -> String -> PbTree' a -> Tree (String, String, Maybe (a -> PbPrim))
pbTreeToTree' prefix name (PbtGetter' get) = Node (name, cat prefix name, Just get) []
pbTreeToTree' prefix name (PbtStruct' stuff) =
Node (name, cat prefix name, Nothing) (map (uncurry (pbTreeToTree' (cat prefix name))) stuff)
pbTreeToTree' prefix name (PbtFunctor' tree s2s) = pbTreeToTree' prefix (s2s name) tree
please :: PbTree a -> PbTree' a
please = f Identity runIdentity
f :: Functor f => (a -> f b) -> (f PbPrim -> PbPrim) -> PbTree b -> PbTree' a
f afb unfunct (PbtGetter get) = PbtGetter' $ \a -> unfunct $ fmap get (afb a)
f afb unfunct (PbtStruct stuff) = PbtStruct' $ zip names (map (f afb unfunct) trees)
where
(names,trees) = unzip stuff
f afb unfunct (PbtFunctor unfunct' h theRest s2s) = PbtFunctor' (f wow blah theRest) s2s
where
wow a = Compose (fmap h (afb a))
blah fga = unfunct $ fmap unfunct' (getCompose fga)
data PbPrim = PbDouble Double
| PbFloat Float
| PbInt32 P'.Int32
| PbInt64 P'.Int64
| PbWord32 P'.Word32
| PbWord64 P'.Word64
| PbBool Bool
| PbUtf8 P'.Utf8
| PbByteString BSL.ByteString
| PbSeq (Seq PbPrim)
| PbMaybe (Maybe PbPrim)
| PbEnum (Int,String)