module Handler.Utils.Form.MassInput.Liveliness
  ( BoxDimension(..)
  , IsBoxCoord(..)
  , boxDimension
  , Liveliness(..)
  ) where

import ClassyPrelude
import Data.Kind (Type)

import Web.PathPieces (PathPiece)
import Data.Aeson (ToJSON, FromJSON, ToJSONKey, FromJSONKey)

import Numeric.Natural

import Utils.Lens

import Algebra.Lattice

import qualified Data.Set as Set
import Data.List (genericLength, genericIndex)


data BoxDimension x = forall n. Eq n => BoxDimension (Lens' x n)

class (ToJSON x, FromJSON x, ToJSONKey x, FromJSONKey x, PathPiece x, Eq x, Ord x) => IsBoxCoord x where
  boxDimensions :: [BoxDimension x]
  boxOrigin :: x

boxDimension :: forall x. IsBoxCoord x => Natural -> BoxDimension x
boxDimension n
  | n < genericLength dims = genericIndex dims n
  | otherwise = error "boxDimension: insufficient dimensions"
  where
    dims :: [BoxDimension x]
    dims = boxDimensions

-- zeroDimension :: IsBoxCoord x => Natural -> x -> x
-- zeroDimension (boxDimension -> BoxDimension dim) = set dim $ boxOrigin ^. dim

class (IsBoxCoord (BoxCoord a), Lattice a, BoundedJoinSemiLattice a) => Liveliness a where
  type BoxCoord a :: Type
  liveCoords :: Prism' (Set (BoxCoord a)) a
  liveCoord :: BoxCoord a -> Prism' Bool a
  liveCoord bC = prism' (\l -> bC `Set.member` review liveCoords l) (bool (Just bottom) (preview liveCoords $ Set.singleton bC))