{-# LANGUAGE CPP #-}
module Seminal.Enumerator.Literals (enumerateChangeInLiteral, enumerateRaiseInLiterals) where
import Seminal.Enumerator.Enumerator (Enumerator)
import Seminal.Compiler.API
import Seminal.Change (Change(..), ChangeType (Terminal), node)
import Data.ByteString (unpack)
import Data.ByteString.Internal (w2c)
import Data.Char (isDigit, digitToInt)
import Text.Read (readMaybe)
import Data.Maybe (mapMaybe)
import Data.Functor ((<&>))
-- | Enumeration of changes for Literals, e.g. hard-coded chars, strings, ints etc.
-- See [API doc](https://hackage.haskell.org/package/ghc-9.6.1/docs/Language-Haskell-Syntax-Lit.html#t:HsLit)
enumerateChangeInLiteral :: Enumerator (HsLit GhcPs)
enumerateChangeInLiteral :: Enumerator (HsLit GhcPs)
enumerateChangeInLiteral HsLit GhcPs
literal SrcSpan
loc = case HsLit GhcPs
literal of
    (HsChar XHsChar GhcPs
_ Char
char) -> Char -> [Change (HsLit GhcPs)]
changeForChar Char
char
    (HsCharPrim XHsCharPrim GhcPs
_ Char
char) -> Char -> [Change (HsLit GhcPs)]
changeForChar Char
char
    (HsString XHsString GhcPs
_ FastString
string) ->
        -- Need to turn FastString to String, for homogeneity
        [Char] -> [Change (HsLit GhcPs)]
changeForString ([Char] -> [Change (HsLit GhcPs)])
-> [Char] -> [Change (HsLit GhcPs)]
forall a b. (a -> b) -> a -> b
$ FastString -> [Char]
unpackFS FastString
string
    (HsStringPrim XHsStringPrim GhcPs
_ ByteString
string) ->
        -- Need to turn ByteString to String, for homogeneity
        [Char] -> [Change (HsLit GhcPs)]
changeForString ([Char] -> [Change (HsLit GhcPs)])
-> [Char] -> [Change (HsLit GhcPs)]
forall a b. (a -> b) -> a -> b
$ Word8 -> Char
w2c (Word8 -> Char) -> [Word8] -> [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> [Word8]
unpack ByteString
string
    HsLit GhcPs
_ -> []
    where
        changeForChar :: Char -> [Change (HsLit GhcPs)]
changeForChar Char
char = (
            ChangeNode (HsLit GhcPs)
-> [ChangeNode (HsLit GhcPs)]
-> SrcSpan
-> [Change (HsLit GhcPs)]
-> [Char]
-> ChangeType
-> Change (HsLit GhcPs)
forall node.
ChangeNode node
-> [ChangeNode node]
-> SrcSpan
-> [Change node]
-> [Char]
-> ChangeType
-> Change node
Change (HsLit GhcPs -> ChangeNode (HsLit GhcPs)
forall n. Outputable n => n -> ChangeNode n
node HsLit GhcPs
literal) [HsLit GhcPs -> ChangeNode (HsLit GhcPs)
forall n. Outputable n => n -> ChangeNode n
node (HsLit GhcPs -> ChangeNode (HsLit GhcPs))
-> HsLit GhcPs -> ChangeNode (HsLit GhcPs)
forall a b. (a -> b) -> a -> b
$ XHsString GhcPs -> FastString -> HsLit GhcPs
forall x. XHsString x -> FastString -> HsLit x
HsString XHsString GhcPs
SourceText
NoSourceText ([Char] -> FastString
mkFastString [Char
char])] SrcSpan
loc []
            [Char]
"The expected type of the expression is a String, not a Char. Use double quotes or brackets instead." ChangeType
Terminal -- Turn into String
            )Change (HsLit GhcPs)
-> [Change (HsLit GhcPs)] -> [Change (HsLit GhcPs)]
forall a. a -> [a] -> [a]
: [(ChangeNode (HsLit GhcPs)
-> [ChangeNode (HsLit GhcPs)]
-> SrcSpan
-> [Change (HsLit GhcPs)]
-> [Char]
-> ChangeType
-> Change (HsLit GhcPs)
forall node.
ChangeNode node
-> [ChangeNode node]
-> SrcSpan
-> [Change node]
-> [Char]
-> ChangeType
-> Change node
Change (HsLit GhcPs -> ChangeNode (HsLit GhcPs)
forall n. Outputable n => n -> ChangeNode n
node HsLit GhcPs
literal) [HsLit GhcPs -> ChangeNode (HsLit GhcPs)
forall n. Outputable n => n -> ChangeNode n
node (Char -> HsLit GhcPs
charToInt Char
char)] SrcSpan
loc [] [Char]
"Expected an Int, not a Char. Remove the quotes" ChangeType
Terminal) | Char -> Bool
isDigit Char
char] -- Turn into Int
        changeForString :: [Char] -> [Change (HsLit GhcPs)]
changeForString [Char
char] = (
            ChangeNode (HsLit GhcPs)
-> [ChangeNode (HsLit GhcPs)]
-> SrcSpan
-> [Change (HsLit GhcPs)]
-> [Char]
-> ChangeType
-> Change (HsLit GhcPs)
forall node.
ChangeNode node
-> [ChangeNode node]
-> SrcSpan
-> [Change node]
-> [Char]
-> ChangeType
-> Change node
Change (HsLit GhcPs -> ChangeNode (HsLit GhcPs)
forall n. Outputable n => n -> ChangeNode n
node HsLit GhcPs
literal) [HsLit GhcPs -> ChangeNode (HsLit GhcPs)
forall n. Outputable n => n -> ChangeNode n
node (HsLit GhcPs -> ChangeNode (HsLit GhcPs))
-> HsLit GhcPs -> ChangeNode (HsLit GhcPs)
forall a b. (a -> b) -> a -> b
$ XHsChar GhcPs -> Char -> HsLit GhcPs
forall x. XHsChar x -> Char -> HsLit x
HsChar XHsChar GhcPs
SourceText
NoSourceText Char
char] SrcSpan
loc []
            [Char]
"The expected type of the expression is a Char, not a String. Use single quotes instead." ChangeType
Terminal -- If Singleton, extract it to char
            )Change (HsLit GhcPs)
-> [Change (HsLit GhcPs)] -> [Change (HsLit GhcPs)]
forall a. a -> [a] -> [a]
: [(ChangeNode (HsLit GhcPs)
-> [ChangeNode (HsLit GhcPs)]
-> SrcSpan
-> [Change (HsLit GhcPs)]
-> [Char]
-> ChangeType
-> Change (HsLit GhcPs)
forall node.
ChangeNode node
-> [ChangeNode node]
-> SrcSpan
-> [Change node]
-> [Char]
-> ChangeType
-> Change node
Change (HsLit GhcPs -> ChangeNode (HsLit GhcPs)
forall n. Outputable n => n -> ChangeNode n
node HsLit GhcPs
literal) [HsLit GhcPs -> ChangeNode (HsLit GhcPs)
forall n. Outputable n => n -> ChangeNode n
node (Char -> HsLit GhcPs
charToInt Char
char)] SrcSpan
loc [] [Char]
"Expected an Int, not a String. Remove the quotes" ChangeType
Terminal) | Char -> Bool
isDigit Char
char]
        changeForString [Char]
str = (([Char] -> Maybe (HsLit GhcPs)) -> Maybe (HsLit GhcPs))
-> [[Char] -> Maybe (HsLit GhcPs)] -> [HsLit GhcPs]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\[Char] -> Maybe (HsLit GhcPs)
x -> [Char] -> Maybe (HsLit GhcPs)
x [Char]
str) [[Char] -> Maybe (HsLit GhcPs)
stringToInteger, [Char] -> Maybe (HsLit GhcPs)
stringToInt, [Char] -> Maybe (HsLit GhcPs)
stringToFloat, [Char] -> Maybe (HsLit GhcPs)
stringToDouble]
            [HsLit GhcPs]
-> (HsLit GhcPs -> Change (HsLit GhcPs)) -> [Change (HsLit GhcPs)]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (\HsLit GhcPs
newNum -> ChangeNode (HsLit GhcPs)
-> [ChangeNode (HsLit GhcPs)]
-> SrcSpan
-> [Change (HsLit GhcPs)]
-> [Char]
-> ChangeType
-> Change (HsLit GhcPs)
forall node.
ChangeNode node
-> [ChangeNode node]
-> SrcSpan
-> [Change node]
-> [Char]
-> ChangeType
-> Change node
Change (HsLit GhcPs -> ChangeNode (HsLit GhcPs)
forall n. Outputable n => n -> ChangeNode n
node HsLit GhcPs
literal) [HsLit GhcPs -> ChangeNode (HsLit GhcPs)
forall n. Outputable n => n -> ChangeNode n
node HsLit GhcPs
newNum] SrcSpan
loc [] [Char]
"Remove the quotes." ChangeType
Terminal)
        charToInt :: Char -> HsLit GhcPs
charToInt = XHsInt GhcPs -> IntegralLit -> HsLit GhcPs
forall x. XHsInt x -> IntegralLit -> HsLit x
HsInt XHsInt GhcPs
NoExtField
NoExtField (IntegralLit -> HsLit GhcPs)
-> (Char -> IntegralLit) -> Char -> HsLit GhcPs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> IntegralLit
forall a. Integral a => a -> IntegralLit
mkIntegralLit (Int -> IntegralLit) -> (Char -> Int) -> Char -> IntegralLit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
digitToInt
        stringToInteger :: String -> Maybe (HsLit GhcPs)
        stringToInteger :: [Char] -> Maybe (HsLit GhcPs)
stringToInteger [Char]
str = (\Integer
x -> XHsInteger GhcPs -> Integer -> Type -> HsLit GhcPs
forall x. XHsInteger x -> Integer -> Type -> HsLit x
HsInteger XHsInteger GhcPs
SourceText
NoSourceText Integer
x Type
integerTy) (Integer -> HsLit GhcPs) -> Maybe Integer -> Maybe (HsLit GhcPs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Char] -> Maybe Integer
forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
str :: Maybe Integer)
        stringToInt :: String -> Maybe (HsLit GhcPs)
        stringToInt :: [Char] -> Maybe (HsLit GhcPs)
stringToInt [Char]
str = (XHsInt GhcPs -> IntegralLit -> HsLit GhcPs
forall x. XHsInt x -> IntegralLit -> HsLit x
HsInt XHsInt GhcPs
NoExtField
NoExtField (IntegralLit -> HsLit GhcPs)
-> (Int -> IntegralLit) -> Int -> HsLit GhcPs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> IntegralLit
forall a. Integral a => a -> IntegralLit
mkIntegralLit) (Int -> HsLit GhcPs) -> Maybe Int -> Maybe (HsLit GhcPs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Char] -> Maybe Int
forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
str :: Maybe Int)
        stringToDouble :: String -> Maybe (HsLit GhcPs)
        stringToDouble :: [Char] -> Maybe (HsLit GhcPs)
stringToDouble [Char]
str = (XHsDoublePrim GhcPs -> FractionalLit -> HsLit GhcPs
forall x. XHsDoublePrim x -> FractionalLit -> HsLit x
HsDoublePrim XHsDoublePrim GhcPs
NoExtField
NoExtField (FractionalLit -> HsLit GhcPs)
-> (Double -> FractionalLit) -> Double -> HsLit GhcPs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> FractionalLit
mkTHFractionalLit (Rational -> FractionalLit)
-> (Double -> Rational) -> Double -> FractionalLit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Rational
forall a. Real a => a -> Rational
toRational) (Double -> HsLit GhcPs) -> Maybe Double -> Maybe (HsLit GhcPs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Char] -> Maybe Double
forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
str :: Maybe Double)
        stringToFloat :: String -> Maybe (HsLit GhcPs)
        stringToFloat :: [Char] -> Maybe (HsLit GhcPs)
stringToFloat [Char]
str = (XHsFloatPrim GhcPs -> FractionalLit -> HsLit GhcPs
forall x. XHsFloatPrim x -> FractionalLit -> HsLit x
HsFloatPrim XHsFloatPrim GhcPs
NoExtField
NoExtField (FractionalLit -> HsLit GhcPs)
-> (Float -> FractionalLit) -> Float -> HsLit GhcPs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> FractionalLit
mkTHFractionalLit (Rational -> FractionalLit)
-> (Float -> Rational) -> Float -> FractionalLit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Rational
forall a. Real a => a -> Rational
toRational) (Float -> HsLit GhcPs) -> Maybe Float -> Maybe (HsLit GhcPs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Char] -> Maybe Float
forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
str :: Maybe Float)

-- | Enumerate changes that could be done, involving turning a literal into an overloaded literal
enumerateRaiseInLiterals :: Enumerator (HsExpr GhcPs)
enumerateRaiseInLiterals :: Enumerator (HsExpr GhcPs)
enumerateRaiseInLiterals HsExpr GhcPs
expr SrcSpan
loc  = case HsExpr GhcPs
expr of
    (HsLit XLitE GhcPs
x HsLit GhcPs
lit) -> case HsLit GhcPs
lit of
        (HsString XHsString GhcPs
_ FastString
string) -> [Char] -> [Change (HsExpr GhcPs)]
changeForString ([Char] -> [Change (HsExpr GhcPs)])
-> [Char] -> [Change (HsExpr GhcPs)]
forall a b. (a -> b) -> a -> b
$ FastString -> [Char]
unpackFS FastString
string
        (HsStringPrim XHsStringPrim GhcPs
_ ByteString
string) -> [Char] -> [Change (HsExpr GhcPs)]
changeForString ([Char] -> [Change (HsExpr GhcPs)])
-> [Char] -> [Change (HsExpr GhcPs)]
forall a b. (a -> b) -> a -> b
$ Word8 -> Char
w2c (Word8 -> Char) -> [Word8] -> [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> [Word8]
unpack ByteString
string
        HsLit GhcPs
_ -> []
        where
            changeForString :: [Char] -> [Change (HsExpr GhcPs)]
changeForString [Char]
s = OverLitVal -> HsOverLit GhcPs
overLitValToLit (OverLitVal -> HsOverLit GhcPs)
-> [OverLitVal] -> [HsOverLit GhcPs]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (([Char] -> Maybe OverLitVal) -> Maybe OverLitVal)
-> [[Char] -> Maybe OverLitVal] -> [OverLitVal]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\[Char] -> Maybe OverLitVal
f -> [Char] -> Maybe OverLitVal
f [Char]
s) [[Char] -> Maybe OverLitVal
stringToDouble]
                [HsOverLit GhcPs]
-> (HsOverLit GhcPs -> Change (HsExpr GhcPs))
-> [Change (HsExpr GhcPs)]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (\HsOverLit GhcPs
newLit -> ChangeNode (HsExpr GhcPs)
-> [ChangeNode (HsExpr GhcPs)]
-> SrcSpan
-> [Change (HsExpr GhcPs)]
-> [Char]
-> ChangeType
-> Change (HsExpr GhcPs)
forall node.
ChangeNode node
-> [ChangeNode node]
-> SrcSpan
-> [Change node]
-> [Char]
-> ChangeType
-> Change node
Change (HsExpr GhcPs -> ChangeNode (HsExpr GhcPs)
forall n. Outputable n => n -> ChangeNode n
node HsExpr GhcPs
expr) [HsExpr GhcPs -> ChangeNode (HsExpr GhcPs)
forall n. Outputable n => n -> ChangeNode n
node (HsExpr GhcPs -> ChangeNode (HsExpr GhcPs))
-> HsExpr GhcPs -> ChangeNode (HsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ XOverLitE GhcPs -> HsOverLit GhcPs -> HsExpr GhcPs
forall p. XOverLitE p -> HsOverLit p -> HsExpr p
HsOverLit XLitE GhcPs
XOverLitE GhcPs
x HsOverLit GhcPs
newLit] SrcSpan
loc [] [Char]
"Remove the quotes" ChangeType
Terminal)
            stringToDouble :: [Char] -> Maybe OverLitVal
stringToDouble [Char]
str = Double -> OverLitVal
nbToOverLitVal (Double -> OverLitVal) -> Maybe Double -> Maybe OverLitVal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Char] -> Maybe Double
forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
str :: Maybe Double)
#if MIN_VERSION_ghc(9,4,1)
            overLitValToLit :: OverLitVal -> HsOverLit GhcPs
overLitValToLit = XOverLit GhcPs -> OverLitVal -> HsOverLit GhcPs
forall p. XOverLit p -> OverLitVal -> HsOverLit p
OverLit XOverLit GhcPs
NoExtField
NoExtField
#else
            overLitValToLit ol = OverLit NoExtField ol expr
#endif  
            nbToOverLitVal :: Double -> OverLitVal
nbToOverLitVal = FractionalLit -> OverLitVal
HsFractional (FractionalLit -> OverLitVal)
-> (Double -> FractionalLit) -> Double -> OverLitVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> FractionalLit
mkTHFractionalLit (Rational -> FractionalLit)
-> (Double -> Rational) -> Double -> FractionalLit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Rational
forall a. Real a => a -> Rational
toRational
    HsExpr GhcPs
_ -> []