{- |
Module      : Util
Copyright   : (c) Leon Vatthauer, 2026
License     : GPL-3
Maintainer  : Leon Vatthauer <leon.vatthauer@fau.de>
Stability   : experimental
Portability : non-portable (ghc-wasm-meta)

Some utility functions.
-}
module Util where

import Miso.Lens (Lens, (%=))

------------------------------------------------------------------------------------------

-- * List utilities

{- | Returns all combinations of a list of list.
Taken from package
[liquid-fixpoint](https://hackage.haskell.org/package/liquid-fixpoint-0.5.0.1)
and adjusted to use `NonEmpty`.

Satisfies:
@allCombinations :: xss:[[a]] -> [{v:[a]| len v == len xss}]@
-}
allCombinations :: [NonEmpty a] -> NonEmpty [a]
allCombinations :: forall a. [NonEmpty a] -> NonEmpty [a]
allCombinations [NonEmpty a]
xs = (NonEmpty [a] -> Bool) -> NonEmpty [a] -> NonEmpty [a]
forall {t}. (t -> Bool) -> t -> t
assert (([a] -> Bool) -> NonEmpty [a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (([NonEmpty a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [NonEmpty a]
xs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==) (Int -> Bool) -> ([a] -> Int) -> [a] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length)) (NonEmpty [a] -> NonEmpty [a]) -> NonEmpty [a] -> NonEmpty [a]
forall a b. (a -> b) -> a -> b
$ [NonEmpty a] -> NonEmpty [a]
forall {f :: * -> *} {a}.
(IsList (f [a]), IsList (Item (f [a])), Functor f,
 Semigroup (f [a])) =>
[NonEmpty a] -> f [a]
go [NonEmpty a]
xs
 where
  go :: [NonEmpty a] -> f [a]
go [] = [[]]
  go ((a
x :| []) : [NonEmpty a]
ys) = (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
:) ([a] -> [a]) -> f [a] -> f [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [NonEmpty a] -> f [a]
go [NonEmpty a]
ys
  go ((a
x :| (a
x' : [a]
xs')) : [NonEmpty a]
ys) = ((a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
:) ([a] -> [a]) -> f [a] -> f [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [NonEmpty a] -> f [a]
go [NonEmpty a]
ys) f [a] -> f [a] -> f [a]
forall a. Semigroup a => a -> a -> a
<> [NonEmpty a] -> f [a]
go ((a
x' a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| [a]
xs') NonEmpty a -> [NonEmpty a] -> [NonEmpty a]
forall a. a -> [a] -> [a]
: [NonEmpty a]
ys)

  assert :: (t -> Bool) -> t -> t
assert t -> Bool
b t
x = if t -> Bool
b t
x then t
x else Text -> t
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"allCombinations: assertion violation"

{- | Interleaves two lists, taking elements alternately from each.
The result ends when the first list is exhausted. If the second list
runs out first, the remaining head of the first list is appended.

>>> interleave [1,2,3] [10,20,30]
[1,10,2,20,3,30]
>>> interleave [1,2,3] [10]
[1,10,2]
-}
interleave :: [a] -> [a] -> [a]
interleave :: forall a. [a] -> [a] -> [a]
interleave [] [a]
_ = []
interleave (a
x : [a]
_) [] = [a
Item [a]
x]
interleave (a
x : [a]
xs) (a
y : [a]
ys) = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: a
y a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
interleave [a]
xs [a]
ys

{- | `insertAt` @x@ @n@ @xs@ inserts @x@ at index @n@ into @xs@.
Returns v'Nothing' for invalid indices.
-}
insertAt :: a -> Int -> [a] -> Maybe [a]
insertAt :: forall a. a -> Int -> [a] -> Maybe [a]
insertAt a
x Int
0 [a]
xs = [a] -> Maybe [a]
forall a. a -> Maybe a
Just ([a] -> Maybe [a]) -> [a] -> Maybe [a]
forall a b. (a -> b) -> a -> b
$ a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs
insertAt a
x Int
n (a
y : [a]
ys) = (a
y a -> [a] -> [a]
forall a. a -> [a] -> [a]
:) ([a] -> [a]) -> Maybe [a] -> Maybe [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> Int -> [a] -> Maybe [a]
forall a. a -> Int -> [a] -> Maybe [a]
insertAt a
x (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [a]
ys
insertAt a
_ Int
_ [a]
_ = Maybe [a]
forall a. Maybe a
Nothing

{- | `removeAt` @n@ @xs@ removes the element at index @n@.
Returns v'Nothing' for invalid indices.
-}
removeAt :: Int -> [a] -> Maybe [a]
removeAt :: forall a. Int -> [a] -> Maybe [a]
removeAt Int
n [] = Maybe [a]
forall a. Maybe a
Nothing
removeAt Int
n (a
x : [a]
xs)
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = [a] -> Maybe [a]
forall a. a -> Maybe a
Just ([a] -> Maybe [a]) -> [a] -> Maybe [a]
forall a b. (a -> b) -> a -> b
$ a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs
  | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = [a] -> Maybe [a]
forall a. a -> Maybe a
Just [a]
xs
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
:) ([a] -> [a]) -> Maybe [a] -> Maybe [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> [a] -> Maybe [a]
forall a. Int -> [a] -> Maybe [a]
removeAt (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [a]
xs

{- | Update nth element of a list, if it exists.
  @O(min index n)@.

  Precondition: the index is >= 0.
  (Copied from Agda.Utils.List and adjusted for monadicity)
-}
updateAtM :: (MonadFail m) => Int -> (a -> m a) -> [a] -> m [a]
updateAtM :: forall (m :: * -> *) a.
MonadFail m =>
Int -> (a -> m a) -> [a] -> m [a]
updateAtM Int
_ a -> m a
_ [] = String -> m [a]
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
""
updateAtM Int
0 a -> m a
f (a
a : [a]
as) = a -> m a
f a
a m a -> (a -> [a]) -> m [a]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
as)
updateAtM Int
n a -> m a
f (a
a : [a]
as) = (a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
:) ([a] -> [a]) -> m [a] -> m [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> (a -> m a) -> [a] -> m [a]
forall (m :: * -> *) a.
MonadFail m =>
Int -> (a -> m a) -> [a] -> m [a]
updateAtM (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) a -> m a
f [a]
as

------------------------------------------------------------------------------------------

-- * Lens utilities

{- | A variant of '(%=)' that only updates the field when the function
returns 'Just'. If the function returns 'Nothing', the field is left
unchanged.
-}
(%=?) :: (MonadState record m) => Lens record field -> (field -> Maybe field) -> m ()
%=? :: forall record (m :: * -> *) field.
MonadState record m =>
Lens record field -> (field -> Maybe field) -> m ()
(%=?) Lens record field
_lens field -> Maybe field
f = Lens record field
_lens Lens record field -> (field -> field) -> m ()
forall record (m :: * -> *) field.
MonadState record m =>
Lens record field -> (field -> field) -> m ()
%= (\field
x -> field -> Maybe field -> field
forall a. a -> Maybe a -> a
fromMaybe field
x (field -> Maybe field
f field
x))

------------------------------------------------------------------------------------------

-- * Numeric utilities

-- | Returns whether the given integer lies inside the inclusive interval.
inRange :: (Int, Int) -> Int -> Bool
inRange :: (Int, Int) -> Int -> Bool
inRange (Int
start, Int
end) Int
n = Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
start Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
end