Skip to content

Instantly share code, notes, and snippets.

@Noeyfan
Last active Jul 7, 2019
Embed
What would you like to do?
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
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment