{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NoImplicitPrelude #-}

-- | Combinators for a possibly-multidimensional measurement
--
-- The type @(Age, Height)@ is archetypal example of 'Measure'. It's typically
-- a fixed-length vector of non-negative " measurements ".
--
-- The anticipated use-cases involve some notion of a capacity that is limited
-- on a per-dimension basis. Thus the measure of each included candidate
-- quantifies how much of that capacity the candidate would occupy. See eg
-- 'splitAt'.
--
-- See the 'Measure' class for more.
module Data.Measure (
  module Data.Measure.Class,
  (<=),
  (>=),
  drop,
  splitAt,
  take,
)
where

import Data.Measure.Class
import qualified Prelude

infix 4 <=, >=

-- | The partial order induced by 'min'
--
-- It's only true if every component on the left is @<=@ the corresponding
-- component on the right.
(<=) :: Measure a => a -> a -> Prelude.Bool
a
x <= :: forall a. Measure a => a -> a -> Bool
<= a
y = a
x forall a. Eq a => a -> a -> Bool
Prelude.== forall a. Measure a => a -> a -> a
min a
x a
y

-- | The partial order induced by 'max'
--
-- It's only true if every component on the left is @>=@ the corresponding
-- component on the right.
(>=) :: Measure a => a -> a -> Prelude.Bool
a
x >= :: forall a. Measure a => a -> a -> Bool
>= a
y = a
x forall a. Eq a => a -> a -> Bool
Prelude.== forall a. Measure a => a -> a -> a
max a
x a
y

-- | Split a list once a prefix fills up the given capacity
--
-- Note that this just splits the given list; it does not attempt anything
-- clever like bin-packing etc.
splitAt :: Measure a => (e -> a) -> a -> [e] -> ([e], [e])
splitAt :: forall a e. Measure a => (e -> a) -> a -> [e] -> ([e], [e])
splitAt e -> a
measure a
limit =
  a -> [e] -> [e] -> ([e], [e])
go forall a. Measure a => a
zero []
  where
    go :: a -> [e] -> [e] -> ([e], [e])
go !a
tot [e]
acc = \case
      [] -> (forall a. [a] -> [a]
Prelude.reverse [e]
acc, [])
      e
e : [e]
es ->
        if a
tot' forall a. Measure a => a -> a -> Bool
<= a
limit
          then a -> [e] -> [e] -> ([e], [e])
go a
tot' (e
e forall a. a -> [a] -> [a]
: [e]
acc) [e]
es
          else (forall a. [a] -> [a]
Prelude.reverse [e]
acc, e
e forall a. a -> [a] -> [a]
: [e]
es)
        where
          tot' :: a
tot' = forall a. Measure a => a -> a -> a
plus a
tot (e -> a
measure e
e)

-- | @fst . 'splitAt' measure limit@, but non-strict
take :: Measure a => (e -> a) -> a -> [e] -> [e]
take :: forall a e. Measure a => (e -> a) -> a -> [e] -> [e]
take e -> a
measure a
limit =
  a -> [e] -> [e]
go forall a. Measure a => a
zero
  where
    go :: a -> [e] -> [e]
go !a
tot = \case
      [] -> []
      e
e : [e]
es ->
        if a
tot' forall a. Measure a => a -> a -> Bool
<= a
limit
          then e
e forall a. a -> [a] -> [a]
: a -> [e] -> [e]
go a
tot' [e]
es
          else []
        where
          tot' :: a
tot' = forall a. Measure a => a -> a -> a
plus a
tot (e -> a
measure e
e)

-- | @snd . 'splitAt' measure limit@, with a bit less allocation
drop :: Measure a => (e -> a) -> a -> [e] -> [e]
drop :: forall a e. Measure a => (e -> a) -> a -> [e] -> [e]
drop e -> a
measure a
limit =
  a -> [e] -> [e]
go forall a. Measure a => a
zero
  where
    go :: a -> [e] -> [e]
go !a
tot = \case
      [] -> []
      e
e : [e]
es ->
        if a
tot' forall a. Measure a => a -> a -> Bool
<= a
limit
          then a -> [e] -> [e]
go a
tot' [e]
es
          else e
e forall a. a -> [a] -> [a]
: [e]
es
        where
          tot' :: a
tot' = forall a. Measure a => a -> a -> a
plus a
tot (e -> a
measure e
e)