{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE DefaultSignatures #-}

module Data.Aviation.Aip.Cache(
  Cache(..)
, AsCache(..)
, FoldCache(..)
, GetCache(..)
, SetCache(..)
, ManyCache(..)
, HasCache(..)
, IsCache(..)
, AsReadCache(..)
, AsReadWriteCache(..)
, AsNoCache(..)
, isReadOrWriteCache
, isWriteCache
) where

import Control.Category(id)
import Control.Applicative(pure)
import Control.Lens
import Data.Bool(Bool, not)
import Data.Eq(Eq)
import Data.Foldable(any)
import Data.Maybe(Maybe(Just, Nothing))
import Data.Ord(Ord)
import Prelude(Show)

data Cache =
  ReadCache
  | ReadWriteCache
  | NoCache
  deriving (Eq, Ord, Show)

class ManyCache a => AsCache a where
  _Cache ::
    Prism' a Cache
  default _Cache ::
    IsCache a =>
    Prism' a Cache
  _Cache =
    _IsCache

instance AsCache Cache where
  _Cache =
    id

class FoldCache a where
  _FoldCache ::
    Fold a Cache

instance FoldCache Cache where
  _FoldCache =
    id

class FoldCache a => GetCache a where
  _GetCache ::
    Getter a Cache
  default _GetCache ::
    HasCache a =>
    Getter a Cache
  _GetCache =
    cache

instance GetCache Cache where
  _GetCache =
    id

class SetCache a where
  _SetCache ::
    Setter' a Cache
  default _SetCache ::
    ManyCache a =>
    Setter' a Cache
  _SetCache =
    _ManyCache

instance SetCache Cache where
  _SetCache =
    id

class (FoldCache a, SetCache a) => ManyCache a where
  _ManyCache ::
    Traversal' a Cache

instance ManyCache Cache where
  _ManyCache =
    id

class (GetCache a, ManyCache a) => HasCache a where
  cache ::
    Lens' a Cache
  default cache ::
    IsCache a =>
    Lens' a Cache
  cache =
    _IsCache

instance HasCache Cache where
  cache =
    id

class (HasCache a, AsCache a) => IsCache a where
  _IsCache ::
    Iso' a Cache

instance IsCache Cache where
  _IsCache =
    id

instance SetCache () where
instance FoldCache () where
  _FoldCache =
    _ManyCache
instance ManyCache () where
  _ManyCache _ x =
    pure x

----


class AsReadCache a where
  _ReadCache ::
    Prism'
      a
      ()

instance AsReadCache () where
  _ReadCache =
    id

instance AsReadCache Cache where
  _ReadCache =
    prism'
      (\() -> ReadCache)
      (\c -> case c of
                ReadCache ->
                  Just ()
                _ ->
                  Nothing)

class AsReadWriteCache a where
  _ReadWriteCache ::
    Prism'
      a
      ()

instance AsReadWriteCache () where
  _ReadWriteCache =
    id

instance AsReadWriteCache Cache where
  _ReadWriteCache =
    prism'
      (\() -> ReadWriteCache)
      (\c -> case c of
                ReadWriteCache ->
                  Just ()
                _ ->
                  Nothing)

class AsNoCache a where
  _NoCache ::
    Prism'
      a
      ()

instance AsNoCache () where
  _NoCache =
    id

instance AsNoCache Cache where
  _NoCache =
    prism'
      (\() -> NoCache)
      (\c -> case c of
                NoCache ->
                  Just ()
                _ ->
                  Nothing)

isReadOrWriteCache ::
  (AsReadCache t, AsReadWriteCache t) =>
  t
  -> Bool
isReadOrWriteCache x =
  any (\p' -> not (isn't p' x)) [_ReadCache, _ReadWriteCache]

isWriteCache ::
  AsReadWriteCache t =>
  t
  -> Bool
isWriteCache x =
  not (isn't _ReadWriteCache x)