{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE ScopedTypeVariables #-}

module DSV.VectorViews
  ( columnNumberView, lookupView
  , columnNumberView_, lookupView_
  ) where

import DSV.IndexError
import DSV.LookupError
import DSV.Numbers
import DSV.Position
import DSV.Prelude
import DSV.Validation
import DSV.Vector
import DSV.ViewType

columnNumberView :: forall a.
    ColumnNumber -> View TooShort (Vector a) a

columnNumberView :: ColumnNumber -> View TooShort (Vector a) a
columnNumberView (ColumnNumber Positive
n) =
    (Vector a -> Validation TooShort a) -> View TooShort (Vector a) a
forall e a b. (a -> Validation e b) -> View e a b
View ((Vector a -> Validation TooShort a) -> View TooShort (Vector a) a)
-> (Vector a -> Validation TooShort a)
-> View TooShort (Vector a) a
forall a b. (a -> b) -> a -> b
$ \Vector a
xs ->
        case Vector a -> Int -> Maybe a
forall a. Vector a -> Int -> Maybe a
vectorIndexInt Vector a
xs (Positive -> Int
positiveInt Positive
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) of
            Maybe a
Nothing -> TooShort -> Validation TooShort a
forall err a. err -> Validation err a
Failure TooShort
TooShort
            Just a
x  -> a -> Validation TooShort a
forall err a. a -> Validation err a
Success a
x

columnNumberView_ :: forall a.
    ColumnNumber -> View () (Vector a) a

columnNumberView_ :: ColumnNumber -> View () (Vector a) a
columnNumberView_ ColumnNumber
x = View TooShort (Vector a) a -> View () (Vector a) a
forall e a b. View e a b -> View () a b
discardViewError (ColumnNumber -> View TooShort (Vector a) a
forall a. ColumnNumber -> View TooShort (Vector a) a
columnNumberView ColumnNumber
x)

lookupView ::
    (a -> Bool)
    -> View LookupError (Vector (a, b)) b

lookupView :: (a -> Bool) -> View LookupError (Vector (a, b)) b
lookupView a -> Bool
f =
    (Vector (a, b) -> Validation LookupError b)
-> View LookupError (Vector (a, b)) b
forall e a b. (a -> Validation e b) -> View e a b
View ((Vector (a, b) -> Validation LookupError b)
 -> View LookupError (Vector (a, b)) b)
-> (Vector (a, b) -> Validation LookupError b)
-> View LookupError (Vector (a, b)) b
forall a b. (a -> b) -> a -> b
$ \Vector (a, b)
xs ->
        case ((a, b) -> Bool) -> [(a, b)] -> [(a, b)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(a
n, b
_) -> a -> Bool
f a
n) (Vector (a, b) -> [(a, b)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Vector (a, b)
xs) of
            [] -> LookupError -> Validation LookupError b
forall err a. err -> Validation err a
Failure LookupError
LookupError_Missing
            [(a
_, b
v)] -> b -> Validation LookupError b
forall err a. a -> Validation err a
Success b
v
            [(a, b)]
_ -> LookupError -> Validation LookupError b
forall err a. err -> Validation err a
Failure LookupError
LookupError_Duplicate

lookupView_ ::
    (a -> Bool)
    -> View () (Vector (a, b)) b

lookupView_ :: (a -> Bool) -> View () (Vector (a, b)) b
lookupView_ a -> Bool
x = View LookupError (Vector (a, b)) b -> View () (Vector (a, b)) b
forall e a b. View e a b -> View () a b
discardViewError ((a -> Bool) -> View LookupError (Vector (a, b)) b
forall a b. (a -> Bool) -> View LookupError (Vector (a, b)) b
lookupView a -> Bool
x)