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

import ClassyPrelude

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. (Enum 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 :: *
  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))