BinaryTree

BinaryTree.hs

import           Data.Function                  ( fix )
import           Optics

{- Given a binary tree, produce the sums of all
   the paths from the root to each of the leaves.

   NeoVim with HLS (Haskell Language Server)

   $> ghcid -W -a -c 'cabal repl lib:graph-mach-core'

  ScopedTypeVariables is an extension in Haskell

  LambdaCase extension in Haskell
-}

data BinaryTree a where
  Leaf ::a -> BinaryTree a
  Node ::{ _ltree :: BinaryTree a,
      _value :: a,
      _rtree :: BinaryTree a
    } ->
    BinaryTree a
  deriving (Show)

makeLenses ''BinaryTree
makePrisms ''BinaryTree

-- | fix point combinator, Y - combinator
gsums'' :: forall a . (Num a) => BinaryTree a -> [] a
gsums'' = fix \r -> \case
  Leaf a       -> [a]
  Node lt a rt -> fmap (+ a) (r lt <> r rt)

gsums :: forall a . Num a => BinaryTree a -> [] a
gsums (Leaf a      ) = [a]
gsums (Node lt a rt) = fmap (+ a) (gsums lt <> gsums rt)

-- | using CPS (Continuation Passing Style) style
gsums' :: forall a . (Num a) => BinaryTree a -> [] a
gsums' = go id
 where
  go fn (Leaf a) = fn [a]
  go fn (Node lt a rt) =
    go (\lr -> go (\rr -> (fn . fmap (+ a)) (lr <> rr)) rt) lt

gsums'''
  :: forall a f
   . (Num a, Semigroup (f a), Applicative f)
  => BinaryTree a
  -> f a
gsums''' =
  (fix \r fn -> \case
      Leaf a       -> pure a & fn
      Node lt a rt -> flip r lt \lr -> flip r rt \rr -> lr <> rr <&> (+ a) & fn
    )
    id