<commit_before>{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ExistentialQuantification #-}
module Network.Protocol.Snmp.AgentX.ATree where

import Data.Tree
import Data.Tree.Zipper hiding (insert, parent)
import qualified Data.Tree.Zipper as Zip
import qualified Data.List as L
import Safe
import Control.Applicative
import Data.Monoid
import Control.Monad.State
import Network.Protocol.Snmp (Value(..), OID)
import Network.Protocol.Snmp.AgentX.Types
import Control.Exception
import Data.Typeable
import Data.Maybe

data MIB = Module OID Integer Parent Name
         | Object OID Integer Parent Name Update
         | ObjectType OID Integer Parent Name Value Update

instance Eq MIB where
    x == y = oid x == oid y

instance Ord MIB where
    compare x y = compare (oid x) (oid y)

class Items a where
    parent :: a -> Parent
    name   :: a -> Name
    int    :: a -> Integer
    oid    :: a -> OID

instance Items MIB where
    parent (Module _ _ x _) = x
    parent (Object _ _ x _ _) = x
    parent (ObjectType _ _ x _ _ _) = x
    name (Module _ _ _ x) = x
    name (Object _ _ _ x _) = x
    name (ObjectType _ _ _ x _ _) = x
    int (Module _ x _ _) = x
    int (Object _ x _ _ _) = x
    int (ObjectType _ x _ _ _ _) = x
    oid (Module x _ _ _) = x
    oid (Object x _ _ _ _) = x
    oid (ObjectType x _ _ _ _ _) = x

emptyMib = Node (Module [1,3,6,1,4444] 4444 "enterprise" "Fixmon") []

ls = [ Object [] 0 "Fixmon" "one" Fixed
     , Object [] 0 "one" "two" Fixed
     , ObjectType [] 0 "two" "six" (Integer 1) Fixed
     , Object [] 1 "one" "tree" Fixed
     , ObjectType [] 1 "two" "seven" (Integer 1) Fixed
     , ObjectType [] 1 "tree" "five" (Integer 1) Fixed
     , ObjectType [] 0 "tree" "fourt" (Integer 1) Fixed
     ]

makeOid :: [MIB] -> [MIB]
makeOid (y@(Module x i _ n):xs) = addOid [] y : makeOid' [(n, [i])] xs
makeOid (y@(Object x i _ n _):xs) = addOid [] y : makeOid' [(n, [i])] xs
makeOid (y@(ObjectType x i _ n _ _):xs) = addOid [] y : makeOid' [(n, [i])] xs

makeOid' :: [(Name, OID)] -> [MIB] -> [MIB]
makeOid' _ [] = []
makeOid' base (x:xs) =
   let Just prev = lookup (parent x) base 
       newbase = (name x, prev <> [int x]) : base
   in addOid prev x : makeOid' newbase xs

tailOid :: MIB -> MIB
tailOid (Module oi a b c) = Module (tail oi) a b c
tailOid (Object oi a b c d) = Object (tail oi) a b c d
tailOid (ObjectType oi a b c d e) = ObjectType (tail oi) a b c d e

insert :: MIB -> MIBTree -> MIBTree
insert y t <commit_msg>rose tree as binary<commit_after>{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
module Network.Protocol.Snmp.AgentX.ATree where

import Data.Tree
import Data.Tree.Zipper hiding (insert, parent, next)
import qualified Data.Tree.Zipper as Zip
import qualified Data.List as L
import Safe
import Control.Applicative
import Data.Monoid
import Control.Monad.State
import Network.Protocol.Snmp (Value(..), OID)
import Network.Protocol.Snmp.AgentX.Types
import Control.Exception
import Data.Typeable
import Data.Maybe
import Debug.Trace

data BinTree a i = 
    Fork { val :: i
         , object :: Maybe a
         , next :: BinTree a i
         , link :: BinTree a i
         }          
    | Empty
    deriving (Show, Eq)

class (Eq b, Ord b) => HasPath a b where
    path :: a -> [b]

instance HasPath MIB Integer where
    path (Module p _ _ _) = p
    path (Object p _ _ _ _) = p
    path (ObjectType p _ _ _ _ _) = p

instance HasPath [Integer] Integer where
    path = id

btl :: [OID]
btl = [[0,0,1], [0,1,0], [0,1,1],[0,0,0] ]

singleton :: HasPath a b => a -> BinTree a b
singleton m = singleton' (path m, m) 
    where
    singleton' ([x], m) = Fork x (Just m) Empty Empty
    singleton' ((x:xs), m) = Fork x Nothing Empty $ singleton' (xs, m)

fromList :: HasPath a b => [a] -> BinTree a b
fromList = foldl1 (<>) . map singleton 

data BException = TwoObjectInOnePath deriving (Typeable, Eq, Show)

instance Exception BException

instance HasPath a b => Monoid (BinTree a b) where
    mempty = Empty
    Empty `mappend` Empty = Empty
    (Fork x o n l) `mappend` Empty = Fork x o n l
    Empty `mappend` (Fork x o n l) = Fork x o n l
    xt@(Fork x xo nx lx) `mappend` yt@(Fork y yo ny ly) 
        | x == y = Fork x (splitD xo yo) (nx `mappend` ny) (lx `mappend` ly)
        | otherwise = Fork x xo (yt `mappend` nx) lx
        where
        splitD Nothing Nothing = Nothing
        splitD (Just a) Nothing = Just a
        splitD Nothing (Just a) = Just a
        splitD _ _ = throw TwoObjectInOnePath

convert :: BinTree a Integer -> Tree a
convert (Fork _ o n l) 
  | isNothing o = convert l  
  | otherwise = Node (fromJust o) $ convertToForest l <> convertToForest n
  where
      convertToForest :: BinTree a Integer -> Forest a
      convertToForest Empty = []
      convertToForest (Fork _ o Empty Empty) = [Node (fromJust o) []]
      convertToForest (Fork _ o n   Empty) = Node (fromJust o) [] : convertToForest n
      convertToForest (Fork _ o Empty l  ) = Node (fromJust o) [] : convertToForest l
      convertToForest (Fork _ o n   l  ) = (Node (fromJust o) (convertToForest l)) : convertToForest n

findB :: OID -> BinTree MIB Integer -> Maybe MIB
findB _ Empty = Nothing
findB [x] bt 
  | val bt == x = object bt
  | val bt /= x = findB [x] (next bt)
findB (x:xs) bt
  | val bt == x = findB xs (link bt)
  | otherwise = findB (x:xs) (next bt)

data MIB = Module OID Integer Parent Name
         | Object OID Integer Parent Name Update
         | ObjectType OID Integer Parent Name Value Update

instance Eq MIB where
    x == y = oid x == oid y

instance Ord MIB where
    compare x y = compare (oid x) (oid y)

class Items a where
    parent :: a -> Parent
    name   :: a -> Name
    int    :: a -> Integer
    oid    :: a -> OID

instance Items MIB where
    parent (Module _ _ x _) = x
    parent (Object _ _ x _ _) = x
    parent (ObjectType _ _ x _ _ _) = x
    name (Module _ _ _ x) = x
    name (Object _ _ _ x _) = x
    name (ObjectType _ _ _ x _ _) = x
    int (Module _ x _ _) = x
    int (Object _ x _ _ _) = x
    int (ObjectType _ x _ _ _ _) = x
    oid (Module x _ _ _) = x
    oid (Object x _ _ _ _) = x
    oid (ObjectType x _ _ _ _ _) = x

emptyMib = Node (Module [1,3,6,1,4444] 4444 "enterprise" "Fixmon") []

ls = [ Module [1,3,6,1,4444] 4444 "enterprise" "Fixmon"
     , Object [] 0 "Fixmon" "one" Fixed
     , Object [] 0 "one" "two" Fixed
     , ObjectType [] 0 "two" "six" (Integer 1) Fixed
     , Object [] 1 "one" "tree" Fixed
     , ObjectType [] 1 "two" "seven" (Integer 1) Fixed
     , ObjectType [] 1 "tree" "five" (Integer 1) Fixed
     , ObjectType [] 0 "tree" "fourt" (Integer 1) Fixed
     ]

makeOid :: [MIB] -> [MIB]
makeOid (y@(Module x i p n):xs) = y : makeOid' [(n, x)] xs
makeOid (y@(Object x i _ n _):xs) = addOid [] y : makeOid' [(n, [i])] xs
makeOid (y@(ObjectType x i _ n _ _):xs) = addOid [] y : makeOid' [(n, [i])] xs

makeOid' :: [(Name, OID)] -> [MIB] -> [MIB]
makeOid' _ [] = []
makeOid' base (x:xs) =
   let Just prev = lookup (parent x) base 
       newbase = (name x, prev <> [int x]) : base
   in addOid prev x : makeOid' newbase xs

tailOid :: MIB -> MIB
tailOid (Module oi a b c) = Module (tail oi) a b c
tailOid (Object oi a b c d) = Object (tail oi) a b c d
tailOid (ObjectType oi a b c d e) = ObjectType (tail oi) a b c d e

insert :: MIB -> MIBTree -> MIBTree
insert y t 
{'fraction_non_alphanumeric': 0.12396694214876033, 'fraction_numerical': 0.009464142895227939, 'mean_word_length': 2.686977886977887, 'pattern_counts': {'":': 0, '<': 7, '<?xml version=': 0, '>': 38, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '7308442', 'n_tokens_mistral': 2851, 'n_tokens_neox': 2737, 'n_words': 994}