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

module DataFrame.Errors where

import qualified Data.Text as T
import qualified Data.Vector.Unboxed as VU

import Control.Exception
import Data.Array
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
    ColumnNotFoundException :: 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 (ColumnNotFoundException Text
columnName Text
callPoint [Text]
availableColumns) = Text -> Text -> [Text] -> [Char]
columnNotFound Text
columnName 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
name Text
callPoint [Text]
columns =
    ShowS
red [Char]
"\n\n[ERROR] "
        [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"Column not found: "
        [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack Text
name
        [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]
++ [Char]
"\n\tDid you mean "
        [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack (Text -> [Text] -> Text
guessColumnName Text
name [Text]
columns)
        [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"?\n\n"

typeMismatchError :: String -> String -> String
typeMismatchError :: [Char] -> ShowS
typeMismatchError [Char]
givenType [Char]
expectedType =
    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]
expectedType)

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 = Array (Int, Int) Int
table Array (Int, Int) Int -> (Int, Int) -> Int
forall i e. Ix i => Array i e -> i -> e
! (Int
m, Int
n)
  where
    (Int
m, Int
n) = (Text -> Int
T.length Text
xs, Text -> Int
T.length Text
ys)
    x :: Array Int Char
x = (Int, Int) -> [(Int, Char)] -> Array Int Char
forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
array (Int
1, Int
m) ([Int] -> [Char] -> [(Int, Char)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1 ..] (Text -> [Char]
T.unpack Text
xs))
    y :: Array Int Char
y = (Int, Int) -> [(Int, Char)] -> Array Int Char
forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
array (Int
1, Int
n) ([Int] -> [Char] -> [(Int, Char)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1 ..] (Text -> [Char]
T.unpack Text
ys))

    table :: Array (Int, Int) Int
    table :: Array (Int, Int) Int
table = ((Int, Int), (Int, Int))
-> [((Int, Int), Int)] -> Array (Int, Int) Int
forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
array ((Int, Int), (Int, Int))
bnds [((Int, Int)
ij, (Int, Int) -> Int
dist (Int, Int)
ij) | (Int, Int)
ij <- ((Int, Int), (Int, Int)) -> [(Int, Int)]
forall a. Ix a => (a, a) -> [a]
range ((Int, Int), (Int, Int))
bnds]
    bnds :: ((Int, Int), (Int, Int))
bnds = ((Int
0, Int
0), (Int
m, 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
            [ Array (Int, Int) Int
table Array (Int, Int) Int -> (Int, Int) -> Int
forall i e. Ix i => Array i e -> i -> e
! (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
            , Array (Int, Int) Int
table Array (Int, Int) Int -> (Int, Int) -> Int
forall i e. Ix i => Array i e -> i -> e
! (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 Array Int Char
x Array Int Char -> Int -> Char
forall i e. Ix i => Array i e -> i -> e
! Int
i Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Array Int Char
y Array Int Char -> Int -> Char
forall i e. Ix i => Array i e -> i -> e
! Int
j then Array (Int, Int) Int
table Array (Int, Int) Int -> (Int, Int) -> Int
forall i e. Ix i => Array i e -> i -> e
! (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) else Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Array (Int, Int) Int
table Array (Int, Int) Int -> (Int, Int) -> Int
forall i e. Ix i => Array i e -> i -> e
! (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)
            ]