Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
Example own Traversable
module Playground18 where
import DA.Foldable
import DA.Traversable
import Daml.Script
import Prelude hiding (mapA)
-- Goal : get a better understanding of the Traversable typeclass by implementing it on a binary tree
data Tree a
= Leaf
| Node with
value : a
left : Tree a
right : Tree a
-- first we define functoriality (with respect to the contained argument)
instance Functor Tree where
-- (a -> b) -> t a -> t b
fmap f Leaf = Leaf
fmap f Node{..} = Node with value = f value, left = fmap f left, right = fmap f right
-- secondly, we implement foldability (with respect to the contained argument)
instance Foldable Tree where
-- Monoid m => (a -> m) -> t a -> m
foldMap f Leaf = mempty
foldMap f Node{..} = foldMap f left <> f value <> foldMap f right
-- thirdly, we want to traverse the tree
-- applicative : given f (a -> b) and f a, I can put them together with <*>
instance Traversable Tree where
-- basically by applying mapA with a carefully chosen action (my node builder + mapA f) I end up with the
-- applicative partially applied to the left part of the tree (because applicative operators are left associative)
-- we then use this applicative to build the rest of the tree
-- it would be easy to change the order of application (using do notation)
mapA f Leaf = pure Leaf
mapA f Node{..} =
let buildNode l c r = Node with left = l, value = c, right = r
in buildNode <$> mapA f left <*> f value <*> mapA f right
template T with
p : Party
t : Text
where signatory p
effectfulFunction : Party -> Text -> Script Text
effectfulFunction p t = do
submit p do createCmd T with p,t
pure t
script : Script ()
script = do
p <- allocateParty "p"
-- build tree
-- a
-- / \
-- b e
-- / \ / \
-- c d f g
let tree = Node
with
value = "a"
left = Node
with
value = "b"
left = Node
with
value = "c"
left = Leaf
right = Leaf
right = Node
with
value = "d"
left = Leaf
right = Leaf
right = Node
with
value = "e"
left = Node
with
value = "f"
left = Leaf
right = Leaf
right = Node
with
value = "g"
left = Leaf
right = Leaf
-- traverse the tree, creating one contract per node
x <- mapA (effectfulFunction p) tree
pure ()
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment