Tree.hs

module Tree where

import Data.Map
import Debug.Trace

data Ion = IonSymbol String | IonStruct (Map String Ion) | IonString String | IonList [Ion] deriving Show
data Tree a = Node String (Map String (Tree a)) (Maybe (DerivedAttribute Ion)) deriving Show
type DerivedAttribute a = Map String a
-- TODO
-- make derived attribute a new type and add other attribute ctors

unionStruct :: Ion -> Ion -> Ion
unionStruct (IonStruct s1) (IonStruct s2) = IonStruct (union s1 s2)
unionStruct _ _ = error "Not an IonStruct"

derive :: Maybe (Map String Ion) -> Maybe Ion -> Maybe Ion
derive Nothing ion  = ion
derive mp (Just (IonStruct struct)) = IonStruct <$> (union <$> mp <*> pure struct)
derive mp _ = error "Not an IonStruct"

process :: Tree Ion -> Maybe Ion -> Maybe Ion
process (Node key child v) (Just (IonStruct struct)) = do
  r <- if member key struct
      then do
        c <- pure (mapWithKey (\k -> \c -> process c derived) child)
        u <- foldlWithKey (\b -> \k -> \a -> unionStruct <$> b <*> a) derived c
        return u
      else derived
  return r
  where
    original = (Just (IonStruct struct))
    derived  = derive v original
process (Node _ _ Nothing) ion = ion

input = Just (IonStruct (fromList [
      ("f_c", IonString "c_s")
]))
tree = Node "f_c" (fromList [("c_s",
        Node "c_s" (fromList []
        ) (Just (fromList [("foo", IonString "bar")])))]
       ) Nothing

main :: IO ()
main = putStrLn $ show $ process tree input