cursor-0.3.1.0: src/Cursor/Map.hs

{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeFamilies #-}

module Cursor.Map
  ( MapCursor (..),
    makeMapCursor,
    makeMapCursorWithSelection,
    singletonMapCursorKey,
    singletonMapCursorValue,
    rebuildMapCursor,
    mapMapCursor,
    mapCursorNonEmptyCursorL,
    mapCursorElemL,
    mapCursorElemSelection,
    mapCursorSelectKey,
    mapCursorSelectValue,
    mapCursorToggleSelected,
    mapCursorSelectPrev,
    mapCursorSelectNext,
    mapCursorSelectFirst,
    mapCursorSelectLast,
    mapCursorSelection,
    mapCursorSelectIndex,
    mapCursorInsert,
    mapCursorAppend,
    mapCursorInsertAndSelectKey,
    mapCursorAppendAndSelectKey,
    mapCursorInsertAndSelectValue,
    mapCursorAppendAndSelectValue,
    mapCursorRemoveElemAndSelectPrev,
    mapCursorDeleteElemAndSelectNext,
    mapCursorRemoveElem,
    mapCursorDeleteElem,
    mapCursorSearch,
    mapCursorSelectOrAdd,
    traverseMapCursor,
    mapCursorTraverseKeyCase,
    mapCursorTraverseValueCase,
    foldMapCursor,
    module Cursor.Map.KeyValue,
  )
where

import Control.DeepSeq
import Cursor.List.NonEmpty
import Cursor.Map.KeyValue
import Cursor.Types
import Data.List.NonEmpty (NonEmpty (..))
import Data.Maybe
import Data.Validity
import Data.Validity.Tree ()
import GHC.Generics (Generic)
import Lens.Micro

newtype MapCursor kc vc k v = MapCursor
  { mapCursorList :: NonEmptyCursor (KeyValueCursor kc vc k v) (k, v)
  }
  deriving (Show, Eq, Generic)

instance (Validity kc, Validity vc, Validity k, Validity v) => Validity (MapCursor kc vc k v)

instance (NFData kc, NFData vc, NFData k, NFData v) => NFData (MapCursor kc vc k v)

makeMapCursor :: (k -> kc) -> NonEmpty (k, v) -> MapCursor kc vc k v
makeMapCursor h = fromJust . makeMapCursorWithSelection h 0

makeMapCursorWithSelection :: (k -> kc) -> Int -> NonEmpty (k, v) -> Maybe (MapCursor kc vc k v)
makeMapCursorWithSelection h i ne =
  MapCursor <$> makeNonEmptyCursorWithSelection (\(k, v) -> makeKeyValueCursorKey (h k) v) i ne

singletonMapCursorKey :: kc -> v -> MapCursor kc vc k v
singletonMapCursorKey kc v =
  MapCursor {mapCursorList = singletonNonEmptyCursor $ makeKeyValueCursorKey kc v}

singletonMapCursorValue :: k -> vc -> MapCursor kc vc k v
singletonMapCursorValue k vc =
  MapCursor {mapCursorList = singletonNonEmptyCursor $ makeKeyValueCursorValue k vc}

rebuildMapCursor :: (kc -> k) -> (vc -> v) -> MapCursor kc vc k v -> NonEmpty (k, v)
rebuildMapCursor f g = rebuildNonEmptyCursor (rebuildKeyValueCursor f g) . mapCursorList

mapMapCursor ::
  (kc -> lc) -> (vc -> wc) -> (k -> l) -> (v -> w) -> MapCursor kc vc k v -> MapCursor lc wc l w
mapMapCursor a b c d =
  mapCursorNonEmptyCursorL %~ mapNonEmptyCursor (mapKeyValueCursor a b c d) (\(k, v) -> (c k, d v))

mapCursorNonEmptyCursorL ::
  Lens
    (MapCursor kc vc k v)
    (MapCursor lc wc l w)
    ( NonEmptyCursor
        (KeyValueCursor kc vc k v)
        ( k,
          v
        )
    )
    ( NonEmptyCursor
        (KeyValueCursor lc wc l w)
        ( l,
          w
        )
    )
mapCursorNonEmptyCursorL = lens mapCursorList $ \mc ne -> mc {mapCursorList = ne}

mapCursorElemL ::
  Lens (MapCursor kc vc k v) (MapCursor kc' vc' k v) (KeyValueCursor kc vc k v) (KeyValueCursor kc' vc' k v)
mapCursorElemL = mapCursorNonEmptyCursorL . nonEmptyCursorElemL

mapCursorElemSelection :: MapCursor kc vc k v -> KeyValueToggle
mapCursorElemSelection mc = keyValueCursorSelection $ mc ^. mapCursorElemL

mapCursorSelectKey :: (k -> kc) -> (vc -> v) -> MapCursor kc vc k v -> MapCursor kc vc k v
mapCursorSelectKey g h = mapCursorElemL %~ keyValueCursorSelectKey g h

mapCursorSelectValue :: (kc -> k) -> (v -> vc) -> MapCursor kc vc k v -> MapCursor kc vc k v
mapCursorSelectValue f i = mapCursorElemL %~ keyValueCursorSelectValue f i

mapCursorToggleSelected ::
  (kc -> k) -> (k -> kc) -> (vc -> v) -> (v -> vc) -> MapCursor kc vc k v -> MapCursor kc vc k v
mapCursorToggleSelected f g h i = mapCursorElemL %~ keyValueCursorToggleSelected f g h i

mapCursorSelectPrev ::
  (kc -> k) -> (k -> kc) -> (vc -> v) -> MapCursor kc vc k v -> Maybe (MapCursor kc vc k v)
mapCursorSelectPrev f g h =
  mapCursorNonEmptyCursorL $ nonEmptyCursorSelectPrev (rebuild f h) (make g)

mapCursorSelectNext ::
  (kc -> k) -> (k -> kc) -> (vc -> v) -> MapCursor kc vc k v -> Maybe (MapCursor kc vc k v)
mapCursorSelectNext f g h =
  mapCursorNonEmptyCursorL $ nonEmptyCursorSelectNext (rebuild f h) (make g)

mapCursorSelectFirst ::
  (kc -> k) -> (k -> kc) -> (vc -> v) -> MapCursor kc vc k v -> MapCursor kc vc k v
mapCursorSelectFirst f g h =
  mapCursorNonEmptyCursorL %~ nonEmptyCursorSelectFirst (rebuild f h) (make g)

mapCursorSelectLast ::
  (kc -> k) -> (k -> kc) -> (vc -> v) -> MapCursor kc vc k v -> MapCursor kc vc k v
mapCursorSelectLast f g h =
  mapCursorNonEmptyCursorL %~ nonEmptyCursorSelectLast (rebuild f h) (make g)

mapCursorSelection :: MapCursor kc vc k v -> Int
mapCursorSelection = nonEmptyCursorSelection . mapCursorList

mapCursorSelectIndex ::
  (kc -> k) ->
  (k -> kc) ->
  (vc -> v) ->
  Int ->
  MapCursor kc vc k v ->
  Maybe (MapCursor kc vc k v)
mapCursorSelectIndex f g h i =
  mapCursorNonEmptyCursorL (nonEmptyCursorSelectIndex (rebuild f h) (make g) i)

mapCursorInsert :: k -> v -> MapCursor kc vc k v -> MapCursor kc vc k v
mapCursorInsert k v = mapCursorNonEmptyCursorL %~ nonEmptyCursorInsert (k, v)

mapCursorAppend :: k -> v -> MapCursor kc vc k v -> MapCursor kc vc k v
mapCursorAppend k v = mapCursorNonEmptyCursorL %~ nonEmptyCursorAppend (k, v)

mapCursorInsertAndSelectKey ::
  (kc -> k) -> (vc -> v) -> kc -> v -> MapCursor kc vc k v -> MapCursor kc vc k v
mapCursorInsertAndSelectKey f h kc v =
  mapCursorNonEmptyCursorL
    %~ nonEmptyCursorInsertAndSelect (rebuild f h) (makeKeyValueCursorKey kc v)

mapCursorAppendAndSelectKey ::
  (kc -> k) -> (vc -> v) -> kc -> v -> MapCursor kc vc k v -> MapCursor kc vc k v
mapCursorAppendAndSelectKey f h kc v =
  mapCursorNonEmptyCursorL
    %~ nonEmptyCursorAppendAndSelect (rebuild f h) (makeKeyValueCursorKey kc v)

mapCursorInsertAndSelectValue ::
  (kc -> k) -> (vc -> v) -> k -> vc -> MapCursor kc vc k v -> MapCursor kc vc k v
mapCursorInsertAndSelectValue f h k vc =
  mapCursorNonEmptyCursorL
    %~ nonEmptyCursorInsertAndSelect (rebuild f h) (makeKeyValueCursorValue k vc)

mapCursorAppendAndSelectValue ::
  (kc -> k) -> (vc -> v) -> k -> vc -> MapCursor kc vc k v -> MapCursor kc vc k v
mapCursorAppendAndSelectValue f h k vc =
  mapCursorNonEmptyCursorL
    %~ nonEmptyCursorAppendAndSelect (rebuild f h) (makeKeyValueCursorValue k vc)

mapCursorRemoveElemAndSelectPrev ::
  (k -> kc) -> MapCursor kc vc k v -> Maybe (DeleteOrUpdate (MapCursor kc vc k v))
mapCursorRemoveElemAndSelectPrev g =
  focusPossibleDeleteOrUpdate mapCursorNonEmptyCursorL $
    nonEmptyCursorRemoveElemAndSelectPrev (make g)

mapCursorDeleteElemAndSelectNext ::
  (k -> kc) -> MapCursor kc vc k v -> Maybe (DeleteOrUpdate (MapCursor kc vc k v))
mapCursorDeleteElemAndSelectNext g =
  focusPossibleDeleteOrUpdate mapCursorNonEmptyCursorL $
    nonEmptyCursorDeleteElemAndSelectNext (make g)

mapCursorRemoveElem :: (k -> kc) -> MapCursor kc vc k v -> DeleteOrUpdate (MapCursor kc vc k v)
mapCursorRemoveElem g = mapCursorNonEmptyCursorL $ nonEmptyCursorRemoveElem (make g)

mapCursorDeleteElem :: (k -> kc) -> MapCursor kc vc k v -> DeleteOrUpdate (MapCursor kc vc k v)
mapCursorDeleteElem g = mapCursorNonEmptyCursorL $ nonEmptyCursorDeleteElem (make g)

mapCursorSearch ::
  (kc -> k) ->
  (k -> kc) ->
  (vc -> v) ->
  (k -> v -> Bool) ->
  MapCursor kc vc k v ->
  Maybe (MapCursor kc vc k v)
mapCursorSearch f g h p =
  mapCursorNonEmptyCursorL $ nonEmptyCursorSearch (rebuild f h) (make g) (uncurry p . rebuild f h)

mapCursorSelectOrAdd ::
  (kc -> k) ->
  (k -> kc) ->
  (vc -> v) ->
  (k -> v -> Bool) ->
  KeyValueCursor kc vc k v ->
  MapCursor kc vc k v ->
  MapCursor kc vc k v
mapCursorSelectOrAdd f g h p kvc =
  mapCursorNonEmptyCursorL
    %~ nonEmptyCursorSelectOrAdd (rebuild f h) (make g) (uncurry p . rebuild f h) kvc

rebuild :: (kc -> k) -> (vc -> v) -> KeyValueCursor kc vc k v -> (k, v)
rebuild = rebuildKeyValueCursor

make :: (k -> kc) -> (k, v) -> KeyValueCursor kc vc k v
make g (k, v) = makeKeyValueCursorKey (g k) v

traverseMapCursor ::
  ([(k, v)] -> KeyValueCursor kc vc k v -> [(k, v)] -> f c) -> MapCursor kc vc k v -> f c
traverseMapCursor combFunc = foldNonEmptyCursor combFunc . mapCursorList

mapCursorTraverseKeyCase ::
  Applicative f => (kc -> v -> f (kc', v)) -> MapCursor kc vc k v -> f (MapCursor kc' vc k v)
mapCursorTraverseKeyCase func = mapCursorElemL $ keyValueCursorTraverseKeyCase func

mapCursorTraverseValueCase ::
  Applicative f => (k -> vc -> f (k, vc')) -> MapCursor kc vc k v -> f (MapCursor kc vc' k v)
mapCursorTraverseValueCase func = mapCursorElemL $ keyValueCursorTraverseValueCase func

foldMapCursor :: ([(k, v)] -> KeyValueCursor kc vc k v -> [(k, v)] -> c) -> MapCursor kc vc k v -> c
foldMapCursor combFunc = foldNonEmptyCursor combFunc . mapCursorList