{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}

module DataFrame.Errors where

import qualified Data.Map.Lazy as ML
import qualified Data.Text as T
import qualified Data.Vector as V
import qualified Data.Vector.Unboxed as VU

import Control.Exception
import qualified Data.List as L
import Data.Typeable (Typeable)
import DataFrame.Display.Terminal.Colours
import Type.Reflection (TypeRep)

data TypeErrorContext a b = MkTypeErrorContext
    { forall a b. TypeErrorContext a b -> Either [Char] (TypeRep a)
userType :: Either String (TypeRep a)
    , forall a b. TypeErrorContext a b -> Either [Char] (TypeRep b)
expectedType :: Either String (TypeRep b)
    , forall a b. TypeErrorContext a b -> Maybe [Char]
errorColumnName :: Maybe String
    , forall a b. TypeErrorContext a b -> Maybe [Char]
callingFunctionName :: Maybe String
    }

data DataFrameException where
    TypeMismatchException ::
        forall a b.
        (Typeable a, Typeable b) =>
        TypeErrorContext a b ->
        DataFrameException
    AggregatedAndNonAggregatedException :: T.Text -> T.Text -> DataFrameException
    ColumnsNotFoundException :: [T.Text] -> T.Text -> [T.Text] -> DataFrameException
    EmptyDataSetException :: T.Text -> DataFrameException
    InternalException :: T.Text -> DataFrameException
    NonColumnReferenceException :: T.Text -> DataFrameException
    UnaggregatedException :: T.Text -> DataFrameException
    WrongQuantileNumberException :: Int -> DataFrameException
    WrongQuantileIndexException :: VU.Vector Int -> Int -> DataFrameException
    deriving (Show DataFrameException
Typeable DataFrameException
(Typeable DataFrameException, Show DataFrameException) =>
(DataFrameException -> SomeException)
-> (SomeException -> Maybe DataFrameException)
-> (DataFrameException -> [Char])
-> Exception DataFrameException
SomeException -> Maybe DataFrameException
DataFrameException -> [Char]
DataFrameException -> SomeException
forall e.
(Typeable e, Show e) =>
(e -> SomeException)
-> (SomeException -> Maybe e) -> (e -> [Char]) -> Exception e
$ctoException :: DataFrameException -> SomeException
toException :: DataFrameException -> SomeException
$cfromException :: SomeException -> Maybe DataFrameException
fromException :: SomeException -> Maybe DataFrameException
$cdisplayException :: DataFrameException -> [Char]
displayException :: DataFrameException -> [Char]
Exception)

instance Show DataFrameException where
    show :: DataFrameException -> String
    show :: DataFrameException -> [Char]
show (TypeMismatchException TypeErrorContext a b
context) =
        let
            errorString :: [Char]
errorString =
                [Char] -> ShowS
typeMismatchError
                    (ShowS
-> (TypeRep a -> [Char]) -> Either [Char] (TypeRep a) -> [Char]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ShowS
forall a. a -> a
id TypeRep a -> [Char]
forall a. Show a => a -> [Char]
show (TypeErrorContext a b -> Either [Char] (TypeRep a)
forall a b. TypeErrorContext a b -> Either [Char] (TypeRep a)
userType TypeErrorContext a b
context))
                    (ShowS
-> (TypeRep b -> [Char]) -> Either [Char] (TypeRep b) -> [Char]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ShowS
forall a. a -> a
id TypeRep b -> [Char]
forall a. Show a => a -> [Char]
show (TypeErrorContext a b -> Either [Char] (TypeRep b)
forall a b. TypeErrorContext a b -> Either [Char] (TypeRep b)
expectedType TypeErrorContext a b
context))
         in
            Maybe [Char] -> Maybe [Char] -> ShowS
addCallPointInfo
                (TypeErrorContext a b -> Maybe [Char]
forall a b. TypeErrorContext a b -> Maybe [Char]
errorColumnName TypeErrorContext a b
context)
                (TypeErrorContext a b -> Maybe [Char]
forall a b. TypeErrorContext a b -> Maybe [Char]
callingFunctionName TypeErrorContext a b
context)
                [Char]
errorString
    show (ColumnsNotFoundException [Text]
columnNames Text
callPoint [Text]
availableColumns) = [Text] -> Text -> [Text] -> [Char]
columnsNotFound [Text]
columnNames Text
callPoint [Text]
availableColumns
    show (EmptyDataSetException Text
callPoint) = Text -> [Char]
emptyDataSetError Text
callPoint
    show (WrongQuantileNumberException Int
q) = Int -> [Char]
wrongQuantileNumberError Int
q
    show (WrongQuantileIndexException Vector Int
qs Int
q) = Vector Int -> Int -> [Char]
wrongQuantileIndexError Vector Int
qs Int
q
    show (InternalException Text
msg) = [Char]
"Internal error: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack Text
msg
    show (NonColumnReferenceException Text
msg) = [Char]
"Expression must be a column reference in: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack Text
msg
    show (UnaggregatedException Text
expr) = [Char]
"Expression is not fully aggregated: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack Text
expr
    show (AggregatedAndNonAggregatedException Text
expr1 Text
expr2) =
        [Char]
"Cannot combine aggregated and non-aggregated expressions: \n"
            [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack Text
expr1
            [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"\n"
            [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack Text
expr2

columnNotFound :: T.Text -> T.Text -> [T.Text] -> String
columnNotFound :: Text -> Text -> [Text] -> [Char]
columnNotFound Text
missingColumn = [Text] -> Text -> [Text] -> [Char]
columnsNotFound [Text
missingColumn]

columnsNotFound :: [T.Text] -> T.Text -> [T.Text] -> String
columnsNotFound :: [Text] -> Text -> [Text] -> [Char]
columnsNotFound [Text]
missingColumns Text
callPoint [Text]
availableColumns =
    ShowS
red [Char]
"\n\n[ERROR] "
        [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Text] -> [Char]
forall {a} {a}. IsString a => [a] -> a
missingColumnsLabel [Text]
missingColumns
        [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
": "
        [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack (Text -> [Text] -> Text
T.intercalate Text
", " [Text]
missingColumns)
        [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" for operation "
        [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack Text
callPoint
        [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Text] -> [Text] -> [Char]
formatSuggestions [Text]
missingColumns [Text]
availableColumns
        [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"\n\n"
  where
    missingColumnsLabel :: [a] -> a
missingColumnsLabel [a
_] = a
"Column not found"
    missingColumnsLabel [a]
_ = a
"Columns not found"

    formatSuggestions :: [Text] -> [Text] -> [Char]
formatSuggestions [Text
missingColumn] [Text]
columns =
        case Text -> [Text] -> Text
guessColumnName Text
missingColumn [Text]
columns of
            Text
"" -> [Char]
""
            Text
guessed ->
                [Char]
"\n\tDid you mean "
                    [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack Text
guessed
                    [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"?"
    formatSuggestions [Text]
names [Text]
columns =
        case (Text -> Maybe Text) -> [Text] -> Maybe [Text]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Text -> [Text] -> Maybe Text
`suggestColumnName` [Text]
columns) [Text]
names of
            Just [Text]
guessedColumns
                | Bool -> Bool
not ([Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
guessedColumns) ->
                    [Char]
"\n\tDid you mean "
                        [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Text] -> [Char]
formatColumnSuggestions [Text]
guessedColumns
                        [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"?"
            Maybe [Text]
_ -> [Char]
""

    suggestColumnName :: Text -> [Text] -> Maybe Text
suggestColumnName Text
missingColumn [Text]
columns = case Text -> [Text] -> Text
guessColumnName Text
missingColumn [Text]
columns of
        Text
"" -> Maybe Text
forall a. Maybe a
Nothing
        Text
guessed -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
guessed

    formatColumnSuggestions :: [Text] -> [Char]
formatColumnSuggestions [Text]
guessedColumns =
        [Char]
"["
            [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
L.intercalate [Char]
", " ((Text -> [Char]) -> [Text] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (ShowS
forall a. Show a => a -> [Char]
show ShowS -> (Text -> [Char]) -> Text -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack) [Text]
guessedColumns)
            [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"]"

typeMismatchError :: String -> String -> String
typeMismatchError :: [Char] -> ShowS
typeMismatchError [Char]
givenType [Char]
expType =
    ShowS
red ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
        ShowS
red [Char]
"\n\n[Error]: Type Mismatch"
            [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"\n\tWhile running your code I tried to "
            [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"get a column of type: "
            [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
red (ShowS
forall a. Show a => a -> [Char]
show [Char]
givenType)
            [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" but the column in the dataframe was actually of type: "
            [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
green (ShowS
forall a. Show a => a -> [Char]
show [Char]
expType)

emptyDataSetError :: T.Text -> String
emptyDataSetError :: Text -> [Char]
emptyDataSetError Text
callPoint =
    ShowS
red [Char]
"\n\n[ERROR] "
        [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack Text
callPoint
        [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" cannot be called on empty data sets"

wrongQuantileNumberError :: Int -> String
wrongQuantileNumberError :: Int -> [Char]
wrongQuantileNumberError Int
q =
    ShowS
red [Char]
"\n\n[ERROR] "
        [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"Quantile number q should satisfy "
        [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"q >= 2, but here q is "
        [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
q

wrongQuantileIndexError :: VU.Vector Int -> Int -> String
wrongQuantileIndexError :: Vector Int -> Int -> [Char]
wrongQuantileIndexError Vector Int
qs Int
q =
    ShowS
red [Char]
"\n\n[ERROR] "
        [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"For quantile number q, "
        [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"each quantile index i "
        [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"should satisfy 0 <= i <= q, "
        [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"but here q is "
        [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
q
        [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" and indexes are "
        [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Vector Int -> [Char]
forall a. Show a => a -> [Char]
show Vector Int
qs

addCallPointInfo :: Maybe String -> Maybe String -> String -> String
addCallPointInfo :: Maybe [Char] -> Maybe [Char] -> ShowS
addCallPointInfo (Just [Char]
name) (Just [Char]
cp) [Char]
err =
    [Char]
err
        [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ( [Char]
"\n\tThis happened when calling function "
                [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
brightGreen [Char]
cp
                [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" on "
                [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
brightGreen [Char]
name
           )
addCallPointInfo Maybe [Char]
Nothing (Just [Char]
cp) [Char]
err =
    [Char]
err
        [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ( [Char]
"\n\tThis happened when calling function "
                [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
brightGreen [Char]
cp
           )
addCallPointInfo (Just [Char]
name) Maybe [Char]
Nothing [Char]
err =
    [Char]
err
        [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ( [Char]
"\n\tOn "
                [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
name
                [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"\n\n"
           )
addCallPointInfo Maybe [Char]
Nothing Maybe [Char]
Nothing [Char]
err = [Char]
err

guessColumnName :: T.Text -> [T.Text] -> T.Text
guessColumnName :: Text -> [Text] -> Text
guessColumnName Text
userInput [Text]
columns = case (Text -> (Int, Text)) -> [Text] -> [(Int, Text)]
forall a b. (a -> b) -> [a] -> [b]
map (\Text
k -> (Text -> Text -> Int
editDistance Text
userInput Text
k, Text
k)) [Text]
columns of
    [] -> Text
""
    [(Int, Text)]
res -> ((Int, Text) -> Text
forall a b. (a, b) -> b
snd ((Int, Text) -> Text)
-> ([(Int, Text)] -> (Int, Text)) -> [(Int, Text)] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Int, Text)] -> (Int, Text)
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum) [(Int, Text)]
res

editDistance :: T.Text -> T.Text -> Int
editDistance :: Text -> Text -> Int
editDistance Text
xs Text
ys = Map (Int, Int) Int
table Map (Int, Int) Int -> (Int, Int) -> Int
forall k a. Ord k => Map k a -> k -> a
ML.! (Int
m, Int
n)
  where
    (Int
m, Int
n) = (Text -> Int
T.length Text
xs, Text -> Int
T.length Text
ys)
    xv :: Vector Char
xv = [Char] -> Vector Char
forall a. [a] -> Vector a
V.fromList (Text -> [Char]
T.unpack Text
xs)
    yv :: Vector Char
yv = [Char] -> Vector Char
forall a. [a] -> Vector a
V.fromList (Text -> [Char]
T.unpack Text
ys)
    table :: ML.Map (Int, Int) Int
    table :: Map (Int, Int) Int
table = [((Int, Int), Int)] -> Map (Int, Int) Int
forall k a. Ord k => [(k, a)] -> Map k a
ML.fromList [((Int
i, Int
j), Int -> Int -> Int
dist Int
i Int
j) | Int
i <- [Int
0 .. Int
m], Int
j <- [Int
0 .. Int
n]]
    dist :: Int -> Int -> Int
dist Int
0 Int
j = Int
j
    dist Int
i Int
0 = Int
i
    dist Int
i Int
j =
        [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum
            [ Map (Int, Int) Int
table Map (Int, Int) Int -> (Int, Int) -> Int
forall k a. Ord k => Map k a -> k -> a
ML.! (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1, Int
j) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
            , Map (Int, Int) Int
table Map (Int, Int) Int -> (Int, Int) -> Int
forall k a. Ord k => Map k a -> k -> a
ML.! (Int
i, Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
            , (if Vector Char
xv Vector Char -> Int -> Char
forall a. Vector a -> Int -> a
V.! (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Vector Char
yv Vector Char -> Int -> Char
forall a. Vector a -> Int -> a
V.! (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) then Int
0 else Int
1)
                Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Map (Int, Int) Int
table Map (Int, Int) Int -> (Int, Int) -> Int
forall k a. Ord k => Map k a -> k -> a
ML.! (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1, Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
            ]