module Data.GiST.GiST
    (  
        
        GiST
        ,Entry(..)
        ,Predicates(..)
        ,LeafEntry,NodeEntry,Penalty
        ,entryPredicate
        
        ,search, insert, delete, empty, save, load, getData, size
    ) where
import Data.GiST.Types
import qualified Data.Text.IO as TIO
import qualified Data.Text as T
   
search  :: Predicates p a => p a -> GiST p a -> [a] 
search  p (Leaf es)     = [fst e | e <- es, consistent p (LeafEntry e)] 
search  _ (Node [])     = []
search  p (Node (e:es))
    |consistent p (NodeEntry e) = (search p (fst e)) ++ (search p (Node es))
    |otherwise                  = search p (Node es)
  
insert  :: Predicates p a => LeafEntry p a -> (Int, Int) -> GiST p a -> GiST p a 
insert (toIns, pred) (min,max) (Node es)
        |search pred (Node es) /= [] = Node es
        |length newEs <= max   =  Node newEs
        |otherwise              = Node [(Node $ map unNodeEntry es1, union $ map entryPredicate es1)
                                    ,(Node $ map unNodeEntry es2, union $ map entryPredicate es2)] 
            
    where   newEs = case insertSubtree of
                        Right newSub -> [if (e == minSubtree)
                                            then newSub
                                            else e
                                        |e <- es]
                        Left split -> (filter (/=minSubtree) es)++[fst split,snd split] 
            
            minSubtree = chooseSubtree es (toIns,pred)
            
            insertSubtree = insertAndSplit minSubtree (min,max) (toIns,pred)
            
            (es1,es2) =  pickSplit $ map NodeEntry newEs
         
insert (toIns, p) (min,max) (Leaf es)
        |search p (Leaf es) /= [] = Leaf es
        |length newEs <= max    = Leaf newEs
        |otherwise              = Node [(Leaf $ map unLeafEntry es1,union $ map entryPredicate es1)
                                    ,(Leaf $ map unLeafEntry es2, union $ map entryPredicate es2)] 
            
    where   newEs = (toIns, p):es
            
            (es1,es2) =  pickSplit $ map LeafEntry newEs 
delete  :: Predicates p a => LeafEntry p a -> (Int, Int) -> GiST p a -> GiST p a 
delete (toDel, p) (min,max) (Node es) 
        |length newEs == 1  = insertMultiple toAdd (makeRoot $ head newEs) (min,max) 
        |otherwise          = insertMultiple toAdd (Node newEs) (min, max)
            
    where   newEs = filter (not.isNull) (map fst delNodes)  
            
            toAdd = concat (map snd delNodes)
            
            delNodes =  [if (consistent p (NodeEntry e)) 
                            then (deleteAndCondense e (min,max) (toDel,p))
                            else (e,[])
                        |e <- es]
                        
delete (toDel, p) (min,max) (Leaf es) = Leaf [e | e <- es, not $ consistent p (LeafEntry e)]
    
empty :: GiST p a 
empty = Leaf []
load :: (Read a, Read (p a)) => FilePath -> IO (GiST p a) 
load f = do s <- TIO.readFile f
            return (read $ T.unpack s)
save :: (Show a, Show (p a)) => GiST p a -> FilePath -> IO ()
save gist f = TIO.writeFile f $ T.pack (show gist)
insertAndSplit :: (Predicates p a) => NodeEntry p a -> (Int,Int) -> LeafEntry p a -> Either (NodeEntry p a, NodeEntry p a) (NodeEntry p a)
insertAndSplit (Node es,p) (min,max) (toIns,pred)
            |length newEs <= max  =  Right (Node newEs,union $ map snd newEs)
            |otherwise = Left ((Node  (map unNodeEntry es1), union $ map entryPredicate es1)
                        ,(Node (map unNodeEntry es2), union $ map entryPredicate es2)) 
                
        where   newEs = case insertSubtree of
                            Right newSub -> [if (e == minSubtree)
                                                then newSub
                                                else e
                                            |e <- es]
                            Left split -> (filter (/=minSubtree) es)++[fst split,snd split] 
                
                minSubtree = chooseSubtree es (toIns,pred)
                
                insertSubtree = insertAndSplit minSubtree (min,max) (toIns,pred)
                
                (es1,es2) =  pickSplit $ map NodeEntry newEs
insertAndSplit (Leaf es,p) (min,max) (toIns,pred)
            |length newEs <= max  = Right (Leaf newEs,union $ map snd newEs)
            |otherwise = Left ((Leaf (map unLeafEntry es1), union $ map entryPredicate es1)
                        ,(Leaf (map unLeafEntry es2), union $ map entryPredicate es2)) 
            
    where   newEs = ((toIns,pred) : es)
            
            (es1,es2) =  pickSplit $ map LeafEntry newEs 
deleteAndCondense :: (Predicates p a) => NodeEntry p a -> (Int,Int) -> LeafEntry p a -> (NodeEntry p a, [LeafEntry p a])
deleteAndCondense (Node es, pred) (min, max) (toDel, p)
        |length newEs < min = ((Null, pred), toAdd ++ getEntries (Node es))   
        |otherwise          = ((Node newEs, union $ map snd newEs), toAdd)
            
    where   newEs = filter (not.isNull) (map fst delNodes)  
            
            toAdd = concat (map snd delNodes) 
            
            delNodes =  [if (consistent p (NodeEntry e)) 
                            then (deleteAndCondense e (min,max) (toDel,p))
                            else (e,[])
                        |e <- es]
deleteAndCondense ((Leaf es),pred) (min, max) (toDel, p) 
    |length newEs < min = ((Null,pred), newEs)
    |otherwise          = ((Leaf newEs, union $ map snd newEs),[])        
                
        where   newEs = [e | e <- es, not $ consistent p (LeafEntry e)] 
insertMultiple :: (Predicates p a) => [LeafEntry p a] -> GiST p a -> (Int,Int) -> GiST p a
insertMultiple [] gist _ = gist
insertMultiple (e:es) gist (min,max) = insertMultiple es afterInsert (min,max)
    where afterInsert = insert e (min,max) gist
chooseSubtree   :: (Predicates p a )=>[(NodeEntry p a)] -> LeafEntry p a -> (NodeEntry p a) 
chooseSubtree subtrees e    = minPenalty penalties (head penalties)
        where   penalties = [(ne, penalty (snd e) (snd ne))|ne <- subtrees]
minPenalty :: [(NodeEntry p a, Penalty)]->(NodeEntry p a, Penalty) -> NodeEntry p a
minPenalty [] p = fst p 
minPenalty ((ne, pen):ps) (nemin, minpen) 
    |pen < minpen   = minPenalty ps (ne, pen) 
    |otherwise      = minPenalty ps (nemin, minpen) 
makeRoot :: NodeEntry p a -> GiST p a
makeRoot (Node es, p) = Node es
makeRoot (Leaf es, p) = Leaf es
isNull :: NodeEntry p a -> Bool
isNull (Null, p) = True
isNull _ = False
getEntries :: GiST p a -> [LeafEntry p a]
getEntries (Node es) = concat [getEntries sub | (sub,_) <- es]
getEntries (Leaf es) = es
getData :: GiST p a -> [a]
getData gist = map fst $ getEntries gist
size :: GiST p a -> Int
size gist = length $ getEntries gist