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

module DataFrame.Errors where

import qualified Data.Text as T

import Control.Exception
import Data.Array
import DataFrame.Display.Terminal.Colours
import Data.Typeable (Typeable)
import Type.Reflection (TypeRep)

data DataFrameException where
    TypeMismatchException :: forall a b. (Typeable a, Typeable b)
                          => TypeRep a -- ^ given type
                          -> TypeRep b -- ^ expected type
                          -> T.Text    -- ^ column name
                          -> T.Text    -- ^ call point
                          -> DataFrameException
    TypeMismatchException' :: forall a . (Typeable a)
                           => TypeRep a -- ^ given type
                           -> String    -- ^ expected type
                           -> T.Text    -- ^ column name
                           -> T.Text    -- ^ call point
                           -> DataFrameException
    ColumnNotFoundException :: T.Text -> T.Text -> [T.Text] -> 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 TypeRep a
a TypeRep b
b Text
columnName Text
callPoint) = Text -> Maybe Text -> ShowS
addCallPointInfo Text
columnName (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
callPoint) (TypeRep a -> TypeRep b -> [Char]
forall a b. TypeRep a -> TypeRep b -> [Char]
typeMismatchError TypeRep a
a TypeRep b
b)
    show (TypeMismatchException' TypeRep a
a [Char]
b Text
columnName Text
callPoint) = Text -> Maybe Text -> ShowS
addCallPointInfo Text
columnName (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
callPoint) ([Char] -> ShowS
typeMismatchError' (TypeRep a -> [Char]
forall a. Show a => a -> [Char]
show TypeRep a
a) [Char]
b)
    show (ColumnNotFoundException Text
columnName Text
callPoint [Text]
availableColumns) = Text -> Text -> [Text] -> [Char]
columnNotFound Text
columnName Text
callPoint [Text]
availableColumns

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 ::
  Type.Reflection.TypeRep a ->
  Type.Reflection.TypeRep b ->
  String
typeMismatchError :: forall a b. TypeRep a -> TypeRep b -> [Char]
typeMismatchError TypeRep a
a TypeRep b
b = [Char] -> ShowS
typeMismatchError' (TypeRep a -> [Char]
forall a. Show a => a -> [Char]
show TypeRep a
a) (TypeRep b -> [Char]
forall a. Show a => a -> [Char]
show TypeRep b
b)

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 column was of type: "
      [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
green (ShowS
forall a. Show a => a -> [Char]
show [Char]
expectedType)

addCallPointInfo :: T.Text -> Maybe T.Text -> String -> String
addCallPointInfo :: Text -> Maybe Text -> ShowS
addCallPointInfo Text
name (Just Text
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 (Text -> [Char]
T.unpack Text
cp)
           [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" on the column "
           [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
brightGreen (Text -> [Char]
T.unpack Text
name)
           [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"\n\n"
           [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
typeAnnotationSuggestion (Text -> [Char]
T.unpack Text
cp)
       )
addCallPointInfo Text
name Maybe Text
Nothing [Char]
err =
  [Char]
err
    [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ( [Char]
"\n\tOn the column "
           [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack Text
name
           [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"\n\n"
           [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
typeAnnotationSuggestion [Char]
"<function>"
       )

typeAnnotationSuggestion :: String -> String
typeAnnotationSuggestion :: ShowS
typeAnnotationSuggestion [Char]
cp =
  [Char]
"\n\n\tTry adding a type at the end of the function e.g "
    [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"change\n\t\t"
    [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
red ([Char]
cp [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" arg1 arg2")
    [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" to \n\t\t"
    [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
green ([Char]
"(" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
cp [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" arg1 arg2 :: <Type>)")
    [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"\n\tor add "
    [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"{-# LANGUAGE TypeApplications #-} to the top of your "
    [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"file then change the call to \n\t\t"
    [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
brightGreen ([Char]
cp [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" @<Type> arg1 arg2")

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)
        ]