{-# 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 Data.Either
import DataFrame.Display.Terminal.Colours
import Data.Typeable (Typeable)
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
    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 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

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)

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

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]
" ...")
    [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]
" ... :: <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> ....")

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