{-# LANGUAGE CPP                #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric      #-}
{-# LANGUAGE FlexibleInstances  #-}
{-# LANGUAGE RankNTypes         #-}
{-# LANGUAGE ViewPatterns       #-}
module Ide.Plugin.Literals (
    collectLiterals
    , Literal(..)
    , getSrcText
    , getSrcSpan
) where

import           Data.Maybe                    (maybeToList)
import           Data.Text                     (Text)
import qualified Data.Text                     as T
import           Development.IDE.GHC.Compat    hiding (getSrcSpan)
import           Development.IDE.Graph.Classes (NFData (rnf))
import qualified GHC.Generics                  as GHC
import           Generics.SYB                  (Data, Typeable, everything,
                                                extQ)

-- data type to capture what type of literal we are dealing with
-- provides location and possibly source text (for OverLits) as well as it's value
-- we currently don't have any use for PrimLiterals. They never have source text so we always drop them
-- | Captures a Numeric Literals Location, Source Text, and Value.
data Literal = IntLiteral  LiteralSrcSpan Text Integer
             | FracLiteral LiteralSrcSpan Text Rational
             deriving ((forall x. Literal -> Rep Literal x)
-> (forall x. Rep Literal x -> Literal) -> Generic Literal
forall x. Rep Literal x -> Literal
forall x. Literal -> Rep Literal x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Literal x -> Literal
$cfrom :: forall x. Literal -> Rep Literal x
GHC.Generic, Int -> Literal -> ShowS
[Literal] -> ShowS
Literal -> String
(Int -> Literal -> ShowS)
-> (Literal -> String) -> ([Literal] -> ShowS) -> Show Literal
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Literal] -> ShowS
$cshowList :: [Literal] -> ShowS
show :: Literal -> String
$cshow :: Literal -> String
showsPrec :: Int -> Literal -> ShowS
$cshowsPrec :: Int -> Literal -> ShowS
Show, Eq Literal
Eq Literal
-> (Literal -> Literal -> Ordering)
-> (Literal -> Literal -> Bool)
-> (Literal -> Literal -> Bool)
-> (Literal -> Literal -> Bool)
-> (Literal -> Literal -> Bool)
-> (Literal -> Literal -> Literal)
-> (Literal -> Literal -> Literal)
-> Ord Literal
Literal -> Literal -> Bool
Literal -> Literal -> Ordering
Literal -> Literal -> Literal
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Literal -> Literal -> Literal
$cmin :: Literal -> Literal -> Literal
max :: Literal -> Literal -> Literal
$cmax :: Literal -> Literal -> Literal
>= :: Literal -> Literal -> Bool
$c>= :: Literal -> Literal -> Bool
> :: Literal -> Literal -> Bool
$c> :: Literal -> Literal -> Bool
<= :: Literal -> Literal -> Bool
$c<= :: Literal -> Literal -> Bool
< :: Literal -> Literal -> Bool
$c< :: Literal -> Literal -> Bool
compare :: Literal -> Literal -> Ordering
$ccompare :: Literal -> Literal -> Ordering
$cp1Ord :: Eq Literal
Ord, Literal -> Literal -> Bool
(Literal -> Literal -> Bool)
-> (Literal -> Literal -> Bool) -> Eq Literal
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Literal -> Literal -> Bool
$c/= :: Literal -> Literal -> Bool
== :: Literal -> Literal -> Bool
$c== :: Literal -> Literal -> Bool
Eq, Typeable Literal
DataType
Constr
Typeable Literal
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Literal -> c Literal)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Literal)
-> (Literal -> Constr)
-> (Literal -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Literal))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Literal))
-> ((forall b. Data b => b -> b) -> Literal -> Literal)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Literal -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Literal -> r)
-> (forall u. (forall d. Data d => d -> u) -> Literal -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Literal -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Literal -> m Literal)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Literal -> m Literal)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Literal -> m Literal)
-> Data Literal
Literal -> DataType
Literal -> Constr
(forall b. Data b => b -> b) -> Literal -> Literal
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Literal -> c Literal
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Literal
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Literal -> u
forall u. (forall d. Data d => d -> u) -> Literal -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Literal -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Literal -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Literal -> m Literal
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Literal -> m Literal
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Literal
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Literal -> c Literal
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Literal)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Literal)
$cFracLiteral :: Constr
$cIntLiteral :: Constr
$tLiteral :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Literal -> m Literal
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Literal -> m Literal
gmapMp :: (forall d. Data d => d -> m d) -> Literal -> m Literal
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Literal -> m Literal
gmapM :: (forall d. Data d => d -> m d) -> Literal -> m Literal
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Literal -> m Literal
gmapQi :: Int -> (forall d. Data d => d -> u) -> Literal -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Literal -> u
gmapQ :: (forall d. Data d => d -> u) -> Literal -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Literal -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Literal -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Literal -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Literal -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Literal -> r
gmapT :: (forall b. Data b => b -> b) -> Literal -> Literal
$cgmapT :: (forall b. Data b => b -> b) -> Literal -> Literal
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Literal)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Literal)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Literal)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Literal)
dataTypeOf :: Literal -> DataType
$cdataTypeOf :: Literal -> DataType
toConstr :: Literal -> Constr
$ctoConstr :: Literal -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Literal
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Literal
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Literal -> c Literal
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Literal -> c Literal
$cp1Data :: Typeable Literal
Data)

newtype LiteralSrcSpan = LiteralSrcSpan { LiteralSrcSpan -> RealSrcSpan
unLit :: RealSrcSpan }
                        deriving ((forall x. LiteralSrcSpan -> Rep LiteralSrcSpan x)
-> (forall x. Rep LiteralSrcSpan x -> LiteralSrcSpan)
-> Generic LiteralSrcSpan
forall x. Rep LiteralSrcSpan x -> LiteralSrcSpan
forall x. LiteralSrcSpan -> Rep LiteralSrcSpan x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LiteralSrcSpan x -> LiteralSrcSpan
$cfrom :: forall x. LiteralSrcSpan -> Rep LiteralSrcSpan x
GHC.Generic, Int -> LiteralSrcSpan -> ShowS
[LiteralSrcSpan] -> ShowS
LiteralSrcSpan -> String
(Int -> LiteralSrcSpan -> ShowS)
-> (LiteralSrcSpan -> String)
-> ([LiteralSrcSpan] -> ShowS)
-> Show LiteralSrcSpan
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LiteralSrcSpan] -> ShowS
$cshowList :: [LiteralSrcSpan] -> ShowS
show :: LiteralSrcSpan -> String
$cshow :: LiteralSrcSpan -> String
showsPrec :: Int -> LiteralSrcSpan -> ShowS
$cshowsPrec :: Int -> LiteralSrcSpan -> ShowS
Show, Eq LiteralSrcSpan
Eq LiteralSrcSpan
-> (LiteralSrcSpan -> LiteralSrcSpan -> Ordering)
-> (LiteralSrcSpan -> LiteralSrcSpan -> Bool)
-> (LiteralSrcSpan -> LiteralSrcSpan -> Bool)
-> (LiteralSrcSpan -> LiteralSrcSpan -> Bool)
-> (LiteralSrcSpan -> LiteralSrcSpan -> Bool)
-> (LiteralSrcSpan -> LiteralSrcSpan -> LiteralSrcSpan)
-> (LiteralSrcSpan -> LiteralSrcSpan -> LiteralSrcSpan)
-> Ord LiteralSrcSpan
LiteralSrcSpan -> LiteralSrcSpan -> Bool
LiteralSrcSpan -> LiteralSrcSpan -> Ordering
LiteralSrcSpan -> LiteralSrcSpan -> LiteralSrcSpan
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: LiteralSrcSpan -> LiteralSrcSpan -> LiteralSrcSpan
$cmin :: LiteralSrcSpan -> LiteralSrcSpan -> LiteralSrcSpan
max :: LiteralSrcSpan -> LiteralSrcSpan -> LiteralSrcSpan
$cmax :: LiteralSrcSpan -> LiteralSrcSpan -> LiteralSrcSpan
>= :: LiteralSrcSpan -> LiteralSrcSpan -> Bool
$c>= :: LiteralSrcSpan -> LiteralSrcSpan -> Bool
> :: LiteralSrcSpan -> LiteralSrcSpan -> Bool
$c> :: LiteralSrcSpan -> LiteralSrcSpan -> Bool
<= :: LiteralSrcSpan -> LiteralSrcSpan -> Bool
$c<= :: LiteralSrcSpan -> LiteralSrcSpan -> Bool
< :: LiteralSrcSpan -> LiteralSrcSpan -> Bool
$c< :: LiteralSrcSpan -> LiteralSrcSpan -> Bool
compare :: LiteralSrcSpan -> LiteralSrcSpan -> Ordering
$ccompare :: LiteralSrcSpan -> LiteralSrcSpan -> Ordering
$cp1Ord :: Eq LiteralSrcSpan
Ord, LiteralSrcSpan -> LiteralSrcSpan -> Bool
(LiteralSrcSpan -> LiteralSrcSpan -> Bool)
-> (LiteralSrcSpan -> LiteralSrcSpan -> Bool) -> Eq LiteralSrcSpan
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LiteralSrcSpan -> LiteralSrcSpan -> Bool
$c/= :: LiteralSrcSpan -> LiteralSrcSpan -> Bool
== :: LiteralSrcSpan -> LiteralSrcSpan -> Bool
$c== :: LiteralSrcSpan -> LiteralSrcSpan -> Bool
Eq, Typeable LiteralSrcSpan
DataType
Constr
Typeable LiteralSrcSpan
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> LiteralSrcSpan -> c LiteralSrcSpan)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c LiteralSrcSpan)
-> (LiteralSrcSpan -> Constr)
-> (LiteralSrcSpan -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c LiteralSrcSpan))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c LiteralSrcSpan))
-> ((forall b. Data b => b -> b)
    -> LiteralSrcSpan -> LiteralSrcSpan)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> LiteralSrcSpan -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> LiteralSrcSpan -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> LiteralSrcSpan -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> LiteralSrcSpan -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> LiteralSrcSpan -> m LiteralSrcSpan)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> LiteralSrcSpan -> m LiteralSrcSpan)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> LiteralSrcSpan -> m LiteralSrcSpan)
-> Data LiteralSrcSpan
LiteralSrcSpan -> DataType
LiteralSrcSpan -> Constr
(forall b. Data b => b -> b) -> LiteralSrcSpan -> LiteralSrcSpan
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LiteralSrcSpan -> c LiteralSrcSpan
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LiteralSrcSpan
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> LiteralSrcSpan -> u
forall u. (forall d. Data d => d -> u) -> LiteralSrcSpan -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LiteralSrcSpan -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LiteralSrcSpan -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> LiteralSrcSpan -> m LiteralSrcSpan
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> LiteralSrcSpan -> m LiteralSrcSpan
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LiteralSrcSpan
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LiteralSrcSpan -> c LiteralSrcSpan
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c LiteralSrcSpan)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c LiteralSrcSpan)
$cLiteralSrcSpan :: Constr
$tLiteralSrcSpan :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> LiteralSrcSpan -> m LiteralSrcSpan
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> LiteralSrcSpan -> m LiteralSrcSpan
gmapMp :: (forall d. Data d => d -> m d)
-> LiteralSrcSpan -> m LiteralSrcSpan
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> LiteralSrcSpan -> m LiteralSrcSpan
gmapM :: (forall d. Data d => d -> m d)
-> LiteralSrcSpan -> m LiteralSrcSpan
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> LiteralSrcSpan -> m LiteralSrcSpan
gmapQi :: Int -> (forall d. Data d => d -> u) -> LiteralSrcSpan -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> LiteralSrcSpan -> u
gmapQ :: (forall d. Data d => d -> u) -> LiteralSrcSpan -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> LiteralSrcSpan -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LiteralSrcSpan -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LiteralSrcSpan -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LiteralSrcSpan -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LiteralSrcSpan -> r
gmapT :: (forall b. Data b => b -> b) -> LiteralSrcSpan -> LiteralSrcSpan
$cgmapT :: (forall b. Data b => b -> b) -> LiteralSrcSpan -> LiteralSrcSpan
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c LiteralSrcSpan)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c LiteralSrcSpan)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c LiteralSrcSpan)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c LiteralSrcSpan)
dataTypeOf :: LiteralSrcSpan -> DataType
$cdataTypeOf :: LiteralSrcSpan -> DataType
toConstr :: LiteralSrcSpan -> Constr
$ctoConstr :: LiteralSrcSpan -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LiteralSrcSpan
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LiteralSrcSpan
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LiteralSrcSpan -> c LiteralSrcSpan
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LiteralSrcSpan -> c LiteralSrcSpan
$cp1Data :: Typeable LiteralSrcSpan
Data)

instance NFData LiteralSrcSpan where
    rnf :: LiteralSrcSpan -> ()
rnf LiteralSrcSpan
x = LiteralSrcSpan
x LiteralSrcSpan -> () -> ()
`seq` ()

instance NFData Literal


-- | Return a Literal's Source representation
getSrcText :: Literal -> Text
getSrcText :: Literal -> Text
getSrcText = \case
  IntLiteral LiteralSrcSpan
_ Text
txt Integer
_  -> Text
txt
  FracLiteral LiteralSrcSpan
_ Text
txt Rational
_ -> Text
txt

-- | Return a Literal's Real Source location
getSrcSpan :: Literal -> RealSrcSpan
getSrcSpan :: Literal -> RealSrcSpan
getSrcSpan = \case
    IntLiteral LiteralSrcSpan
ss Text
_ Integer
_  -> LiteralSrcSpan -> RealSrcSpan
unLit LiteralSrcSpan
ss
    FracLiteral LiteralSrcSpan
ss Text
_ Rational
_ -> LiteralSrcSpan -> RealSrcSpan
unLit LiteralSrcSpan
ss

-- | Find all literals in a Parsed Source File
collectLiterals :: (Data ast, Typeable ast) => ast -> [Literal]
collectLiterals :: ast -> [Literal]
collectLiterals = ([Literal] -> [Literal] -> [Literal])
-> GenericQ [Literal] -> GenericQ [Literal]
forall r. (r -> r -> r) -> GenericQ r -> GenericQ r
everything [Literal] -> [Literal] -> [Literal]
forall a. Semigroup a => a -> a -> a
(<>) (Maybe Literal -> [Literal]
forall a. Maybe a -> [a]
maybeToList (Maybe Literal -> [Literal])
-> (a -> Maybe Literal) -> a -> [Literal]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Literal -> a -> Maybe Literal
forall a b. a -> b -> a
const Maybe Literal
forall a. Maybe a
Nothing (a -> Maybe Literal)
-> (LHsExpr GhcPs -> Maybe Literal) -> a -> Maybe Literal
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` LHsExpr GhcPs -> Maybe Literal
getLiteral (a -> Maybe Literal)
-> (Located (Pat GhcPs) -> Maybe Literal) -> a -> Maybe Literal
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` LocPat GhcPs -> Maybe Literal
Located (Pat GhcPs) -> Maybe Literal
getPattern))


-- | Translate from HsLit and HsOverLit Types to our Literal Type
getLiteral :: LHsExpr GhcPs -> Maybe Literal
getLiteral :: LHsExpr GhcPs -> Maybe Literal
getLiteral (L (SrcSpan -> SrcSpan
forall a. a -> a
locA -> (RealSrcSpan RealSrcSpan
sSpan Maybe ()
_)) HsExpr GhcPs
expr) = case HsExpr GhcPs
expr of
    HsLit XLitE GhcPs
_ HsLit GhcPs
lit         -> HsLit GhcPs -> RealSrcSpan -> Maybe Literal
forall p. HsLit p -> RealSrcSpan -> Maybe Literal
fromLit HsLit GhcPs
lit RealSrcSpan
sSpan
    HsOverLit XOverLitE GhcPs
_ HsOverLit GhcPs
overLit -> HsOverLit GhcPs -> RealSrcSpan -> Maybe Literal
forall p. HsOverLit p -> RealSrcSpan -> Maybe Literal
fromOverLit HsOverLit GhcPs
overLit RealSrcSpan
sSpan
    HsExpr GhcPs
_                   -> Maybe Literal
forall a. Maybe a
Nothing
getLiteral LHsExpr GhcPs
_ = Maybe Literal
forall a. Maybe a
Nothing



-- GHC 8.8 typedefs LPat = Pat
#if __GLASGOW_HASKELL__ == 808
type LocPat a = GenLocated SrcSpan (Pat a)
#else
type LocPat a = LPat a
#endif

-- | Destructure Patterns to unwrap any Literals
getPattern :: LocPat GhcPs -> Maybe Literal
getPattern :: LocPat GhcPs -> Maybe Literal
getPattern (L (locA -> (RealSrcSpan patSpan _)) pat) = case Pat GhcPs
pat of
    LitPat XLitPat GhcPs
_ HsLit GhcPs
lit -> case HsLit GhcPs
lit of
        HsInt XHsInt GhcPs
_ IntegralLit
val   -> RealSrcSpan -> IntegralLit -> Maybe Literal
fromIntegralLit RealSrcSpan
patSpan IntegralLit
val
        HsRat XHsRat GhcPs
_ FractionalLit
val Type
_ -> RealSrcSpan -> FractionalLit -> Maybe Literal
fromFractionalLit RealSrcSpan
patSpan FractionalLit
val
        HsLit GhcPs
_             -> Maybe Literal
forall a. Maybe a
Nothing
    -- a located HsOverLit is (GenLocated SrcSpan HsOverLit) NOT (GenLocated SrcSpanAnn' a HsOverLit)
    NPat XNPat GhcPs
_ (L (RealSrcSpan RealSrcSpan
sSpan Maybe ()
_) HsOverLit GhcPs
overLit) Maybe (SyntaxExpr GhcPs)
_ SyntaxExpr GhcPs
_ -> HsOverLit GhcPs -> RealSrcSpan -> Maybe Literal
forall p. HsOverLit p -> RealSrcSpan -> Maybe Literal
fromOverLit HsOverLit GhcPs
overLit RealSrcSpan
sSpan
    NPlusKPat XNPlusKPat GhcPs
_ Located (IdP GhcPs)
_ (L (RealSrcSpan RealSrcSpan
sSpan Maybe ()
_) HsOverLit GhcPs
overLit1) HsOverLit GhcPs
_ SyntaxExpr GhcPs
_ SyntaxExpr GhcPs
_ -> HsOverLit GhcPs -> RealSrcSpan -> Maybe Literal
forall p. HsOverLit p -> RealSrcSpan -> Maybe Literal
fromOverLit HsOverLit GhcPs
overLit1 RealSrcSpan
sSpan
    Pat GhcPs
_ -> Maybe Literal
forall a. Maybe a
Nothing
getPattern LocPat GhcPs
_ = Maybe Literal
forall a. Maybe a
Nothing

fromLit :: HsLit p -> RealSrcSpan -> Maybe Literal
fromLit :: HsLit p -> RealSrcSpan -> Maybe Literal
fromLit HsLit p
lit RealSrcSpan
sSpan = case HsLit p
lit of
        HsInt XHsInt p
_ IntegralLit
val   -> RealSrcSpan -> IntegralLit -> Maybe Literal
fromIntegralLit RealSrcSpan
sSpan IntegralLit
val
        HsRat XHsRat p
_ FractionalLit
val Type
_ -> RealSrcSpan -> FractionalLit -> Maybe Literal
fromFractionalLit RealSrcSpan
sSpan FractionalLit
val
        HsLit p
_             -> Maybe Literal
forall a. Maybe a
Nothing

fromOverLit :: HsOverLit p -> RealSrcSpan -> Maybe Literal
fromOverLit :: HsOverLit p -> RealSrcSpan -> Maybe Literal
fromOverLit OverLit{OverLitVal
HsExpr p
XOverLit p
ol_ext :: forall p. HsOverLit p -> XOverLit p
ol_val :: forall p. HsOverLit p -> OverLitVal
ol_witness :: forall p. HsOverLit p -> HsExpr p
ol_witness :: HsExpr p
ol_val :: OverLitVal
ol_ext :: XOverLit p
..} RealSrcSpan
sSpan = case OverLitVal
ol_val of
        HsIntegral IntegralLit
il   -> RealSrcSpan -> IntegralLit -> Maybe Literal
fromIntegralLit RealSrcSpan
sSpan IntegralLit
il
        HsFractional FractionalLit
fl -> RealSrcSpan -> FractionalLit -> Maybe Literal
fromFractionalLit RealSrcSpan
sSpan FractionalLit
fl
        OverLitVal
_               -> Maybe Literal
forall a. Maybe a
Nothing
fromOverLit HsOverLit p
_ RealSrcSpan
_ = Maybe Literal
forall a. Maybe a
Nothing

fromIntegralLit :: RealSrcSpan -> IntegralLit -> Maybe Literal
fromIntegralLit :: RealSrcSpan -> IntegralLit -> Maybe Literal
fromIntegralLit RealSrcSpan
s IL{Bool
Integer
SourceText
il_text :: IntegralLit -> SourceText
il_neg :: IntegralLit -> Bool
il_value :: IntegralLit -> Integer
il_value :: Integer
il_neg :: Bool
il_text :: SourceText
..} = (Text -> Literal) -> Maybe Text -> Maybe Literal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Text
txt' -> LiteralSrcSpan -> Text -> Integer -> Literal
IntLiteral (RealSrcSpan -> LiteralSrcSpan
LiteralSrcSpan RealSrcSpan
s) Text
txt' Integer
il_value) (SourceText -> Maybe Text
fromSourceText SourceText
il_text)

fromFractionalLit  :: RealSrcSpan -> FractionalLit -> Maybe Literal
fromFractionalLit :: RealSrcSpan -> FractionalLit -> Maybe Literal
fromFractionalLit RealSrcSpan
s fl :: FractionalLit
fl@FL{SourceText
fl_text :: FractionalLit -> SourceText
fl_text :: SourceText
fl_text} = (Text -> Literal) -> Maybe Text -> Maybe Literal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Text
txt' -> LiteralSrcSpan -> Text -> Rational -> Literal
FracLiteral (RealSrcSpan -> LiteralSrcSpan
LiteralSrcSpan RealSrcSpan
s) Text
txt' (FractionalLit -> Rational
rationalFromFractionalLit FractionalLit
fl)) (SourceText -> Maybe Text
fromSourceText SourceText
fl_text)

fromSourceText :: SourceText -> Maybe Text
fromSourceText :: SourceText -> Maybe Text
fromSourceText = \case
  SourceText String
s -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
s
  SourceText
NoSourceText -> Maybe Text
forall a. Maybe a
Nothing