{-# LANGUAGE DeriveGeneric         #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE InstanceSigs          #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TypeFamilies          #-}

module HaskellWorks.Data.Json.Standard.Cursor.Generic
  ( GenericCursor(..)
  , jsonCursorPos
  ) where

import GHC.Generics
import HaskellWorks.Data.Positioning
import HaskellWorks.Data.RankSelect.Base.Rank0
import HaskellWorks.Data.RankSelect.Base.Rank1
import HaskellWorks.Data.RankSelect.Base.Select1
import HaskellWorks.Data.TreeCursor
import Prelude                                   hiding (drop)

import qualified HaskellWorks.Data.BalancedParens as BP

data GenericCursor t v w = GenericCursor
  { GenericCursor t v w -> t
cursorText     :: !t
  , GenericCursor t v w -> v
interests      :: !v
  , GenericCursor t v w -> w
balancedParens :: !w
  , GenericCursor t v w -> Count
cursorRank     :: !Count
  }
  deriving (GenericCursor t v w -> GenericCursor t v w -> Bool
(GenericCursor t v w -> GenericCursor t v w -> Bool)
-> (GenericCursor t v w -> GenericCursor t v w -> Bool)
-> Eq (GenericCursor t v w)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall t v w.
(Eq t, Eq v, Eq w) =>
GenericCursor t v w -> GenericCursor t v w -> Bool
/= :: GenericCursor t v w -> GenericCursor t v w -> Bool
$c/= :: forall t v w.
(Eq t, Eq v, Eq w) =>
GenericCursor t v w -> GenericCursor t v w -> Bool
== :: GenericCursor t v w -> GenericCursor t v w -> Bool
$c== :: forall t v w.
(Eq t, Eq v, Eq w) =>
GenericCursor t v w -> GenericCursor t v w -> Bool
Eq, (forall x. GenericCursor t v w -> Rep (GenericCursor t v w) x)
-> (forall x. Rep (GenericCursor t v w) x -> GenericCursor t v w)
-> Generic (GenericCursor t v w)
forall x. Rep (GenericCursor t v w) x -> GenericCursor t v w
forall x. GenericCursor t v w -> Rep (GenericCursor t v w) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall t v w x. Rep (GenericCursor t v w) x -> GenericCursor t v w
forall t v w x. GenericCursor t v w -> Rep (GenericCursor t v w) x
$cto :: forall t v w x. Rep (GenericCursor t v w) x -> GenericCursor t v w
$cfrom :: forall t v w x. GenericCursor t v w -> Rep (GenericCursor t v w) x
Generic, Int -> GenericCursor t v w -> ShowS
[GenericCursor t v w] -> ShowS
GenericCursor t v w -> String
(Int -> GenericCursor t v w -> ShowS)
-> (GenericCursor t v w -> String)
-> ([GenericCursor t v w] -> ShowS)
-> Show (GenericCursor t v w)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall t v w.
(Show t, Show v, Show w) =>
Int -> GenericCursor t v w -> ShowS
forall t v w.
(Show t, Show v, Show w) =>
[GenericCursor t v w] -> ShowS
forall t v w.
(Show t, Show v, Show w) =>
GenericCursor t v w -> String
showList :: [GenericCursor t v w] -> ShowS
$cshowList :: forall t v w.
(Show t, Show v, Show w) =>
[GenericCursor t v w] -> ShowS
show :: GenericCursor t v w -> String
$cshow :: forall t v w.
(Show t, Show v, Show w) =>
GenericCursor t v w -> String
showsPrec :: Int -> GenericCursor t v w -> ShowS
$cshowsPrec :: forall t v w.
(Show t, Show v, Show w) =>
Int -> GenericCursor t v w -> ShowS
Show)

instance (BP.BalancedParens u, Rank1 u, Rank0 u) => TreeCursor (GenericCursor t v u) where
  firstChild :: GenericCursor t v u -> Maybe (GenericCursor t v u)
  firstChild :: GenericCursor t v u -> Maybe (GenericCursor t v u)
firstChild GenericCursor t v u
k = let mq :: Maybe Count
mq = u -> Count -> Maybe Count
forall v. BalancedParens v => v -> Count -> Maybe Count
BP.firstChild (GenericCursor t v u -> u
forall t v w. GenericCursor t v w -> w
balancedParens GenericCursor t v u
k) (GenericCursor t v u -> Count
forall t v w. GenericCursor t v w -> Count
cursorRank GenericCursor t v u
k) in (\Count
q -> GenericCursor t v u
k { cursorRank :: Count
cursorRank = Count
q }) (Count -> GenericCursor t v u)
-> Maybe Count -> Maybe (GenericCursor t v u)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Count
mq

  nextSibling :: GenericCursor t v u -> Maybe (GenericCursor t v u)
  nextSibling :: GenericCursor t v u -> Maybe (GenericCursor t v u)
nextSibling GenericCursor t v u
k = (\Count
q -> GenericCursor t v u
k { cursorRank :: Count
cursorRank = Count
q }) (Count -> GenericCursor t v u)
-> Maybe Count -> Maybe (GenericCursor t v u)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> u -> Count -> Maybe Count
forall v. BalancedParens v => v -> Count -> Maybe Count
BP.nextSibling (GenericCursor t v u -> u
forall t v w. GenericCursor t v w -> w
balancedParens GenericCursor t v u
k) (GenericCursor t v u -> Count
forall t v w. GenericCursor t v w -> Count
cursorRank GenericCursor t v u
k)

  parent :: GenericCursor t v u -> Maybe (GenericCursor t v u)
  parent :: GenericCursor t v u -> Maybe (GenericCursor t v u)
parent GenericCursor t v u
k = let mq :: Maybe Count
mq = u -> Count -> Maybe Count
forall v. BalancedParens v => v -> Count -> Maybe Count
BP.parent (GenericCursor t v u -> u
forall t v w. GenericCursor t v w -> w
balancedParens GenericCursor t v u
k) (GenericCursor t v u -> Count
forall t v w. GenericCursor t v w -> Count
cursorRank GenericCursor t v u
k) in (\Count
q -> GenericCursor t v u
k { cursorRank :: Count
cursorRank = Count
q }) (Count -> GenericCursor t v u)
-> Maybe Count -> Maybe (GenericCursor t v u)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Count
mq

  depth :: GenericCursor t v u -> Maybe Count
  depth :: GenericCursor t v u -> Maybe Count
depth GenericCursor t v u
k = u -> Count -> Maybe Count
forall v.
(BalancedParens v, Rank0 v, Rank1 v) =>
v -> Count -> Maybe Count
BP.depth (GenericCursor t v u -> u
forall t v w. GenericCursor t v w -> w
balancedParens GenericCursor t v u
k) (GenericCursor t v u -> Count
forall t v w. GenericCursor t v w -> Count
cursorRank GenericCursor t v u
k)

  subtreeSize :: GenericCursor t v u -> Maybe Count
  subtreeSize :: GenericCursor t v u -> Maybe Count
subtreeSize GenericCursor t v u
k = u -> Count -> Maybe Count
forall v. BalancedParens v => v -> Count -> Maybe Count
BP.subtreeSize (GenericCursor t v u -> u
forall t v w. GenericCursor t v w -> w
balancedParens GenericCursor t v u
k) (GenericCursor t v u -> Count
forall t v w. GenericCursor t v w -> Count
cursorRank GenericCursor t v u
k)

jsonCursorPos :: (Rank1 w, Select1 v) => GenericCursor s v w -> Position
jsonCursorPos :: GenericCursor s v w -> Position
jsonCursorPos GenericCursor s v w
k = Count -> Position
forall a. ToPosition a => a -> Position
toPosition (v -> Count -> Count
forall v. Select1 v => v -> Count -> Count
select1 v
ik (w -> Count -> Count
forall v. Rank1 v => v -> Count -> Count
rank1 w
bpk (GenericCursor s v w -> Count
forall t v w. GenericCursor t v w -> Count
cursorRank GenericCursor s v w
k)) Count -> Count -> Count
forall a. Num a => a -> a -> a
- Count
1)
  where ik :: v
ik  = GenericCursor s v w -> v
forall t v w. GenericCursor t v w -> v
interests GenericCursor s v w
k
        bpk :: w
bpk = GenericCursor s v w -> w
forall t v w. GenericCursor t v w -> w
balancedParens GenericCursor s v w
k