{-# LANGUAGE NoImplicitPrelude #-}

module DSV.LookupUtf8
  ( lookupTextViewUtf8, lookupStringViewUtf8
  , lookupTextViewUtf8_, lookupStringViewUtf8_
  , LookupErrorUtf8 (..)
  ) where

import DSV.ByteString
import DSV.LookupErrorUtf8
import DSV.Prelude
import DSV.Text
import DSV.Validation
import DSV.Vector
import DSV.ViewType
import DSV.UTF8

lookupTextViewUtf8 :: (Text -> Bool)
    -> View LookupErrorUtf8 (Vector (ByteString, ByteString)) Text
lookupTextViewUtf8 :: (Text -> Bool)
-> View LookupErrorUtf8 (Vector (ByteString, ByteString)) Text
lookupTextViewUtf8 = (Text -> Bool)
-> View LookupErrorUtf8 (Vector (ByteString, ByteString)) Text
forall a.
DecodeUtf8 a =>
(a -> Bool)
-> View LookupErrorUtf8 (Vector (ByteString, ByteString)) a
lookupViewUtf8

lookupTextViewUtf8_ :: (Text -> Bool)
    -> View () (Vector (ByteString, ByteString)) Text
lookupTextViewUtf8_ :: (Text -> Bool) -> View () (Vector (ByteString, ByteString)) Text
lookupTextViewUtf8_ Text -> Bool
x = View LookupErrorUtf8 (Vector (ByteString, ByteString)) Text
-> View () (Vector (ByteString, ByteString)) Text
forall e a b. View e a b -> View () a b
discardViewError ((Text -> Bool)
-> View LookupErrorUtf8 (Vector (ByteString, ByteString)) Text
lookupTextViewUtf8 Text -> Bool
x)

lookupStringViewUtf8 :: (String -> Bool)
    -> View LookupErrorUtf8 (Vector (ByteString, ByteString)) String
lookupStringViewUtf8 :: (String -> Bool)
-> View LookupErrorUtf8 (Vector (ByteString, ByteString)) String
lookupStringViewUtf8 = (String -> Bool)
-> View LookupErrorUtf8 (Vector (ByteString, ByteString)) String
forall a.
DecodeUtf8 a =>
(a -> Bool)
-> View LookupErrorUtf8 (Vector (ByteString, ByteString)) a
lookupViewUtf8

lookupStringViewUtf8_ :: (String -> Bool)
    -> View () (Vector (ByteString, ByteString)) String
lookupStringViewUtf8_ :: (String -> Bool)
-> View () (Vector (ByteString, ByteString)) String
lookupStringViewUtf8_ String -> Bool
x = View LookupErrorUtf8 (Vector (ByteString, ByteString)) String
-> View () (Vector (ByteString, ByteString)) String
forall e a b. View e a b -> View () a b
discardViewError ((String -> Bool)
-> View LookupErrorUtf8 (Vector (ByteString, ByteString)) String
lookupStringViewUtf8 String -> Bool
x)

lookupViewUtf8 :: DecodeUtf8 a => (a -> Bool)
    -> View LookupErrorUtf8 (Vector (ByteString, ByteString)) a
lookupViewUtf8 :: (a -> Bool)
-> View LookupErrorUtf8 (Vector (ByteString, ByteString)) a
lookupViewUtf8 a -> Bool
f =
    (Vector (ByteString, ByteString) -> Validation LookupErrorUtf8 a)
-> View LookupErrorUtf8 (Vector (ByteString, ByteString)) a
forall e a b. (a -> Validation e b) -> View e a b
View ((Vector (ByteString, ByteString) -> Validation LookupErrorUtf8 a)
 -> View LookupErrorUtf8 (Vector (ByteString, ByteString)) a)
-> (Vector (ByteString, ByteString)
    -> Validation LookupErrorUtf8 a)
-> View LookupErrorUtf8 (Vector (ByteString, ByteString)) a
forall a b. (a -> b) -> a -> b
$ \Vector (ByteString, ByteString)
xs ->
        case ((ByteString, ByteString) -> Bool)
-> [(ByteString, ByteString)] -> [(ByteString, ByteString)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(ByteString
n, ByteString
_) -> Bool -> (a -> Bool) -> Maybe a -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False a -> Bool
f (ByteString -> Maybe a
forall a. DecodeUtf8 a => ByteString -> Maybe a
decodeUtf8Maybe ByteString
n)) (Vector (ByteString, ByteString) -> [(ByteString, ByteString)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Vector (ByteString, ByteString)
xs) of
            [] -> LookupErrorUtf8 -> Validation LookupErrorUtf8 a
forall err a. err -> Validation err a
Failure LookupErrorUtf8
LookupErrorUtf8_Missing
            [(ByteString
_, ByteString
v)] -> Validation LookupErrorUtf8 a
-> (a -> Validation LookupErrorUtf8 a)
-> Maybe a
-> Validation LookupErrorUtf8 a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (LookupErrorUtf8 -> Validation LookupErrorUtf8 a
forall err a. err -> Validation err a
Failure LookupErrorUtf8
LookupErrorUtf8_Invalid) a -> Validation LookupErrorUtf8 a
forall err a. a -> Validation err a
Success (ByteString -> Maybe a
forall a. DecodeUtf8 a => ByteString -> Maybe a
decodeUtf8Maybe ByteString
v)
            [(ByteString, ByteString)]
_ -> LookupErrorUtf8 -> Validation LookupErrorUtf8 a
forall err a. err -> Validation err a
Failure LookupErrorUtf8
LookupErrorUtf8_Duplicate