{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE DerivingStrategies, DeriveAnyClass #-}

module DSV.LookupError
  ( Missing (..)
  , Duplicate (..)
  , LookupError (..)
  ) where

import DSV.IO
import DSV.Prelude

data Missing = Missing
  deriving stock (Missing -> Missing -> Bool
(Missing -> Missing -> Bool)
-> (Missing -> Missing -> Bool) -> Eq Missing
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Missing -> Missing -> Bool
$c/= :: Missing -> Missing -> Bool
== :: Missing -> Missing -> Bool
$c== :: Missing -> Missing -> Bool
Eq, Int -> Missing -> ShowS
[Missing] -> ShowS
Missing -> String
(Int -> Missing -> ShowS)
-> (Missing -> String) -> ([Missing] -> ShowS) -> Show Missing
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Missing] -> ShowS
$cshowList :: [Missing] -> ShowS
show :: Missing -> String
$cshow :: Missing -> String
showsPrec :: Int -> Missing -> ShowS
$cshowsPrec :: Int -> Missing -> ShowS
Show)
  deriving anyclass Show Missing
Typeable Missing
Typeable Missing
-> Show Missing
-> (Missing -> SomeException)
-> (SomeException -> Maybe Missing)
-> (Missing -> String)
-> Exception Missing
SomeException -> Maybe Missing
Missing -> String
Missing -> SomeException
forall e.
Typeable e
-> Show e
-> (e -> SomeException)
-> (SomeException -> Maybe e)
-> (e -> String)
-> Exception e
displayException :: Missing -> String
$cdisplayException :: Missing -> String
fromException :: SomeException -> Maybe Missing
$cfromException :: SomeException -> Maybe Missing
toException :: Missing -> SomeException
$ctoException :: Missing -> SomeException
$cp2Exception :: Show Missing
$cp1Exception :: Typeable Missing
Exception

data Duplicate = Duplicate
  deriving stock (Duplicate -> Duplicate -> Bool
(Duplicate -> Duplicate -> Bool)
-> (Duplicate -> Duplicate -> Bool) -> Eq Duplicate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Duplicate -> Duplicate -> Bool
$c/= :: Duplicate -> Duplicate -> Bool
== :: Duplicate -> Duplicate -> Bool
$c== :: Duplicate -> Duplicate -> Bool
Eq, Int -> Duplicate -> ShowS
[Duplicate] -> ShowS
Duplicate -> String
(Int -> Duplicate -> ShowS)
-> (Duplicate -> String)
-> ([Duplicate] -> ShowS)
-> Show Duplicate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Duplicate] -> ShowS
$cshowList :: [Duplicate] -> ShowS
show :: Duplicate -> String
$cshow :: Duplicate -> String
showsPrec :: Int -> Duplicate -> ShowS
$cshowsPrec :: Int -> Duplicate -> ShowS
Show)
  deriving anyclass Show Duplicate
Typeable Duplicate
Typeable Duplicate
-> Show Duplicate
-> (Duplicate -> SomeException)
-> (SomeException -> Maybe Duplicate)
-> (Duplicate -> String)
-> Exception Duplicate
SomeException -> Maybe Duplicate
Duplicate -> String
Duplicate -> SomeException
forall e.
Typeable e
-> Show e
-> (e -> SomeException)
-> (SomeException -> Maybe e)
-> (e -> String)
-> Exception e
displayException :: Duplicate -> String
$cdisplayException :: Duplicate -> String
fromException :: SomeException -> Maybe Duplicate
$cfromException :: SomeException -> Maybe Duplicate
toException :: Duplicate -> SomeException
$ctoException :: Duplicate -> SomeException
$cp2Exception :: Show Duplicate
$cp1Exception :: Typeable Duplicate
Exception

-- | The general concept of what can go wrong when you look up the position of a particular element in a list.
data LookupError
  = LookupError_Missing  -- ^ There is /no/ matching element.
  | LookupError_Duplicate  -- ^ There are /more than one/ matching elements.
  deriving stock (LookupError -> LookupError -> Bool
(LookupError -> LookupError -> Bool)
-> (LookupError -> LookupError -> Bool) -> Eq LookupError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LookupError -> LookupError -> Bool
$c/= :: LookupError -> LookupError -> Bool
== :: LookupError -> LookupError -> Bool
$c== :: LookupError -> LookupError -> Bool
Eq, Int -> LookupError -> ShowS
[LookupError] -> ShowS
LookupError -> String
(Int -> LookupError -> ShowS)
-> (LookupError -> String)
-> ([LookupError] -> ShowS)
-> Show LookupError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LookupError] -> ShowS
$cshowList :: [LookupError] -> ShowS
show :: LookupError -> String
$cshow :: LookupError -> String
showsPrec :: Int -> LookupError -> ShowS
$cshowsPrec :: Int -> LookupError -> ShowS
Show)
  deriving anyclass Show LookupError
Typeable LookupError
Typeable LookupError
-> Show LookupError
-> (LookupError -> SomeException)
-> (SomeException -> Maybe LookupError)
-> (LookupError -> String)
-> Exception LookupError
SomeException -> Maybe LookupError
LookupError -> String
LookupError -> SomeException
forall e.
Typeable e
-> Show e
-> (e -> SomeException)
-> (SomeException -> Maybe e)
-> (e -> String)
-> Exception e
displayException :: LookupError -> String
$cdisplayException :: LookupError -> String
fromException :: SomeException -> Maybe LookupError
$cfromException :: SomeException -> Maybe LookupError
toException :: LookupError -> SomeException
$ctoException :: LookupError -> SomeException
$cp2Exception :: Show LookupError
$cp1Exception :: Typeable LookupError
Exception