module Chiasma.Ui.Measure.Weights(
  viewWeights,
  normalizeWeights,
  amendAndNormalizeWeights,
) where

import qualified Data.List.NonEmpty as NonEmpty (toList, filter)
import GHC.Float (int2Float)

import Chiasma.Ui.Data.ViewGeometry (ViewGeometry(ViewGeometry))
import Chiasma.Ui.Data.ViewState (ViewState(ViewState))

effectiveWeight :: ViewState -> ViewGeometry -> Maybe Float
effectiveWeight :: ViewState -> ViewGeometry -> Maybe Float
effectiveWeight (ViewState Bool
minimized) (ViewGeometry Maybe Float
_ Maybe Float
_ Maybe Float
fixedSize Maybe Float
_ Maybe Float
weight Maybe Float
_) =
  if Maybe Float -> Bool
forall a. Maybe a -> Bool
isJust Maybe Float
fixedSize Bool -> Bool -> Bool
|| Bool
minimized then Float -> Maybe Float
forall a. a -> Maybe a
Just Float
0 else Maybe Float
weight

amendWeights :: NonEmpty (Maybe Float) -> NonEmpty Float
amendWeights :: NonEmpty (Maybe Float) -> NonEmpty Float
amendWeights NonEmpty (Maybe Float)
weights =
  (Maybe Float -> Float) -> NonEmpty (Maybe Float) -> NonEmpty Float
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Float -> Maybe Float -> Float
forall a. a -> Maybe a -> a
fromMaybe Float
emptyWeight) NonEmpty (Maybe Float)
weights
  where
    total :: Float
total = [Float] -> Float
forall a (f :: * -> *). (Foldable f, Num a) => f a -> a
sum ([Maybe Float] -> [Float]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Float] -> [Float]) -> [Maybe Float] -> [Float]
forall a b. (a -> b) -> a -> b
$ NonEmpty (Maybe Float) -> [Maybe Float]
forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty (Maybe Float)
weights)
    normTotal :: Float
normTotal = if Float
total Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
0 then Float
1 else Float
total
    empties :: Int
empties = [Maybe Float] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ((Maybe Float -> Bool) -> NonEmpty (Maybe Float) -> [Maybe Float]
forall a. (a -> Bool) -> NonEmpty a -> [a]
NonEmpty.filter Maybe Float -> Bool
forall a. Maybe a -> Bool
isNothing NonEmpty (Maybe Float)
weights)
    normEmpties :: Int
normEmpties = if Int
empties Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Int
1 else Int
empties
    emptyWeight :: Float
emptyWeight = Float
normTotal Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Int -> Float
int2Float Int
normEmpties

normalizeWeights :: NonEmpty Float -> NonEmpty Float
normalizeWeights :: NonEmpty Float -> NonEmpty Float
normalizeWeights NonEmpty Float
weights =
  (Float -> Float) -> NonEmpty Float -> NonEmpty Float
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
normTotal) NonEmpty Float
weights
  where
    total :: Float
total = NonEmpty Float -> Float
forall a (f :: * -> *). (Foldable f, Num a) => f a -> a
sum NonEmpty Float
weights
    normTotal :: Float
normTotal = if Float
total Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
0 then Float
1 else Float
total

amendAndNormalizeWeights :: NonEmpty (Maybe Float) -> NonEmpty Float
amendAndNormalizeWeights :: NonEmpty (Maybe Float) -> NonEmpty Float
amendAndNormalizeWeights = NonEmpty Float -> NonEmpty Float
normalizeWeights (NonEmpty Float -> NonEmpty Float)
-> (NonEmpty (Maybe Float) -> NonEmpty Float)
-> NonEmpty (Maybe Float)
-> NonEmpty Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (Maybe Float) -> NonEmpty Float
amendWeights

viewWeights :: NonEmpty (ViewState, ViewGeometry) -> NonEmpty Float
viewWeights :: NonEmpty (ViewState, ViewGeometry) -> NonEmpty Float
viewWeights = NonEmpty (Maybe Float) -> NonEmpty Float
amendAndNormalizeWeights (NonEmpty (Maybe Float) -> NonEmpty Float)
-> (NonEmpty (ViewState, ViewGeometry) -> NonEmpty (Maybe Float))
-> NonEmpty (ViewState, ViewGeometry)
-> NonEmpty Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ViewState, ViewGeometry) -> Maybe Float)
-> NonEmpty (ViewState, ViewGeometry) -> NonEmpty (Maybe Float)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ViewState -> ViewGeometry -> Maybe Float)
-> (ViewState, ViewGeometry) -> Maybe Float
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ViewState -> ViewGeometry -> Maybe Float
effectiveWeight)