{-# LANGUAGE RebindableSyntax #-}
{- |
Some functions that are counterparts of functions from "Data.List"
using NumericPrelude.Numeric type classes.
They are distinct in that they check for valid arguments,
e.g. the length argument of 'take' must be at most the length of the input list.
However, since many Haskell programs rely on the absence of such checks,
we did not make these the default implementations
as in "NumericPrelude.List.Generic".
-}
module NumericPrelude.List.Checked
   (take, drop, splitAt, (!!), zipWith,
   ) where

import qualified Algebra.ToInteger  as ToInteger
import Algebra.Ring (one, )
import Algebra.Additive (zero, (-), )

import Data.Tuple.HT (mapFst, )

import qualified NumericPrelude.List as NPList

import NumericPrelude.Base hiding (take, drop, splitAt, length, replicate, (!!), zipWith, )


moduleError :: String -> String -> a
moduleError :: String -> String -> a
moduleError String
name String
msg =
   String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"NumericPrelude.List.Left." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
msg

{- |
Taken number of elements must be at most the length of the list,
otherwise the end of the list is undefined.
-}
take :: (ToInteger.C n) => n -> [a] -> [a]
take :: n -> [a] -> [a]
take n
n =
   if n
nn -> n -> Bool
forall a. Ord a => a -> a -> Bool
<=n
forall a. C a => a
zero
     then [a] -> [a] -> [a]
forall a b. a -> b -> a
const []
     else \[a]
xt ->
       case [a]
xt of
          [] -> String -> String -> [a]
forall a. String -> String -> a
moduleError String
"take" String
"index out of range"
          (a
x:[a]
xs) -> a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: n -> [a] -> [a]
forall n a. C n => n -> [a] -> [a]
take (n
nn -> n -> n
forall a. C a => a -> a -> a
-n
forall a. C a => a
one) [a]
xs

{- |
Dropped number of elements must be at most the length of the list,
otherwise the end of the list is undefined.
-}
drop :: (ToInteger.C n) => n -> [a] -> [a]
drop :: n -> [a] -> [a]
drop n
n =
   if n
nn -> n -> Bool
forall a. Ord a => a -> a -> Bool
<=n
forall a. C a => a
zero
     then [a] -> [a]
forall a. a -> a
id
     else \[a]
xt ->
       case [a]
xt of
          [] -> String -> String -> [a]
forall a. String -> String -> a
moduleError String
"drop" String
"index out of range"
          (a
_:[a]
xs) -> n -> [a] -> [a]
forall n a. C n => n -> [a] -> [a]
drop (n
nn -> n -> n
forall a. C a => a -> a -> a
-n
forall a. C a => a
one) [a]
xs

{- |
Split position must be at most the length of the list,
otherwise the end of the first list and the second list are undefined.
-}
splitAt :: (ToInteger.C n) => n -> [a] -> ([a], [a])
splitAt :: n -> [a] -> ([a], [a])
splitAt n
n [a]
xt =
   if n
nn -> n -> Bool
forall a. Ord a => a -> a -> Bool
<=n
forall a. C a => a
zero
     then ([], [a]
xt)
     else
       case [a]
xt of
          [] -> String -> String -> ([a], [a])
forall a. String -> String -> a
moduleError String
"splitAt" String
"index out of range"
          (a
x:[a]
xs) -> ([a] -> [a]) -> ([a], [a]) -> ([a], [a])
forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:) (([a], [a]) -> ([a], [a])) -> ([a], [a]) -> ([a], [a])
forall a b. (a -> b) -> a -> b
$ n -> [a] -> ([a], [a])
forall n a. C n => n -> [a] -> ([a], [a])
splitAt (n
nn -> n -> n
forall a. C a => a -> a -> a
-n
forall a. C a => a
one) [a]
xs

{- |
The index must be smaller than the length of the list,
otherwise the result is undefined.
-}
(!!) :: (ToInteger.C n) => [a] -> n -> a
!! :: [a] -> n -> a
(!!) [] n
_ = String -> String -> a
forall a. String -> String -> a
moduleError String
"(!!)" String
"index out of range"
(!!) (a
x:[a]
xs) n
n =
   if n
nn -> n -> Bool
forall a. Ord a => a -> a -> Bool
<=n
forall a. C a => a
zero
     then a
x
     else [a] -> n -> a
forall n a. C n => [a] -> n -> a
(!!) [a]
xs (n
nn -> n -> n
forall a. C a => a -> a -> a
-n
forall a. C a => a
one)


{- |
Zip two lists which must be of the same length.
This is checked only lazily, that is unequal lengths are detected only
if the list is evaluated completely.
But it is more strict than @zipWithPad undefined f@
since the latter one may succeed on unequal length list if @f@ is lazy.
-}
zipWith
   :: (a -> b -> c)   {-^ function applied to corresponding elements of the lists -}
   -> [a]
   -> [b]
   -> [c]
zipWith :: (a -> b -> c) -> [a] -> [b] -> [c]
zipWith = (a -> b -> c) -> [a] -> [b] -> [c]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
NPList.zipWithChecked