{-# OPTIONS -XTemplateHaskell -XMultiParamTypeClasses -XTypeOperators #-}
import UpdatableViewStub 
import Control.Arrow
import RIC

{-# LINE 6 "../examples/sized_tree.hs" #-}
data List a = Nil | Cons a (List a) deriving (Show,Eq) 

{-# LINE 15 "../examples/sized_tree.hs" #-}
data STree a = SEmp | SLeaf a | STree Int (STree a) (STree a) deriving (Show,Eq) 

instance UpdatableView (STree a ) (List a ) where 
{-# LINE 35 "../examples/sized_tree.hs" #-}
    view = $(foldT ''STree) ( nilB <||> wrapB <||> (ignoreFstB (getSize') >>>> appendB) ) >>>> foldListB (nilB' <||> consB')
           -- >>>> totalB myenrich myunenrich
           {- Clearly this fuunction is not written in RINV. 
              I failed to find how to write the function satisfying the joinly-surjective condition. -}
        where 
          nilB   = $(toC '[])
          wrapB  = introUnitRB >>>> (idB <**> nilB) >>>> $(toC '(:))
          nilB'  = $(toC 'Nil)
          consB' = $(toC 'Cons)
          getSize' (x,y) = length x + length y 





index :: Int -> List a -> a 
index = 
  let
    index 1 (SLeaf a) = a 
    index n (STree s lt rt) | n > ls    = index (n - ls) rt 
                            | otherwise = index n lt 
        where 
          ls = getSize lt 
          getSize (STree s _ _) = s
          getSize (SLeaf _)     = 1 
  in (toView :: (Int -> STree a -> a) ->  (Int -> List a -> a )) index
enrich :: [a] -> List a 
enrich = 
  let
    enrich x = f (length x) x 
       where 
         f 1 [x] = SLeaf x 
         f n x = let (a,b) = splitAt ls x 
                 in  STree n (f ls a) (f rs b)
             where ls = n `div` 2 
                   rs = n - ls 
  in (toView :: ([a] -> STree a) ->  ([a] -> List a )) enrich
{-# LINE 49 "../examples/sized_tree.hs" #-}
answerQueries is x = 
    let v = enrich x 
    in map (\i -> index i v) is