OnlineTree.hs

{-# LANGUAGE DeriveFoldable    #-}
{-# LANGUAGE DeriveFunctor     #-}
{-# LANGUAGE DeriveTraversable #-}
{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} -- uniplate patterns
{-# OPTIONS_HADDOCK show-extensions #-}

-- |
-- Module      :  Yi.Syntax.OnlineTree
-- License     :  GPL-2
-- Maintainer  :  yi-devel@googlegroups.com
-- Stability   :  experimental
-- Portability :  portable
--
-- Module defining the 'Tree' used as part of many 'Mode's.

module Yi.Syntax.OnlineTree (Tree(..), manyToks,
                             tokAtOrBefore) where

import Yi.IncrementalParse (P, Parser (Look), symbol)
import Yi.Lexer.Alex       (Tok)
import Yi.Syntax.Tree      (IsTree (emptyNode, uniplate), tokAtOrBefore)

data Tree a = Bin (Tree a) (Tree a)
            | Leaf a
            | Tip
              deriving (Show, Functor, Foldable, Traversable)

instance IsTree Tree where
    emptyNode = Tip
    uniplate (Bin l r) = ([l,r],\[l',r'] -> Bin l' r')
    uniplate t = ([],const t)

manyToks :: P (Tok t) (Tree (Tok t))
manyToks = manyToks' 1

manyToks' :: Int -> P a (Tree a)
manyToks' n = Look (pure Tip) (\_ -> Bin <$> subTree n <*> manyToks' (n * 2))

subTree :: Int -> P a (Tree a)
subTree n = Look (pure Tip) . const $ case n of
  0 -> pure Tip
  1 -> Leaf <$> symbol (const True)
  _ -> let m = n `div` 2 in Bin <$> subTree m <*> subTree m