48 lines
1.3 KiB
Haskell
48 lines
1.3 KiB
Haskell
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))
|
|
|
|
|