KeyValue.hs

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

module Cursor.Map.KeyValue
  ( KeyValueCursor(..)
  , makeKeyValueCursorKey
  , makeKeyValueCursorValue
  , rebuildKeyValueCursor
  , keyValueCursorSelection
  , mapKeyValueCursor
  , keyValueCursorSelectKey
  , keyValueCursorSelectValue
  , keyValueCursorToggleSelected
  , KeyValueToggle(..)
  , traverseKeyValueCursor
  , foldKeyValueCursor
  ) where

import GHC.Generics (Generic)

import Data.Validity

import Control.DeepSeq

data KeyValueCursor kc vc k v
  = KeyValueCursorKey kc v
  | KeyValueCursorValue k vc
  deriving (Show, Eq, Generic)

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

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

makeKeyValueCursorKey :: kc -> v -> KeyValueCursor kc vc k v
makeKeyValueCursorKey = KeyValueCursorKey

makeKeyValueCursorValue :: k -> vc -> KeyValueCursor kc vc k v
makeKeyValueCursorValue = KeyValueCursorValue

rebuildKeyValueCursor :: (kc -> k) -> (vc -> v) -> KeyValueCursor kc vc k v -> (k, v)
rebuildKeyValueCursor f _ (KeyValueCursorKey kc v) = (f kc, v)
rebuildKeyValueCursor _ g (KeyValueCursorValue k vc) = (k, g vc)

keyValueCursorSelection :: KeyValueCursor kc vc k v -> KeyValueToggle
keyValueCursorSelection (KeyValueCursorKey _ _) = KeySelected
keyValueCursorSelection (KeyValueCursorValue _ _) = ValueSelected

mapKeyValueCursor ::
     (kc -> lc)
  -> (vc -> wc)
  -> (k -> l)
  -> (v -> w)
  -> KeyValueCursor kc vc k v
  -> KeyValueCursor lc wc l w
mapKeyValueCursor a b c d kvc =
  case kvc of
    KeyValueCursorKey kc v -> KeyValueCursorKey (a kc) (d v)
    KeyValueCursorValue k vc -> KeyValueCursorValue (c k) (b vc)

keyValueCursorSelectKey ::
     (k -> kc) -> (vc -> v) -> KeyValueCursor kc vc k v -> KeyValueCursor kc vc k v
keyValueCursorSelectKey g h kvc =
  case kvc of
    KeyValueCursorValue k vc -> KeyValueCursorKey (g k) (h vc)
    _ -> kvc

keyValueCursorSelectValue ::
     (kc -> k) -> (v -> vc) -> KeyValueCursor kc vc k v -> KeyValueCursor kc vc k v
keyValueCursorSelectValue f i kvc =
  case kvc of
    KeyValueCursorKey kc v -> KeyValueCursorValue (f kc) (i v)
    _ -> kvc

keyValueCursorToggleSelected ::
     (kc -> k)
  -> (k -> kc)
  -> (vc -> v)
  -> (v -> vc)
  -> KeyValueCursor kc vc k v
  -> KeyValueCursor kc vc k v
keyValueCursorToggleSelected f g h i kvc =
  case kvc of
    KeyValueCursorKey kc v -> KeyValueCursorValue (f kc) (i v)
    KeyValueCursorValue k vc -> KeyValueCursorKey (g k) (h vc)

data KeyValueToggle
  = KeySelected
  | ValueSelected
  deriving (Show, Eq, Generic)

instance Validity KeyValueToggle

traverseKeyValueCursor :: (kc -> v -> f c) -> (k -> vc -> f c) -> KeyValueCursor kc vc k v -> f c
traverseKeyValueCursor = foldKeyValueCursor

foldKeyValueCursor :: (kc -> v -> c) -> (k -> vc -> c) -> KeyValueCursor kc vc k v -> c
foldKeyValueCursor keyFunc valFunc kvc =
  case kvc of
    KeyValueCursorKey kc v -> keyFunc kc v
    KeyValueCursorValue k vc -> valFunc k vc