{-# LANGUAGE TemplateHaskell, TypeFamilies #-}
module Data.SimpleIndex
   (
  -- * The Data Type to use
  Indexed

  -- ** Creation functions
  , create1
  , create2
  , create3
  , create4
  , create5
  , create6

  -- * Fill this type class to make your type indexable
  , SimpleIx(..)

  -- * Insert, Delete, Update and Read
  , ixInsert
  , ixDelete
  , ixUpdate
  , ixRead1
  , ixRead2
  , ixRead3
  , ixRead4
  , ixRead5
  , ixRead6
  )
where

import Prelude
import Data.Foldable
import qualified Data.Foldable as Fold
import Data.Sequence (Seq, (|>), (><))
import qualified Data.Sequence as Seq
import Data.HashMap.Lazy (HashMap)
import qualified Data.HashMap.Lazy as HM
import Data.SafeCopy
import Data.Hashable
-- import GHC.Generics


-- | define index insert, update and delete functions
_ixInsertIx f h pos u = HM.insert (f u) pos h
_ixInsertData u ux baseData constructor = 
    (pos, constructor newBase)
    where 
        -- baseData = base ux
        newBase = baseData |> u
        pos = Seq.length baseData
_ixIt f hix u ux (pos, c) = (pos, c (_ixInsertIx f hix pos u) f)
_getIx = snd
_ixInsertData1 u ux c bd hix1 f1 = 
    _ixIt f1 hix1 u ux $ 
    _ixInsertData u ux bd c
_ixInsertData2 u ux c b hix1 hix2 f1 f2 = 
    _ixIt f2 hix2 u ux $ _ixInsertData1 u ux c b hix1 f1
_ixInsertData3 u ux c b hix1 hix2 hix3 f1 f2 f3 = 
    _ixIt f3 hix3 u ux $ _ixInsertData2 u ux c b hix1 hix2 f1 f2
_ixInsertData4 u ux c b hix1 hix2 hix3 hix4 f1 f2 f3 f4 = 
    _ixIt f4 hix4 u ux $ _ixInsertData3 u ux c b hix1 hix2 hix3 f1 f2 f3
_ixInsertData5 u ux c b hix1 hix2 hix3 hix4 hix5 f1 f2 f3 f4 f5 = 
    _ixIt f5 hix5 u ux $ _ixInsertData4 u ux c b hix1 hix2 hix3 hix4 f1 f2 f3 f4
_ixInsertData6 u ux c b hix1 hix2 hix3 hix4 hix5 hix6 f1 f2 f3 f4 f5 f6= 
    _ixIt f6 hix6 u ux $ _ixInsertData5 u ux c b hix1 hix2 hix3 hix4 hix5 f1 f2 f3 f4 f5

_ixUpdateIx getIndex h pos old new =
    HM.insert (getIndex new) pos $ HM.delete (getIndex old) h

_ixUpdateData ux constructor base hix uid updateF = 
    fmap genTuple $ HM.lookup uid hix 
    where 
        old' pos = Seq.index base pos
        new' pos = updateF (old' pos)
        newBase pos = Seq.update pos (new' pos) base
        genTuple pos = (pos, old' pos, new' pos, constructor (newBase pos))

_ixUp f hix ux (pos, old, new, c) = 
    (pos, old, new, c (_ixUpdateIx f hix pos old new) f)
_getUp u t = case t of
                Nothing -> u
                Just (_,_,_,f) -> f
_ixUpdateData1 ux c b hix1 f1 uid f = 
    fmap (_ixUp f1 hix1 ux) (_ixUpdateData ux c b hix1 uid f)
_ixUpdateData2 ux c b hix1 hix2 f1 f2 uid f = 
    fmap (_ixUp f2 hix2 ux) (_ixUpdateData1 ux c b hix1 f1 uid f)
_ixUpdateData3 ux c b hix1 hix2 hix3 f1 f2 f3 uid f = 
    fmap (_ixUp f3 hix3 ux) (_ixUpdateData2 ux c b hix1 hix2 f1 f2 uid f)
_ixUpdateData4 ux c b hix1 hix2 hix3 hix4 f1 f2 f3 f4 uid f = 
    fmap (_ixUp f4 hix4 ux) (_ixUpdateData3 ux c b hix1 hix2 hix3 f1 f2 f3 uid f)
_ixUpdateData5 ux c b hix1 hix2 hix3 hix4 hix5 f1 f2 f3 f4 f5 uid f = 
    fmap (_ixUp f5 hix5 ux) (_ixUpdateData4 ux c b hix1 hix2 hix3 hix4 f1 f2 f3 f4 uid f)
_ixUpdateData6 ux c b hix1 hix2 hix3 hix4 hix5 hix6 f1 f2 f3 f4 f5 f6 uid f = 
    fmap (_ixUp f6 hix6 ux) (_ixUpdateData5 ux c b hix1 hix2 hix3 hix4 hix5 f1 f2 f3 f4 f5 uid f)

_ixDeleteIx getIndex h u = HM.delete (getIndex u) h
_ixDeleteData u ux constructor base = constructor newBase
    where
        newBase = _seqDelete u base

_seqDelete :: Eq a => a -> Seq a -> Seq a
_seqDelete item ss = left >< Seq.drop 1 right
    where (left, right) = Seq.breakl (== item) ss

_ixDeleteData1 ux c b hix1 f1 u = 
    (_ixDeleteData u ux c b) (_ixDeleteIx f1 hix1 u) f1
_ixDeleteData2 ux c b hix1 hix2 f1 f2 u = 
    (_ixDeleteData1 ux c b hix1 f1 u) (_ixDeleteIx f2 hix2 u) f2
_ixDeleteData3 ux c b hix1 hix2 hix3 f1 f2 f3 u = 
    (_ixDeleteData2 ux c b hix1 hix2 f1 f2 u) (_ixDeleteIx f3 hix3 u) f3
_ixDeleteData4 ux c b hix1 hix2 hix3 hix4 f1 f2 f3 f4 u = 
    (_ixDeleteData3 ux c b hix1 hix2 hix3 f1 f2 f3 u) (_ixDeleteIx f4 hix4 u) f4
_ixDeleteData5 ux c b hix1 hix2 hix3 hix4 hix5 f1 f2 f3 f4 f5 u = 
    (_ixDeleteData4 ux c b hix1 hix2 hix3 hix4 f1 f2 f3 f4 u) (_ixDeleteIx f5 hix5 u) f5
_ixDeleteData6 ux c b hix1 hix2 hix3 hix4 hix5 hix6 f1 f2 f3 f4 f5 f6 u = 
    (_ixDeleteData5 ux c b hix1 hix2 hix3 hix4 hix5 f1 f2 f3 f4 f5 u) (_ixDeleteIx f6 hix6 u) f6

data Indexed a i1 i2 i3 i4 i5 i6
    = -- forall i1. (Eq i1, Hashable i1) =>
      IxHas1 { has1Base :: Seq a 
             , has1Ix1 :: (HashMap i1 Int) 
             , has1Fetch1 :: (a -> i1)
             }
    | IxHas2 { has2Base :: Seq a
             , has2Ix1 :: (HashMap i1 Int)
             , has2Fetch1 :: (a -> i1)
             , has2Ix2 :: (HashMap i2 Int)
             , has2Fetch2 :: (a -> i2)
             }
    | IxHas3 { has3Base :: Seq a
             , has3Ix1 :: (HashMap i1 Int)
             , has3Fetch1 :: (a -> i1)
             , has3Ix2 :: (HashMap i2 Int)
             , has3Fetch2 :: (a -> i2)
             , has3Ix3 :: (HashMap i3 Int)
             , has3Fetch3 :: (a -> i3)
             }
    | IxHas4 { has4Base :: Seq a
             , has4Ix1 :: (HashMap i1 Int)
             , has4Fetch1 :: (a -> i1)
             , has4Ix2 :: (HashMap i2 Int)
             , has4Fetch2 :: (a -> i2)
             , has4Ix3 :: (HashMap i3 Int)
             , has4Fetch3 :: (a -> i3)
             , has4Ix4 :: (HashMap i4 Int)
             , has4Fetch4 :: (a -> i4)
             }
    | IxHas5 { has5Base :: Seq a
             , has5Ix1 :: (HashMap i1 Int)
             , has5Fetch1 :: (a -> i1)
             , has5Ix2 :: (HashMap i2 Int)
             , has5Fetch2 :: (a -> i2)
             , has5Ix3 :: (HashMap i3 Int)
             , has5Fetch3 :: (a -> i3)
             , has5Ix4 :: (HashMap i4 Int)
             , has5Fetch4 :: (a -> i4)
             , has5Ix5 :: (HashMap i5 Int)
             , has5Fetch5 :: (a -> i5)
             }
    | IxHas6 { has6Base :: Seq a
             , has6Ix1 :: (HashMap i1 Int)
             , has6Fetch1 :: (a -> i1)
             , has6Ix2 :: (HashMap i2 Int)
             , has6Fetch2 :: (a -> i2)
             , has6Ix3 :: (HashMap i3 Int)
             , has6Fetch3 :: (a -> i3)
             , has6Ix4 :: (HashMap i4 Int)
             , has6Fetch4 :: (a -> i4)
             , has6Ix5 :: (HashMap i5 Int)
             , has6Fetch5 :: (a -> i5)
             , has6Ix6 :: (HashMap i6 Int)
             , has6Fetch6 :: (a -> i6)
             }

-- | Use this function to create an Indexed data type with only 1 index for your type
create1 :: (Eq a, Eq i1, Hashable i1) 
        => (a -> i1) 
        -- ^ The function that returns the index for the base datatype
        -> Indexed a i1 () () () () ()
create1 f = IxHas1 Seq.empty HM.empty f
-- | Create an Indexed data type with 2 indexes for your type
-- create2 :: forall a i1 i2 i3 i4 i5 i6. (Eq i1, Eq i2, Eq i3, Eq i4, Eq i5, Eq i6, Hashable i1,
--          Hashable i2, Hashable i3, Hashable i4, Hashable i5, Hashable i6, SafeCopy a) 
--        => (a -> i1) 
--        -- ^ The function that returns the first index for your datatype
--        -> (a -> i2) 
--        -- ^ The function that returns the second index for your datatype
--        -> Indexed a i1 i2 i3 i4 i5 i6
create2 f1 f2 = IxHas2 Seq.empty HM.empty f1 HM.empty f2

-- | Create an Indexed data type with 3 indexes for your type
create3 :: (a -> i1) 
        -- ^ The function that returns the first index for your datatype
        -> (a -> i2) 
        -- ^ The function that returns the second index for your datatype
        -> (a -> i3)
        -- ^ The function that returns the third index for your datatype
        -> Indexed a i1 i2 i3 () () ()
create3 f1 f2 f3 = IxHas3 Seq.empty HM.empty f1 HM.empty f2 HM.empty f3

-- | Create an Indexed data type with 4 indexes for your type
create4 :: (a -> i1) 
        -- ^ The function that returns the first index for your datatype
        -> (a -> i2) 
        -- ^ The function that returns the second index for your datatype
        -> (a -> i3) 
        -- ^ The function that returns the third index for your datatype
        -> (a -> i4) 
        -- ^ The function that returns the fourth index for your datatype
        -> Indexed a i1 i2 i3 i4 () ()
create4 f1 f2 f3 f4 = IxHas4 Seq.empty HM.empty f1 HM.empty f2 HM.empty f3 
                             HM.empty f4

-- | Create an Indexed data type with 5 indexes for your type
create5 :: (a -> i1) 
        -- ^ The function that returns the first index for your datatype
        -> (a -> i2) 
        -- ^ The function that returns the second index for your datatype
        -> (a -> i3) 
        -- ^ The function that returns the third index for your datatype
        -> (a -> i4) 
        -- ^ The function that returns the fourth index for your datatype
        -> (a -> i5) 
        -- ^ The function that returns the fifth index for your datatype
        -> Indexed a i1 i2 i3 i4 i5 ()
create5 f1 f2 f3 f4 f5 = IxHas5 Seq.empty HM.empty f1 HM.empty f2 HM.empty f3 
                                HM.empty f4 HM.empty f5

-- | Create an Indexed data type with 6 indexes for your type
create6 :: (a -> i1) 
        -- ^ The function that returns the first index for your datatype
        -> (a -> i2) 
        -- ^ The function that returns the second index for your datatype
        -> (a -> i3) 
        -- ^ The function that returns the third index for your datatype
        -> (a -> i4) 
        -- ^ The function that returns the fourth index for your datatype
        -> (a -> i5) 
        -- ^ The function that returns the fifth index for your datatype
        -> (a -> i6) 
        -- ^ The function that returns the sixth index for your datatype
        -> Indexed a i1 i2 i3 i4 i5 i6
create6 f1 f2 f3 f4 f5 f6 = IxHas6 Seq.empty HM.empty f1 HM.empty f2 
                            HM.empty f3 HM.empty f4 HM.empty f5 HM.empty f6

-- http://lpaste.net/91233
class SimpleIx a where
    -- | Creates your indexed dataype, you can use "create1" .. "create6" functions to help you here
    type I1 a
    type I2 a
    type I3 a
    type I4 a
    type I5 a
    type I6 a
    create :: Indexed a (I1 a) (I2 a) (I3 a) (I4 a) (I5 a) (I6 a)
               
-- | Inserts a new value into the Indexed data type and updates all the information
-- in the indexes
ixInsert :: 
    (Eq k4, Eq k3, Eq k2, Eq k1, Eq k, Eq i6, Hashable k4,
      Hashable k3, Hashable k2, Hashable k1, Hashable k, Hashable i6) =>
           Indexed a k4 k3 k2 k1 k i6 -> a -> Indexed a k4 k3 k2 k1 k i6
ixInsert ux u = _getIx $ 
    case ux of
        (IxHas1 b h1 f1) -> _ixInsertData1 u ux IxHas1 b h1 f1
        (IxHas2 b h1 f1 h2 f2) -> 
            _ixInsertData2 u ux IxHas2 b h1 h2 f1 f2
        (IxHas3 b h1 f1 h2 f2 h3 f3) -> 
            _ixInsertData3 u ux IxHas3 b h1 h2 h3 f1 f2 f3
        (IxHas4 b h1 f1 h2 f2 h3 f3 h4 f4) -> 
            _ixInsertData4 u ux IxHas4 b h1 h2 h3 h4 f1 f2 f3 f4
        (IxHas5 b h1 f1 h2 f2 h3 f3 h4 f4 h5 f5) -> 
            _ixInsertData5 u ux IxHas5 b h1 h2 h3 h4 h5 f1 f2 f3 f4 f5
        (IxHas6 b h1 f1 h2 f2 h3 f3 h4 f4 h5 f5 h6 f6) -> 
            _ixInsertData6 u ux IxHas6 b h1 h2 h3 h4 h5 h6 f1 f2 f3 f4 f5 f6

-- | Deletes a value from the Indexed data type and updates all the information
-- in the indexes
ixDelete :: (Eq a, Eq k, Eq i2, Eq i3, Eq i4, Eq i5, Eq i6, Hashable k,
      Hashable i2, Hashable i3, Hashable i4, Hashable i5, Hashable i6) =>
           Indexed a k i2 i3 i4 i5 i6 -> a -> Indexed a k i2 i3 i4 i5 i6
ixDelete ux u = 
    case ux of
        (IxHas1 b h1 f1) -> _ixDeleteData1 ux IxHas1 b h1 f1 u
        (IxHas2 b h1 f1 h2 f2) -> 
            _ixDeleteData2 ux IxHas2 b h1 h2 f1 f2 u
        (IxHas3 b h1 f1 h2 f2 h3 f3) -> 
            _ixDeleteData3 ux IxHas3 b h1 h2 h3 f1 f2 f3 u
        (IxHas4 b h1 f1 h2 f2 h3 f3 h4 f4) -> 
            _ixDeleteData4 ux IxHas4 b h1 h2 h3 h4 f1 f2 f3 f4 u
        (IxHas5 b h1 f1 h2 f2 h3 f3 h4 f4 h5 f5) -> 
            _ixDeleteData5 ux IxHas5 b h1 h2 h3 h4 h5 f1 f2 f3 f4 f5 u
        (IxHas6 b h1 f1 h2 f2 h3 f3 h4 f4 h5 f5 h6 f6) -> 
            _ixDeleteData6 ux IxHas6 b h1 h2 h3 h4 h5 h6 f1 f2 f3 f4 f5 f6 u


-- | Updates a value in the Indexed data type and all the information
-- in the indexes
ixUpdate :: (Eq k, Eq i2, Eq i3, Eq i4, Eq i5, Eq i6, Hashable k,
      Hashable i2, Hashable i3, Hashable i4, Hashable i5, Hashable i6) =>
           Indexed a k i2 i3 i4 i5 i6
                -> k -> (a -> a) -> Maybe (Int, a, a, Indexed a k i2 i3 i4 i5 i6)
ixUpdate ux uid f = 
    case ux of
        (IxHas1 b h1 f1) -> _ixUpdateData1 ux IxHas1 b h1 f1 uid f
        (IxHas2 b h1 f1 h2 f2) -> 
            _ixUpdateData2 ux IxHas2 b h1 h2 f1 f2 uid f
        (IxHas3 b h1 f1 h2 f2 h3 f3) -> 
            _ixUpdateData3 ux IxHas3 b h1 h2 h3 f1 f2 f3 uid f
        (IxHas4 b h1 f1 h2 f2 h3 f3 h4 f4) -> 
            _ixUpdateData4 ux IxHas4 b h1 h2 h3 h4 f1 f2 f3 f4 uid f
        (IxHas5 b h1 f1 h2 f2 h3 f3 h4 f4 h5 f5) -> 
            _ixUpdateData5 ux IxHas5 b h1 h2 h3 h4 h5 f1 f2 f3 f4 f5 uid f
        (IxHas6 b h1 f1 h2 f2 h3 f3 h4 f4 h5 f5 h6 f6) -> 
            _ixUpdateData6 ux IxHas6 b h1 h2 h3 h4 h5 h6 f1 f2 f3 f4 f5 f6 uid f

_read :: (Eq k, Hashable k) 
      => (Indexed b t1 t2 t3 t4 t5 t6 -> Maybe (HashMap k Int))
      -> k -> Indexed b t1 t2 t3 t4 t5 t6 -> Maybe b
_read f b ux = do
    ixHashMap <- f ux
    index     <- HM.lookup b ixHashMap
    return $ Seq.index (_ixData ux) index

-- | Reads your datatype from the Indexed data by looking up a first index value
ixRead1 :: (Eq b, Hashable b) => b -> Indexed a b t2 t3 t4 t5 t6 -> Maybe a
ixRead1 = _read _getIx1
-- | Reads your datatype from the Indexed data by looking up a value on the second index
ixRead2 :: (Eq b, Hashable b) => b -> Indexed a t1 b t3 t4 t5 t6 -> Maybe a
ixRead2 = _read _getIx2
-- | Reads your datatype from the Indexed data by looking up a value on the third index
ixRead3 :: (Eq b, Hashable b) => b -> Indexed a t1 t2 b t4 t5 t6 -> Maybe a
ixRead3 = _read _getIx3
-- | Reads your datatype from the Indexed data by looking up a value on the fourth index
ixRead4 :: (Eq b, Hashable b) => b -> Indexed a t1 t2 t3 b t5 t6 -> Maybe a
ixRead4 = _read _getIx4
-- | Reads your datatype from the Indexed data by looking up a value on the fifth index
ixRead5 :: (Eq b, Hashable b) => b -> Indexed a t1 t2 t3 t4 b t6 -> Maybe a
ixRead5 = _read _getIx5
-- | Reads your datatype from the Indexed data by looking up a value on the sixth index
ixRead6 :: (Eq b, Hashable b) => b -> Indexed a t1 t2 t3 t4 t5 b -> Maybe a
ixRead6 = _read _getIx6

_ixData :: Indexed a t1 t2 t3 t4 t5 t6 -> Seq a
_ixData ux = 
    case ux of
        (IxHas1 b _ _) -> b
        (IxHas2 b _ _ _ _) -> b
        (IxHas3 b _ _ _ _ _ _) -> b
        (IxHas4 b _ _ _ _ _ _ _ _) -> b
        (IxHas5 b _ _ _ _ _ _ _ _ _ _) -> b
        (IxHas6 b _ _ _ _ _ _ _ _ _ _ _ _) -> b

_getIx1 :: Indexed a b t2 t3 t4 t5 t6 -> Maybe (HashMap b Int)
_getIx1 ux = 
    case ux of
        (IxHas1 _ i _) -> Just i
        (IxHas2 _ i _ _ _) -> Just i
        (IxHas3 _ i _ _ _ _ _) -> Just i
        (IxHas4 _ i _ _ _ _ _ _ _) -> Just i
        (IxHas5 _ i _ _ _ _ _ _ _ _ _) -> Just i
        (IxHas6 _ i _ _ _ _ _ _ _ _ _ _ _) -> Just i
_getIx2 :: Indexed a t1 b t3 t4 t5 t6 -> Maybe (HashMap b Int)
_getIx2 ux = 
    case ux of
        (IxHas2 _ _ _ i _) -> Just i
        (IxHas3 _ _ _ i _ _ _) -> Just i
        (IxHas4 _ _ _ i _ _ _ _ _) -> Just i
        (IxHas5 _ _ _ i _ _ _ _ _ _ _) -> Just i
        (IxHas6 _ _ _ i _ _ _ _ _ _ _ _ _) -> Just i
        _ -> Nothing
_getIx3 :: Indexed a t1 t2 b t4 t5 t6 -> Maybe (HashMap b Int)
_getIx3 ux = 
    case ux of
        (IxHas3 _ _ _ _ _ i _) -> Just i
        (IxHas4 _ _ _ _ _ i _ _ _) -> Just i
        (IxHas5 _ _ _ _ _ i _ _ _ _ _) -> Just i
        (IxHas6 _ _ _ _ _ i _ _ _ _ _ _ _) -> Just i
        _ -> Nothing
_getIx4 :: Indexed a t1 t2 t3 b t5 t6 -> Maybe (HashMap b Int)
_getIx4 ux = 
    case ux of
        (IxHas4 _ _ _ _ _ _ _ i _) -> Just i
        (IxHas5 _ _ _ _ _ _ _ i _ _ _) -> Just i
        (IxHas6 _ _ _ _ _ _ _ i _ _ _ _ _) -> Just i
        _ -> Nothing
_getIx5 :: Indexed a t1 t2 t3 t4 b t6 -> Maybe (HashMap b Int)
_getIx5 ux = 
    case ux of
        (IxHas5 _ _ _ _ _ _ _ _ _ i _) -> Just i
        (IxHas6 _ _ _ _ _ _ _ _ _ i _ _ _) -> Just i
        _ -> Nothing
_getIx6 :: Indexed a t1 t2 t3 t4 t5 b -> Maybe (HashMap b Int)
_getIx6 ux = 
    case ux of
        (IxHas6 _ _ _ _ _ _ _ _ _ _ _ i _) -> Just i
        _ -> Nothing

instance (Eq a, Eq t1, Eq t2, Eq t3, Eq t4, Eq t5, Eq t6, Hashable t1,
          Hashable t2, Hashable t3, Hashable t4, Hashable t5, Hashable t6,
          t1 ~ I1 a, t2 ~ I2 a, t3 ~ I3 a, t4 ~ I4 a, t5 ~ I5 a, t6 ~ I6 a,
          SafeCopy a, SimpleIx a) => SafeCopy (Indexed a t1 t2 t3 t4 t5 t6) where
    version = 0
    putCopy ux = contain $ safePut $ _ixData ux
    getCopy = contain $ fmap withData safeGet
        where
            withData :: 
                (Eq a, Eq t1, Eq t2, Eq t3, Eq t4, Eq t5, Eq t6, Hashable t1,
                 Hashable t2, Hashable t3, Hashable t4, Hashable t5, Hashable t6,
                 t1 ~ I1 a, t2 ~ I2 a, t3 ~ I3 a, t4 ~ I4 a, t5 ~ I5 a, t6 ~ I6 a,
                 SafeCopy a, SimpleIx a) => Seq a -> Indexed a t1 t2 t3 t4 t5 t6
            withData seq = Fold.foldl ixInsert create seq