module Chiasma.Ui.Measure.Weights where

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

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 a b. (a -> b) -> NonEmpty a -> NonEmpty b
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. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Maybe Float] -> [Float]
forall a. [Maybe a] -> [a]
catMaybes (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 a. [a] -> 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)
    emptyWeight :: Float
emptyWeight =
      Float -> Maybe Float -> Float
forall a. a -> Maybe a -> a
fromMaybe Float
normTotal (Float
normTotal Float -> Float -> Maybe Float
forall a. (Eq a, Fractional a) => a -> a -> Maybe a
/ Int -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac Int
empties)

normalizeWeights :: NonEmpty Float -> NonEmpty Float
normalizeWeights :: NonEmpty Float -> NonEmpty Float
normalizeWeights NonEmpty Float
weights =
  (Float -> Float) -> NonEmpty Float -> NonEmpty Float
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Float -> Float
norm NonEmpty Float
weights
  where
    norm :: Float -> Float
norm Float
a =
      Float -> Maybe Float -> Float
forall a. a -> Maybe a -> a
fromMaybe Float
a (Float
a Float -> Float -> Maybe Float
forall a. (Eq a, Fractional a) => a -> a -> Maybe a
/ NonEmpty Float -> Float
forall a. Num a => NonEmpty a -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum NonEmpty Float
weights)

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 a b. (a -> b) -> NonEmpty a -> NonEmpty b
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)