{-# LANGUAGE ScopedTypeVariables, UnboxedTuples #-}
module Unboxed (mySplit) where

import Prelude hiding (null, reverse)

import Data.Monoid

data Digit a
	= One a
	| Two a a
	| Three a a a
	| Four a a a a

newtype Size = Size Int

data FingerTree v a = Empty | Single a | Deep !v !(Digit a) (FingerTree v (Node v a)) !(Digit a)
data Node v a = Node2 !v a a | Node3 !v a a a

type Split t a = (# t, a, t #)
  

-- measurements
myMeasure :: Node v b -> v
myMeasure (Node2 v _ _) = v
myMeasure (Node3 v _ _ _) = v

measureFT :: Monoid v => FingerTree v (Node v b) -> v
measureFT f = case f of
  Empty -> mempty
  Single x -> myMeasure x
  Deep v _ _ _ -> v

measureDigit :: Monoid v => Digit (Node v b) -> v
measureDigit (One a) = myMeasure a
measureDigit (Two a b) = myMeasure a `mappend` myMeasure b
measureDigit (Three a b c) = myMeasure a `mappend` myMeasure b `mappend` myMeasure c
measureDigit (Four a b c d) = myMeasure a `mappend` myMeasure b `mappend` myMeasure c `mappend` myMeasure d

deep ::  Monoid v => Digit (Node v b) -> FingerTree v (Node v (Node v b)) -> Digit (Node v b) -> FingerTree v (Node v b)
deep pr m sf = Deep ((measureDigit pr `mappendVal` m) `mappend` measureDigit sf) pr m sf

empty :: FingerTree v b
empty =  Empty
  
mappendVal :: Monoid v => v -> FingerTree v (Node v b) -> v
mappendVal v t = v `seq` case  t of
    Empty -> v
    _ -> v `mappend` measureFT t
{-# INLINE mappendVal #-}

digitToTree :: Monoid v => Digit (Node v b) -> FingerTree v (Node v b)
digitToTree (One a) = Single a
digitToTree (Two a b) = deep (One a) empty (One b)
digitToTree (Three a b c) = deep (Two a b) empty (One c)
digitToTree (Four a b c d) = deep (Two a b) empty (Two c d)

------------------------------------------------------------------------------------------
--                                         Splitting                                    --
------------------------------------------------------------------------------------------
-- | /O(log(min(i,n-i)))/. Split a sequence at a point where the predicate
-- on the accumulated measure changes from 'False' to 'True'.
split :: forall v c. Monoid v => (v -> Bool) -> FingerTree v (Node v c) -> (FingerTree v (Node v c), FingerTree v (Node v c))
split p t = case splitTree mempty t of (# l, x, r #) -> (l, undefined)
--      _ | otherwise -> (t, empty)
   where

  -- we manually CPR this call, because GHC apparently doesn't want to
  splitTree :: v -> FingerTree v (Node v b) -> Split (FingerTree v (Node v b)) (Node v b)
  splitTree i tree = case  tree of
      Empty -> error "splitTree of empty tree (possible violation of monoid invariant?)"
      Single x -> i `seq` (# empty, x, empty #)
      Deep _ pr m sf 
        | p vpr ->  case splitDigit i pr of
                       (# l, x, r #) -> (# (maybe empty digitToTree l), x, undefined #)
        | p vm ->  case splitTree vpr m of
                     (# ml, xs, mr #) -> case splitNode (vpr `mappend` measureFT ml) xs of
                       (# l, x, r #) -> (# undefined, x, undefined #)
                         where 
        | otherwise -> case splitDigit vm sf of
                          (# l, x, r #) -> (# undefined, x, (maybe empty digitToTree r) #)
       where 
         vpr =  i    `mappend`  measureDigit pr
         vm =  vpr  `mappend` measureFT m
 
  
  splitNode :: v -> Node v (Node v b) -> Split (Maybe (Digit (Node v b))) (Node v b)
  splitNode i node = error "splitNode"

  splitDigit :: v -> Digit (Node v b) -> Split (Maybe (Digit (Node v b))) (Node v b)
  splitDigit i (One a) = i `seq` (# Nothing, a, Nothing #)
  splitDigit i (Two a b)
    | p va	= (# Nothing, a, (Just (One b)) #)
    | otherwise	= (# (Just (One a)), b, Nothing #)
    where	va	= i `mappend` myMeasure a
  splitDigit i (Three a b c)
    | p va	= (# Nothing, a, (Just (Two b c)) #)
    | p vab	= (# (Just (One a)), b, (Just (One c)) #)
    | otherwise	= (# (Just (Two a b)), c, Nothing #)
    where va	= i `mappend` myMeasure a
          vab	= va `mappend` myMeasure b
  splitDigit i (Four a b c d)
    | p va	= (# Nothing, a, (Just (Three b c d)) #)
    | p vab	= (# (Just (One a)), b, (Just (Two c d)) #)
    | p vabc	= (# (Just (Two a b)), c, (Just (One d)) #)
    | otherwise	= (# (Just (Three a b c)), d, Nothing #)
    where va	= i `mappend` myMeasure a
          vab	= va `mappend` myMeasure b
          vabc	= vab `mappend` myMeasure c


------------------------------------------------------------------------------------------

newtype Seq a = Seq (FingerTree Size (Node Size a))

instance Monoid Size where
    {-# INLINE mappend #-}
    mappend (Size a) (Size b) = Size (a + b)
    {-# INLINE mempty #-}
    mempty = Size 0

mySplit :: Int -> Seq a -> (Seq a, Seq a)
mySplit n (Seq a) = n `seq` case split (\(Size s) -> s>n) a of (l, r) -> (Seq l, Seq r)