{-# LANGUAGE DeriveGeneric    #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ViewPatterns     #-}
module Ide.Plugin.Conversion (
    alternateFormat
    , hexRegex
    , hexFloatRegex
    , binaryRegex
    , octalRegex
    , decimalRegex
    , numDecimalRegex
    , matchLineRegex
    , toOctal
    , toDecimal
    , toBinary
    , toHex
    , toFloatDecimal
    , toFloatExpDecimal
    , toHexFloat
    , AlternateFormat
    , ExtensionNeeded(..)
) where

import           Data.Char                     (toUpper)
import           Data.List                     (delete)
import           Data.Maybe                    (mapMaybe)
import           Data.Ratio                    (denominator, numerator)
import           Data.Text                     (Text)
import qualified Data.Text                     as T
import           Development.IDE.Graph.Classes (NFData)
import           GHC.Generics                  (Generic)
import           GHC.LanguageExtensions.Type   (Extension (..))
import           GHC.Show                      (intToDigit)
import           Ide.Plugin.Literals           (Literal (..), getSrcText)
import           Numeric
import           Text.Regex.TDFA               ((=~))

data FormatType = IntFormat IntFormatType
                | FracFormat FracFormatType
                | NoFormat
                deriving (Int -> FormatType -> ShowS
[FormatType] -> ShowS
FormatType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FormatType] -> ShowS
$cshowList :: [FormatType] -> ShowS
show :: FormatType -> String
$cshow :: FormatType -> String
showsPrec :: Int -> FormatType -> ShowS
$cshowsPrec :: Int -> FormatType -> ShowS
Show, FormatType -> FormatType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FormatType -> FormatType -> Bool
$c/= :: FormatType -> FormatType -> Bool
== :: FormatType -> FormatType -> Bool
$c== :: FormatType -> FormatType -> Bool
Eq, forall x. Rep FormatType x -> FormatType
forall x. FormatType -> Rep FormatType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FormatType x -> FormatType
$cfrom :: forall x. FormatType -> Rep FormatType x
Generic)

instance NFData FormatType

data IntFormatType = IntDecimalFormat
                   | HexFormat
                   | OctalFormat
                   | BinaryFormat
                   | NumDecimalFormat
                   deriving (Int -> IntFormatType -> ShowS
[IntFormatType] -> ShowS
IntFormatType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IntFormatType] -> ShowS
$cshowList :: [IntFormatType] -> ShowS
show :: IntFormatType -> String
$cshow :: IntFormatType -> String
showsPrec :: Int -> IntFormatType -> ShowS
$cshowsPrec :: Int -> IntFormatType -> ShowS
Show, IntFormatType -> IntFormatType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IntFormatType -> IntFormatType -> Bool
$c/= :: IntFormatType -> IntFormatType -> Bool
== :: IntFormatType -> IntFormatType -> Bool
$c== :: IntFormatType -> IntFormatType -> Bool
Eq, forall x. Rep IntFormatType x -> IntFormatType
forall x. IntFormatType -> Rep IntFormatType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep IntFormatType x -> IntFormatType
$cfrom :: forall x. IntFormatType -> Rep IntFormatType x
Generic, IntFormatType
forall a. a -> a -> Bounded a
maxBound :: IntFormatType
$cmaxBound :: IntFormatType
minBound :: IntFormatType
$cminBound :: IntFormatType
Bounded, Int -> IntFormatType
IntFormatType -> Int
IntFormatType -> [IntFormatType]
IntFormatType -> IntFormatType
IntFormatType -> IntFormatType -> [IntFormatType]
IntFormatType -> IntFormatType -> IntFormatType -> [IntFormatType]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: IntFormatType -> IntFormatType -> IntFormatType -> [IntFormatType]
$cenumFromThenTo :: IntFormatType -> IntFormatType -> IntFormatType -> [IntFormatType]
enumFromTo :: IntFormatType -> IntFormatType -> [IntFormatType]
$cenumFromTo :: IntFormatType -> IntFormatType -> [IntFormatType]
enumFromThen :: IntFormatType -> IntFormatType -> [IntFormatType]
$cenumFromThen :: IntFormatType -> IntFormatType -> [IntFormatType]
enumFrom :: IntFormatType -> [IntFormatType]
$cenumFrom :: IntFormatType -> [IntFormatType]
fromEnum :: IntFormatType -> Int
$cfromEnum :: IntFormatType -> Int
toEnum :: Int -> IntFormatType
$ctoEnum :: Int -> IntFormatType
pred :: IntFormatType -> IntFormatType
$cpred :: IntFormatType -> IntFormatType
succ :: IntFormatType -> IntFormatType
$csucc :: IntFormatType -> IntFormatType
Enum)

instance NFData IntFormatType

data FracFormatType = FracDecimalFormat
                    | HexFloatFormat
                    | ExponentFormat
                    deriving (Int -> FracFormatType -> ShowS
[FracFormatType] -> ShowS
FracFormatType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FracFormatType] -> ShowS
$cshowList :: [FracFormatType] -> ShowS
show :: FracFormatType -> String
$cshow :: FracFormatType -> String
showsPrec :: Int -> FracFormatType -> ShowS
$cshowsPrec :: Int -> FracFormatType -> ShowS
Show, FracFormatType -> FracFormatType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FracFormatType -> FracFormatType -> Bool
$c/= :: FracFormatType -> FracFormatType -> Bool
== :: FracFormatType -> FracFormatType -> Bool
$c== :: FracFormatType -> FracFormatType -> Bool
Eq, forall x. Rep FracFormatType x -> FracFormatType
forall x. FracFormatType -> Rep FracFormatType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FracFormatType x -> FracFormatType
$cfrom :: forall x. FracFormatType -> Rep FracFormatType x
Generic, FracFormatType
forall a. a -> a -> Bounded a
maxBound :: FracFormatType
$cmaxBound :: FracFormatType
minBound :: FracFormatType
$cminBound :: FracFormatType
Bounded, Int -> FracFormatType
FracFormatType -> Int
FracFormatType -> [FracFormatType]
FracFormatType -> FracFormatType
FracFormatType -> FracFormatType -> [FracFormatType]
FracFormatType
-> FracFormatType -> FracFormatType -> [FracFormatType]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: FracFormatType
-> FracFormatType -> FracFormatType -> [FracFormatType]
$cenumFromThenTo :: FracFormatType
-> FracFormatType -> FracFormatType -> [FracFormatType]
enumFromTo :: FracFormatType -> FracFormatType -> [FracFormatType]
$cenumFromTo :: FracFormatType -> FracFormatType -> [FracFormatType]
enumFromThen :: FracFormatType -> FracFormatType -> [FracFormatType]
$cenumFromThen :: FracFormatType -> FracFormatType -> [FracFormatType]
enumFrom :: FracFormatType -> [FracFormatType]
$cenumFrom :: FracFormatType -> [FracFormatType]
fromEnum :: FracFormatType -> Int
$cfromEnum :: FracFormatType -> Int
toEnum :: Int -> FracFormatType
$ctoEnum :: Int -> FracFormatType
pred :: FracFormatType -> FracFormatType
$cpred :: FracFormatType -> FracFormatType
succ :: FracFormatType -> FracFormatType
$csucc :: FracFormatType -> FracFormatType
Enum)

instance NFData FracFormatType

data ExtensionNeeded = NoExtension
                     | NeedsExtension Extension

type AlternateFormat = (Text, ExtensionNeeded)

-- | Generate alternate formats for a single Literal based on FormatType's given.
alternateFormat :: Literal -> [AlternateFormat]
alternateFormat :: Literal -> [AlternateFormat]
alternateFormat Literal
lit = case Literal
lit of
  IntLiteral LiteralSrcSpan
_ Text
_ Integer
val   -> forall a b. (a -> b) -> [a] -> [b]
map (Integer -> IntFormatType -> AlternateFormat
alternateIntFormat Integer
val) (Literal -> [IntFormatType]
removeCurrentFormatInt Literal
lit)
  FracLiteral LiteralSrcSpan
_ Text
_  Rational
val -> if forall a. Ratio a -> a
denominator Rational
val forall a. Eq a => a -> a -> Bool
== Integer
1 -- floats that can be integers we can represent as ints
      then forall a b. (a -> b) -> [a] -> [b]
map (Integer -> IntFormatType -> AlternateFormat
alternateIntFormat (forall a. Ratio a -> a
numerator Rational
val)) (Literal -> [IntFormatType]
removeCurrentFormatInt Literal
lit)
      else forall a b. (a -> b) -> [a] -> [b]
map (Rational -> FracFormatType -> AlternateFormat
alternateFracFormat Rational
val) (Literal -> [FracFormatType]
removeCurrentFormatFrac Literal
lit)

alternateIntFormat :: Integer -> IntFormatType -> AlternateFormat
alternateIntFormat :: Integer -> IntFormatType -> AlternateFormat
alternateIntFormat Integer
val = \case
    IntFormatType
IntDecimalFormat -> (String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Integral a => a -> String
toDecimal Integer
val, ExtensionNeeded
NoExtension)
    IntFormatType
HexFormat        -> (String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. (Integral a, Show a) => a -> String
toHex Integer
val, ExtensionNeeded
NoExtension)
    IntFormatType
OctalFormat      -> (String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. (Integral a, Show a) => a -> String
toOctal Integer
val, ExtensionNeeded
NoExtension)
    IntFormatType
BinaryFormat     -> (String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. (Integral a, Show a) => a -> String
toBinary Integer
val, Extension -> ExtensionNeeded
NeedsExtension Extension
BinaryLiterals)
    IntFormatType
NumDecimalFormat -> (String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. RealFloat a => a -> String
toFloatExpDecimal (forall a. Num a => Integer -> a
fromInteger @Double Integer
val), Extension -> ExtensionNeeded
NeedsExtension Extension
NumDecimals)

alternateFracFormat :: Rational -> FracFormatType -> AlternateFormat
alternateFracFormat :: Rational -> FracFormatType -> AlternateFormat
alternateFracFormat Rational
val = \case
  FracFormatType
FracDecimalFormat -> (String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. RealFloat a => a -> String
toFloatDecimal (forall a. Fractional a => Rational -> a
fromRational @Double Rational
val), ExtensionNeeded
NoExtension)
  FracFormatType
ExponentFormat    -> (String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. RealFloat a => a -> String
toFloatExpDecimal (forall a. Fractional a => Rational -> a
fromRational @Double Rational
val), ExtensionNeeded
NoExtension)
  FracFormatType
HexFloatFormat    -> (String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. RealFloat a => a -> String
toHexFloat (forall a. Fractional a => Rational -> a
fromRational @Double Rational
val), Extension -> ExtensionNeeded
NeedsExtension Extension
HexFloatLiterals)

-- given a Literal compute it's current Format and delete it from the list of available formats
removeCurrentFormat :: (Foldable t, Eq a) => [a] -> t a -> [a]
removeCurrentFormat :: forall (t :: * -> *) a. (Foldable t, Eq a) => [a] -> t a -> [a]
removeCurrentFormat [a]
fmts t a
toRemove = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Eq a => a -> [a] -> [a]
delete) [a]
fmts t a
toRemove

removeCurrentFormatInt :: Literal -> [IntFormatType]
removeCurrentFormatInt :: Literal -> [IntFormatType]
removeCurrentFormatInt (Literal -> Text
getSrcText -> Text
srcText) = forall (t :: * -> *) a. (Foldable t, Eq a) => [a] -> t a -> [a]
removeCurrentFormat [IntFormatType]
intFormats ([FormatType] -> [IntFormatType]
filterIntFormats forall a b. (a -> b) -> a -> b
$ Text -> [FormatType]
sourceToFormatType Text
srcText)

removeCurrentFormatFrac :: Literal -> [FracFormatType]
removeCurrentFormatFrac :: Literal -> [FracFormatType]
removeCurrentFormatFrac (Literal -> Text
getSrcText -> Text
srcText) = forall (t :: * -> *) a. (Foldable t, Eq a) => [a] -> t a -> [a]
removeCurrentFormat [FracFormatType]
fracFormats ([FormatType] -> [FracFormatType]
filterFracFormats forall a b. (a -> b) -> a -> b
$ Text -> [FormatType]
sourceToFormatType Text
srcText)

filterIntFormats :: [FormatType] -> [IntFormatType]
filterIntFormats :: [FormatType] -> [IntFormatType]
filterIntFormats = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe FormatType -> Maybe IntFormatType
getIntFormat
    where
        getIntFormat :: FormatType -> Maybe IntFormatType
getIntFormat (IntFormat IntFormatType
f) = forall a. a -> Maybe a
Just IntFormatType
f
        getIntFormat FormatType
_             = forall a. Maybe a
Nothing

filterFracFormats :: [FormatType] -> [FracFormatType]
filterFracFormats :: [FormatType] -> [FracFormatType]
filterFracFormats = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe FormatType -> Maybe FracFormatType
getFracFormat
    where
        getFracFormat :: FormatType -> Maybe FracFormatType
getFracFormat (FracFormat FracFormatType
f) = forall a. a -> Maybe a
Just FracFormatType
f
        getFracFormat FormatType
_              = forall a. Maybe a
Nothing

intFormats :: [IntFormatType]
intFormats :: [IntFormatType]
intFormats = [forall a. Bounded a => a
minBound .. forall a. Bounded a => a
maxBound]

fracFormats :: [FracFormatType]
fracFormats :: [FracFormatType]
fracFormats = [forall a. Bounded a => a
minBound .. forall a. Bounded a => a
maxBound]

-- | Regex to match a Haskell Hex Literal
hexRegex :: Text
hexRegex :: Text
hexRegex = Text
"0[xX][a-fA-F0-9]+"

-- | Regex to match a Haskell Hex Float Literal
hexFloatRegex :: Text
hexFloatRegex :: Text
hexFloatRegex = Text
"0[xX][a-fA-F0-9]+(\\.)?[a-fA-F0-9]*(p[+-]?[0-9]+)?"

-- | Regex to match a Haskell Binary Literal
binaryRegex :: Text
binaryRegex :: Text
binaryRegex = Text
"0[bB][0|1]+"

-- | Regex to match a Haskell Octal Literal
octalRegex :: Text
octalRegex :: Text
octalRegex = Text
"0[oO][0-8]+"

-- | Regex to match a Haskell Decimal Literal (no decimal points)
decimalRegex :: Text
decimalRegex :: Text
decimalRegex = Text
"[0-9]+(\\.[0-9]+)?"

-- | Regex to match a Haskell Literal with an explicit exponent
numDecimalRegex :: Text
numDecimalRegex :: Text
numDecimalRegex = Text
"[0-9]+\\.[0-9]+[eE][+-]?[0-9]+"

-- we want to be explicit in our matches
-- so we need to match the beginning/end of the source text
-- | Wraps a Regex with a beginning ("^") and end ("$") token
matchLineRegex :: Text -> Text
matchLineRegex :: Text -> Text
matchLineRegex Text
regex = Text
"^" forall a. Semigroup a => a -> a -> a
<> Text
regex forall a. Semigroup a => a -> a -> a
<> Text
"$"

sourceToFormatType :: Text -> [FormatType]
sourceToFormatType :: Text -> [FormatType]
sourceToFormatType Text
srcText
    | Text
srcText forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~ Text -> Text
matchLineRegex Text
hexRegex = [IntFormatType -> FormatType
IntFormat IntFormatType
HexFormat]
    | Text
srcText forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~ Text -> Text
matchLineRegex Text
hexFloatRegex = [FracFormatType -> FormatType
FracFormat FracFormatType
HexFloatFormat]
    | Text
srcText forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~ Text -> Text
matchLineRegex Text
octalRegex = [IntFormatType -> FormatType
IntFormat IntFormatType
OctalFormat]
    | Text
srcText forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~ Text -> Text
matchLineRegex Text
binaryRegex = [IntFormatType -> FormatType
IntFormat IntFormatType
BinaryFormat]
    -- can either be a NumDecimal or just a regular Fractional with an exponent
    -- otherwise we wouldn't need to return a list
    | Text
srcText forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~ Text -> Text
matchLineRegex Text
numDecimalRegex  = [IntFormatType -> FormatType
IntFormat IntFormatType
NumDecimalFormat, FracFormatType -> FormatType
FracFormat FracFormatType
ExponentFormat]
    -- just assume we are in base 10 with no decimals
    | Bool
otherwise = [IntFormatType -> FormatType
IntFormat IntFormatType
IntDecimalFormat, FracFormatType -> FormatType
FracFormat FracFormatType
FracDecimalFormat]

toBase :: (Num a, Ord a) => (a -> ShowS) -> String -> a -> String
toBase :: forall a. (Num a, Ord a) => (a -> ShowS) -> String -> a -> String
toBase a -> ShowS
conv String
header a
n
  | a
n forall a. Ord a => a -> a -> Bool
< a
0 = Char
'-' forall a. a -> [a] -> [a]
: String
header forall a. Semigroup a => a -> a -> a
<> forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper (a -> ShowS
conv (forall a. Num a => a -> a
abs a
n) String
"")
  | Bool
otherwise = String
header forall a. Semigroup a => a -> a -> a
<> forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper (a -> ShowS
conv a
n String
"")

toOctal :: (Integral a, Show a) => a -> String
toOctal :: forall a. (Integral a, Show a) => a -> String
toOctal = forall a. (Num a, Ord a) => (a -> ShowS) -> String -> a -> String
toBase forall a. (Integral a, Show a) => a -> ShowS
showOct String
"0o"

toDecimal :: Integral a => a -> String
toDecimal :: forall a. Integral a => a -> String
toDecimal = forall a. (Num a, Ord a) => (a -> ShowS) -> String -> a -> String
toBase forall a. Integral a => a -> ShowS
showInt String
""

toBinary :: (Integral a, Show a) => a -> String
toBinary :: forall a. (Integral a, Show a) => a -> String
toBinary = forall a. (Num a, Ord a) => (a -> ShowS) -> String -> a -> String
toBase a -> ShowS
showBin String
"0b"
  where
    -- this is not defined in versions of Base < 4.16-ish
    showBin :: a -> ShowS
showBin = forall a. (Integral a, Show a) => a -> (Int -> Char) -> a -> ShowS
showIntAtBase a
2 Int -> Char
intToDigit

toHex :: (Integral a, Show a) => a  -> String
toHex :: forall a. (Integral a, Show a) => a -> String
toHex = forall a. (Num a, Ord a) => (a -> ShowS) -> String -> a -> String
toBase forall a. (Integral a, Show a) => a -> ShowS
showHex String
"0x"

toFloatDecimal :: RealFloat a => a -> String
toFloatDecimal :: forall a. RealFloat a => a -> String
toFloatDecimal a
val = forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat forall a. Maybe a
Nothing a
val String
""

toFloatExpDecimal :: RealFloat a => a -> String
toFloatExpDecimal :: forall a. RealFloat a => a -> String
toFloatExpDecimal a
val = forall a. RealFloat a => Maybe Int -> a -> ShowS
showEFloat forall a. Maybe a
Nothing a
val String
""

toHexFloat :: RealFloat a => a -> String
toHexFloat :: forall a. RealFloat a => a -> String
toHexFloat a
val = forall a. RealFloat a => a -> ShowS
showHFloat a
val String
""