module Stan.Analysis.Analyser
( analyseAst
) where
import Extensions (ExtensionsResult)
import GHC.LanguageExtensions.Type (Extension (Strict, StrictData))
import Slist (Slist)
import Stan.Analysis.Visitor (Visitor (..), VisitorState (..), addFixity, addObservation,
addObservations, addOpDecl, getFinalObservations)
import Stan.Core.Id (Id)
import Stan.Core.List (nonRepeatingPairs)
import Stan.FileInfo (isExtensionDisabled)
import Stan.Ghc.Compat (RealSrcSpan, isSymOcc, nameOccName, occNameString)
import Stan.Hie (eqAst)
import Stan.Hie.Compat (HieAST (..), HieFile (..), Identifier, NodeInfo (..), TypeIndex, nodeInfo)
import Stan.Hie.MatchAst (hieMatchPatternAst)
import Stan.Inspection (Inspection (..), InspectionAnalysis (..))
import Stan.NameMeta (NameMeta, ghcPrimNameFrom)
import Stan.Observation (Observations, mkObservation)
import Stan.Pattern.Ast (Literal (..), PatternAst (..), anyNamesToPatternAst, case', constructor,
constructorNameIdentifier, dataDecl, fixity, fun, guardBranch, lambdaCase,
lazyField, literalPat, opApp, patternMatchArrow, patternMatchBranch,
patternMatch_, rhs, tuple, typeSig)
import Stan.Pattern.Edsl (PatternBool (..))
import qualified Data.Map.Strict as Map
import qualified Data.Set as Set
import qualified Slist as S
analyseAst
:: HieFile
-> ExtensionsResult
-> [Inspection]
-> Observations
analyseAst :: HieFile -> ExtensionsResult -> [Inspection] -> Observations
analyseAst HieFile
hie ExtensionsResult
exts = HieFile -> Visitor -> Observations
getFinalObservations HieFile
hie (Visitor -> Observations)
-> ([Inspection] -> Visitor) -> [Inspection] -> Observations
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HieFile -> ExtensionsResult -> [Inspection] -> Visitor
createVisitor HieFile
hie ExtensionsResult
exts
createVisitor
:: HieFile
-> ExtensionsResult
-> [Inspection]
-> Visitor
createVisitor :: HieFile -> ExtensionsResult -> [Inspection] -> Visitor
createVisitor HieFile
hie ExtensionsResult
exts [Inspection]
inspections = (HieAST TypeIndex -> State VisitorState ()) -> Visitor
Visitor ((HieAST TypeIndex -> State VisitorState ()) -> Visitor)
-> (HieAST TypeIndex -> State VisitorState ()) -> Visitor
forall a b. (a -> b) -> a -> b
$ \HieAST TypeIndex
node ->
[Inspection]
-> (Inspection -> State VisitorState ()) -> State VisitorState ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Inspection]
inspections ((Inspection -> State VisitorState ()) -> State VisitorState ())
-> (Inspection -> State VisitorState ()) -> State VisitorState ()
forall a b. (a -> b) -> a -> b
$ \Inspection{[Text]
NonEmpty Category
Text
Id Inspection
Severity
InspectionAnalysis
inspectionId :: Id Inspection
inspectionName :: Text
inspectionDescription :: Text
inspectionSolution :: [Text]
inspectionCategory :: NonEmpty Category
inspectionSeverity :: Severity
inspectionAnalysis :: InspectionAnalysis
inspectionId :: Inspection -> Id Inspection
inspectionName :: Inspection -> Text
inspectionDescription :: Inspection -> Text
inspectionSolution :: Inspection -> [Text]
inspectionCategory :: Inspection -> NonEmpty Category
inspectionSeverity :: Inspection -> Severity
inspectionAnalysis :: Inspection -> InspectionAnalysis
..} -> case InspectionAnalysis
inspectionAnalysis of
FindAst PatternAst
patAst -> Id Inspection
-> PatternAst
-> HieFile
-> HieAST TypeIndex
-> State VisitorState ()
matchAst Id Inspection
inspectionId PatternAst
patAst HieFile
hie HieAST TypeIndex
node
InspectionAnalysis
Infix -> HieFile -> HieAST TypeIndex -> State VisitorState ()
analyseInfix HieFile
hie HieAST TypeIndex
node
InspectionAnalysis
LazyField -> Bool -> State VisitorState () -> State VisitorState ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when
(Extension -> ExtensionsResult -> Bool
isExtensionDisabled Extension
StrictData ExtensionsResult
exts Bool -> Bool -> Bool
&& Extension -> ExtensionsResult -> Bool
isExtensionDisabled Extension
Strict ExtensionsResult
exts)
(Id Inspection
-> HieFile -> HieAST TypeIndex -> State VisitorState ()
analyseLazyFields Id Inspection
inspectionId HieFile
hie HieAST TypeIndex
node)
InspectionAnalysis
BigTuples -> Id Inspection
-> HieFile -> HieAST TypeIndex -> State VisitorState ()
analyseBigTuples Id Inspection
inspectionId HieFile
hie HieAST TypeIndex
node
InspectionAnalysis
PatternMatchOn_ -> Id Inspection
-> HieFile -> HieAST TypeIndex -> State VisitorState ()
analysePatternMatch_ Id Inspection
inspectionId HieFile
hie HieAST TypeIndex
node
InspectionAnalysis
UseCompare -> Id Inspection
-> HieFile -> HieAST TypeIndex -> State VisitorState ()
analyseCompare Id Inspection
inspectionId HieFile
hie HieAST TypeIndex
node
analyseBigTuples
:: Id Inspection
-> HieFile
-> HieAST TypeIndex
-> State VisitorState ()
analyseBigTuples :: Id Inspection
-> HieFile -> HieAST TypeIndex -> State VisitorState ()
analyseBigTuples Id Inspection
insId = (HieAST TypeIndex -> Bool)
-> Id Inspection
-> PatternAst
-> HieFile
-> HieAST TypeIndex
-> State VisitorState ()
matchAstWith HieAST TypeIndex -> Bool
isBigTuple Id Inspection
insId PatternAst
tuple
where
isBigTuple :: HieAST TypeIndex -> Bool
isBigTuple :: HieAST TypeIndex -> Bool
isBigTuple Node{[HieAST TypeIndex]
RealSrcSpan
SourcedNodeInfo TypeIndex
sourcedNodeInfo :: SourcedNodeInfo TypeIndex
nodeSpan :: RealSrcSpan
nodeChildren :: [HieAST TypeIndex]
sourcedNodeInfo :: forall a. HieAST a -> SourcedNodeInfo a
nodeSpan :: forall a. HieAST a -> RealSrcSpan
nodeChildren :: forall a. HieAST a -> [HieAST a]
..} = case [HieAST TypeIndex]
nodeChildren of
HieAST TypeIndex
_:HieAST TypeIndex
_:HieAST TypeIndex
_:HieAST TypeIndex
_:[HieAST TypeIndex]
_ -> Bool
True
[HieAST TypeIndex]
_lessThan4 -> Bool
False
analyseCompare
:: Id Inspection
-> HieFile
-> HieAST TypeIndex
-> State VisitorState ()
analyseCompare :: Id Inspection
-> HieFile -> HieAST TypeIndex -> State VisitorState ()
analyseCompare Id Inspection
insId HieFile
hie HieAST TypeIndex
curNode =
Observations -> State VisitorState ()
addObservations (Observations -> State VisitorState ())
-> Observations -> State VisitorState ()
forall a b. (a -> b) -> a -> b
$ Id Inspection -> HieFile -> RealSrcSpan -> Observation
mkObservation Id Inspection
insId HieFile
hie (RealSrcSpan -> Observation) -> Slist RealSrcSpan -> Observations
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HieAST TypeIndex -> Slist RealSrcSpan
matchComparisonGuards HieAST TypeIndex
curNode
where
matchComparisonGuards :: HieAST TypeIndex -> Slist RealSrcSpan
matchComparisonGuards :: HieAST TypeIndex -> Slist RealSrcSpan
matchComparisonGuards HieAST TypeIndex
node = Bool -> Slist RealSrcSpan -> Slist RealSrcSpan
forall m. Monoid m => Bool -> m -> m
memptyIfFalse
(HieFile -> HieAST TypeIndex -> PatternAst -> Bool
hieMatchPatternAst HieFile
hie HieAST TypeIndex
node PatternAst
fun)
(Slist RealSrcSpan -> Slist RealSrcSpan)
-> Slist RealSrcSpan -> Slist RealSrcSpan
forall a b. (a -> b) -> a -> b
$ let guards :: [(HieAST TypeIndex, HieAST TypeIndex)]
guards = (HieAST TypeIndex -> Maybe (HieAST TypeIndex, HieAST TypeIndex))
-> [HieAST TypeIndex] -> [(HieAST TypeIndex, HieAST TypeIndex)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe HieAST TypeIndex -> Maybe (HieAST TypeIndex, HieAST TypeIndex)
extractComparisonGuard (HieAST TypeIndex -> [HieAST TypeIndex]
forall a. HieAST a -> [HieAST a]
nodeChildren HieAST TypeIndex
node)
in Bool -> Slist RealSrcSpan -> Slist RealSrcSpan
forall m. Monoid m => Bool -> m -> m
memptyIfFalse ([(HieAST TypeIndex, HieAST TypeIndex)] -> Bool
hasManyCompares [(HieAST TypeIndex, HieAST TypeIndex)]
guards) (RealSrcSpan -> Slist RealSrcSpan
forall a. a -> Slist a
S.one (RealSrcSpan -> Slist RealSrcSpan)
-> RealSrcSpan -> Slist RealSrcSpan
forall a b. (a -> b) -> a -> b
$ HieAST TypeIndex -> RealSrcSpan
forall a. HieAST a -> RealSrcSpan
nodeSpan HieAST TypeIndex
node)
extractComparisonGuard
:: HieAST TypeIndex
-> Maybe (HieAST TypeIndex, HieAST TypeIndex)
extractComparisonGuard :: HieAST TypeIndex -> Maybe (HieAST TypeIndex, HieAST TypeIndex)
extractComparisonGuard HieAST TypeIndex
node = do
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ HieFile -> HieAST TypeIndex -> PatternAst -> Bool
hieMatchPatternAst HieFile
hie HieAST TypeIndex
node PatternAst
rhs
HieAST TypeIndex
stmt:[HieAST TypeIndex]
_ <- [HieAST TypeIndex] -> Maybe [HieAST TypeIndex]
forall a. a -> Maybe a
Just ([HieAST TypeIndex] -> Maybe [HieAST TypeIndex])
-> [HieAST TypeIndex] -> Maybe [HieAST TypeIndex]
forall a b. (a -> b) -> a -> b
$ HieAST TypeIndex -> [HieAST TypeIndex]
forall a. HieAST a -> [HieAST a]
nodeChildren HieAST TypeIndex
node
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ HieFile -> HieAST TypeIndex -> PatternAst -> Bool
hieMatchPatternAst HieFile
hie HieAST TypeIndex
stmt PatternAst
guardBranch
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ HieFile -> HieAST TypeIndex -> PatternAst -> Bool
hieMatchPatternAst HieFile
hie HieAST TypeIndex
stmt (PatternAst -> Bool) -> PatternAst -> Bool
forall a b. (a -> b) -> a -> b
$ PatternAst -> PatternAst -> PatternAst -> PatternAst
opApp PatternAst
forall a. PatternBool a => a
(?) PatternAst
opsPat PatternAst
forall a. PatternBool a => a
(?)
HieAST TypeIndex
x:HieAST TypeIndex
_opAst:HieAST TypeIndex
y:[HieAST TypeIndex]
_ <- [HieAST TypeIndex] -> Maybe [HieAST TypeIndex]
forall a. a -> Maybe a
Just ([HieAST TypeIndex] -> Maybe [HieAST TypeIndex])
-> [HieAST TypeIndex] -> Maybe [HieAST TypeIndex]
forall a b. (a -> b) -> a -> b
$ HieAST TypeIndex -> [HieAST TypeIndex]
forall a. HieAST a -> [HieAST a]
nodeChildren HieAST TypeIndex
stmt
(HieAST TypeIndex, HieAST TypeIndex)
-> Maybe (HieAST TypeIndex, HieAST TypeIndex)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HieAST TypeIndex
x, HieAST TypeIndex
y)
opsPat :: PatternAst
opsPat :: PatternAst
opsPat = NonEmpty NameMeta -> PatternAst
anyNamesToPatternAst (NonEmpty NameMeta -> PatternAst)
-> NonEmpty NameMeta -> PatternAst
forall a b. (a -> b) -> a -> b
$ NameMeta
le NameMeta -> [NameMeta] -> NonEmpty NameMeta
forall a. a -> [a] -> NonEmpty a
:| [NameMeta
leq, NameMeta
eq, NameMeta
ge, NameMeta
geq]
le, leq, eq, ge, geq :: NameMeta
le :: NameMeta
le = Text -> NameMeta
opName Text
"<"
leq :: NameMeta
leq = Text -> NameMeta
opName Text
"<="
eq :: NameMeta
eq = Text -> NameMeta
opName Text
"=="
ge :: NameMeta
ge = Text -> NameMeta
opName Text
">"
geq :: NameMeta
geq = Text -> NameMeta
opName Text
">="
opName :: Text -> NameMeta
opName :: Text -> NameMeta
opName = (Text -> ModuleName -> NameMeta
`ghcPrimNameFrom` ModuleName
"GHC.Classes")
hasManyCompares :: [(HieAST TypeIndex, HieAST TypeIndex)] -> Bool
hasManyCompares :: [(HieAST TypeIndex, HieAST TypeIndex)] -> Bool
hasManyCompares = (((HieAST TypeIndex, HieAST TypeIndex),
(HieAST TypeIndex, HieAST TypeIndex))
-> Bool)
-> [((HieAST TypeIndex, HieAST TypeIndex),
(HieAST TypeIndex, HieAST TypeIndex))]
-> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (((HieAST TypeIndex, HieAST TypeIndex)
-> (HieAST TypeIndex, HieAST TypeIndex) -> Bool)
-> ((HieAST TypeIndex, HieAST TypeIndex),
(HieAST TypeIndex, HieAST TypeIndex))
-> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (HieAST TypeIndex, HieAST TypeIndex)
-> (HieAST TypeIndex, HieAST TypeIndex) -> Bool
matchingComparions) ([((HieAST TypeIndex, HieAST TypeIndex),
(HieAST TypeIndex, HieAST TypeIndex))]
-> Bool)
-> ([(HieAST TypeIndex, HieAST TypeIndex)]
-> [((HieAST TypeIndex, HieAST TypeIndex),
(HieAST TypeIndex, HieAST TypeIndex))])
-> [(HieAST TypeIndex, HieAST TypeIndex)]
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(HieAST TypeIndex, HieAST TypeIndex)]
-> [((HieAST TypeIndex, HieAST TypeIndex),
(HieAST TypeIndex, HieAST TypeIndex))]
forall a. [a] -> [(a, a)]
nonRepeatingPairs
matchingComparions
:: (HieAST TypeIndex, HieAST TypeIndex)
-> (HieAST TypeIndex, HieAST TypeIndex)
-> Bool
matchingComparions :: (HieAST TypeIndex, HieAST TypeIndex)
-> (HieAST TypeIndex, HieAST TypeIndex) -> Bool
matchingComparions (HieAST TypeIndex
a, HieAST TypeIndex
b) (HieAST TypeIndex
x, HieAST TypeIndex
y) =
(HieFile -> HieAST TypeIndex -> HieAST TypeIndex -> Bool
forall a. Ord a => HieFile -> HieAST a -> HieAST a -> Bool
eqAst HieFile
hie HieAST TypeIndex
a HieAST TypeIndex
x Bool -> Bool -> Bool
&& HieFile -> HieAST TypeIndex -> HieAST TypeIndex -> Bool
forall a. Ord a => HieFile -> HieAST a -> HieAST a -> Bool
eqAst HieFile
hie HieAST TypeIndex
b HieAST TypeIndex
y) Bool -> Bool -> Bool
|| (HieFile -> HieAST TypeIndex -> HieAST TypeIndex -> Bool
forall a. Ord a => HieFile -> HieAST a -> HieAST a -> Bool
eqAst HieFile
hie HieAST TypeIndex
a HieAST TypeIndex
y Bool -> Bool -> Bool
&& HieFile -> HieAST TypeIndex -> HieAST TypeIndex -> Bool
forall a. Ord a => HieFile -> HieAST a -> HieAST a -> Bool
eqAst HieFile
hie HieAST TypeIndex
b HieAST TypeIndex
x)
analyseLazyFields
:: Id Inspection
-> HieFile
-> HieAST TypeIndex
-> State VisitorState ()
analyseLazyFields :: Id Inspection
-> HieFile -> HieAST TypeIndex -> State VisitorState ()
analyseLazyFields Id Inspection
insId HieFile
hie HieAST TypeIndex
curNode =
Observations -> State VisitorState ()
addObservations (Observations -> State VisitorState ())
-> Observations -> State VisitorState ()
forall a b. (a -> b) -> a -> b
$ Id Inspection -> HieFile -> RealSrcSpan -> Observation
mkObservation Id Inspection
insId HieFile
hie (RealSrcSpan -> Observation) -> Slist RealSrcSpan -> Observations
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HieAST TypeIndex -> Slist RealSrcSpan
matchLazyField HieAST TypeIndex
curNode
where
matchLazyField :: HieAST TypeIndex -> Slist RealSrcSpan
matchLazyField :: HieAST TypeIndex -> Slist RealSrcSpan
matchLazyField HieAST TypeIndex
node = Bool -> Slist RealSrcSpan -> Slist RealSrcSpan
forall m. Monoid m => Bool -> m -> m
memptyIfFalse
(HieFile -> HieAST TypeIndex -> PatternAst -> Bool
hieMatchPatternAst HieFile
hie HieAST TypeIndex
node PatternAst
dataDecl)
(Slist RealSrcSpan -> Slist RealSrcSpan)
-> Slist RealSrcSpan -> Slist RealSrcSpan
forall a b. (a -> b) -> a -> b
$ let constructors :: [HieAST TypeIndex]
constructors = (HieAST TypeIndex -> Bool)
-> [HieAST TypeIndex] -> [HieAST TypeIndex]
forall a. (a -> Bool) -> [a] -> [a]
filter
(\HieAST TypeIndex
n -> HieFile -> HieAST TypeIndex -> PatternAst -> Bool
hieMatchPatternAst HieFile
hie HieAST TypeIndex
n PatternAst
constructor)
(HieAST TypeIndex -> [HieAST TypeIndex]
forall a. HieAST a -> [HieAST a]
nodeChildren HieAST TypeIndex
node)
in case [HieAST TypeIndex]
constructors of
[] -> Slist RealSrcSpan
forall a. Monoid a => a
mempty
[HieAST TypeIndex
c] -> (HieAST TypeIndex -> Slist RealSrcSpan)
-> [HieAST TypeIndex] -> Slist RealSrcSpan
forall (t :: * -> *) a b.
Foldable t =>
(a -> Slist b) -> t a -> Slist b
S.concatMap HieAST TypeIndex -> Slist RealSrcSpan
matchField ([HieAST TypeIndex] -> Slist RealSrcSpan)
-> [HieAST TypeIndex] -> Slist RealSrcSpan
forall a b. (a -> b) -> a -> b
$ Bool -> HieAST TypeIndex -> [HieAST TypeIndex]
extractFields Bool
False HieAST TypeIndex
c
[HieAST TypeIndex]
cs -> (HieAST TypeIndex -> Slist RealSrcSpan)
-> [HieAST TypeIndex] -> Slist RealSrcSpan
forall (t :: * -> *) a b.
Foldable t =>
(a -> Slist b) -> t a -> Slist b
S.concatMap ((HieAST TypeIndex -> Slist RealSrcSpan)
-> [HieAST TypeIndex] -> Slist RealSrcSpan
forall (t :: * -> *) a b.
Foldable t =>
(a -> Slist b) -> t a -> Slist b
S.concatMap HieAST TypeIndex -> Slist RealSrcSpan
matchField ([HieAST TypeIndex] -> Slist RealSrcSpan)
-> (HieAST TypeIndex -> [HieAST TypeIndex])
-> HieAST TypeIndex
-> Slist RealSrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> HieAST TypeIndex -> [HieAST TypeIndex]
extractFields Bool
True) [HieAST TypeIndex]
cs
extractFields :: Bool -> HieAST TypeIndex -> [HieAST TypeIndex]
extractFields :: Bool -> HieAST TypeIndex -> [HieAST TypeIndex]
extractFields Bool
hasManyCtors HieAST TypeIndex
ctor = case TypeIndex -> [HieAST TypeIndex] -> [HieAST TypeIndex]
forall a. TypeIndex -> [a] -> [a]
drop TypeIndex
1 ([HieAST TypeIndex] -> [HieAST TypeIndex])
-> [HieAST TypeIndex] -> [HieAST TypeIndex]
forall a b. (a -> b) -> a -> b
$ (HieAST TypeIndex -> Bool)
-> [HieAST TypeIndex] -> [HieAST TypeIndex]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile HieAST TypeIndex -> Bool
isConstraint ([HieAST TypeIndex] -> [HieAST TypeIndex])
-> [HieAST TypeIndex] -> [HieAST TypeIndex]
forall a b. (a -> b) -> a -> b
$ HieAST TypeIndex -> [HieAST TypeIndex]
forall a. HieAST a -> [HieAST a]
nodeChildren HieAST TypeIndex
ctor of
[] -> []
[HieAST TypeIndex
n] ->
if HieAST TypeIndex -> Bool
isDummyRecordNode HieAST TypeIndex
n
then case HieAST TypeIndex -> [HieAST TypeIndex]
forall a. HieAST a -> [HieAST a]
nodeChildren HieAST TypeIndex
n of
[] -> []
[HieAST TypeIndex
field] -> [HieAST TypeIndex
field | Bool
hasManyCtors]
[HieAST TypeIndex]
fields -> [HieAST TypeIndex]
fields
else [HieAST TypeIndex
n | Bool
hasManyCtors]
[HieAST TypeIndex]
fields -> [HieAST TypeIndex]
fields
where
isDummyRecordNode :: HieAST TypeIndex -> Bool
isDummyRecordNode :: HieAST TypeIndex -> Bool
isDummyRecordNode = Set NodeAnnotation -> Bool
forall a. Set a -> Bool
Set.null (Set NodeAnnotation -> Bool)
-> (HieAST TypeIndex -> Set NodeAnnotation)
-> HieAST TypeIndex
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeInfo TypeIndex -> Set NodeAnnotation
forall a. NodeInfo a -> Set NodeAnnotation
nodeAnnotations (NodeInfo TypeIndex -> Set NodeAnnotation)
-> (HieAST TypeIndex -> NodeInfo TypeIndex)
-> HieAST TypeIndex
-> Set NodeAnnotation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HieAST TypeIndex -> NodeInfo TypeIndex
forall a. Ord a => HieAST a -> NodeInfo a
nodeInfo
isConstraint :: HieAST TypeIndex -> Bool
isConstraint :: HieAST TypeIndex -> Bool
isConstraint HieAST TypeIndex
n = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ HieFile -> HieAST TypeIndex -> PatternAst -> Bool
hieMatchPatternAst HieFile
hie HieAST TypeIndex
n PatternAst
constructorNameIdentifier
matchField :: HieAST TypeIndex -> Slist RealSrcSpan
matchField :: HieAST TypeIndex -> Slist RealSrcSpan
matchField = PatternAst -> HieFile -> HieAST TypeIndex -> Slist RealSrcSpan
createMatch PatternAst
lazyField HieFile
hie
analysePatternMatch_
:: Id Inspection
-> HieFile
-> HieAST TypeIndex
-> State VisitorState ()
analysePatternMatch_ :: Id Inspection
-> HieFile -> HieAST TypeIndex -> State VisitorState ()
analysePatternMatch_ Id Inspection
insId HieFile
hie HieAST TypeIndex
curNode =
Observations -> State VisitorState ()
addObservations (Observations -> State VisitorState ())
-> Observations -> State VisitorState ()
forall a b. (a -> b) -> a -> b
$ Id Inspection -> HieFile -> RealSrcSpan -> Observation
mkObservation Id Inspection
insId HieFile
hie (RealSrcSpan -> Observation) -> Slist RealSrcSpan -> Observations
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HieAST TypeIndex -> Slist RealSrcSpan
matchPatternMatch HieAST TypeIndex
curNode
where
matchPatternMatch :: HieAST TypeIndex -> Slist RealSrcSpan
matchPatternMatch :: HieAST TypeIndex -> Slist RealSrcSpan
matchPatternMatch HieAST TypeIndex
node = Bool -> Slist RealSrcSpan -> Slist RealSrcSpan
forall m. Monoid m => Bool -> m -> m
memptyIfFalse
(HieFile -> HieAST TypeIndex -> PatternAst -> Bool
hieMatchPatternAst HieFile
hie HieAST TypeIndex
node (PatternAst -> Bool) -> PatternAst -> Bool
forall a b. (a -> b) -> a -> b
$ PatternAst
lambdaCase PatternAst -> PatternAst -> PatternAst
forall a. PatternBool a => a -> a -> a
||| PatternAst
case')
(Slist RealSrcSpan -> Slist RealSrcSpan)
-> Slist RealSrcSpan -> Slist RealSrcSpan
forall a b. (a -> b) -> a -> b
$ case HieAST TypeIndex -> [HieAST TypeIndex]
forall a. HieAST a -> [HieAST a]
nodeChildren HieAST TypeIndex
node of
[] -> Slist RealSrcSpan
forall a. Monoid a => a
mempty
[HieAST TypeIndex
pm] -> HieAST TypeIndex -> Slist RealSrcSpan
analyseBranches HieAST TypeIndex
pm
HieAST TypeIndex
_:HieAST TypeIndex
pm:[HieAST TypeIndex]
_ -> HieAST TypeIndex -> Slist RealSrcSpan
analyseBranches HieAST TypeIndex
pm
analyseBranches :: HieAST TypeIndex -> Slist RealSrcSpan
analyseBranches :: HieAST TypeIndex -> Slist RealSrcSpan
analyseBranches HieAST TypeIndex
pm = case HieAST TypeIndex -> [HieAST TypeIndex]
forall a. HieAST a -> [HieAST a]
nodeChildren HieAST TypeIndex
pm of
[] -> Slist RealSrcSpan
forall a. Monoid a => a
mempty
HieAST TypeIndex
c:[HieAST TypeIndex]
cs -> Bool -> Slist RealSrcSpan -> Slist RealSrcSpan
forall m. Monoid m => Bool -> m -> m
memptyIfFalse (HieAST TypeIndex -> Bool
isFirstPatternMatchBranchOk HieAST TypeIndex
c) (Slist RealSrcSpan -> Slist RealSrcSpan)
-> Slist RealSrcSpan -> Slist RealSrcSpan
forall a b. (a -> b) -> a -> b
$
case (HieAST TypeIndex -> Bool)
-> [HieAST TypeIndex] -> Maybe (HieAST TypeIndex)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\HieAST TypeIndex
x -> HieFile -> HieAST TypeIndex -> PatternAst -> Bool
hieMatchPatternAst HieFile
hie HieAST TypeIndex
x (PatternAst -> PatternAst
patternMatch_ PatternAst
forall a. PatternBool a => a
(?))) [HieAST TypeIndex]
cs of
Maybe (HieAST TypeIndex)
Nothing -> Slist RealSrcSpan
forall a. Monoid a => a
mempty
Just HieAST TypeIndex
e -> RealSrcSpan -> Slist RealSrcSpan
forall a. a -> Slist a
S.one (HieAST TypeIndex -> RealSrcSpan
forall a. HieAST a -> RealSrcSpan
nodeSpan HieAST TypeIndex
e)
isFirstPatternMatchBranchOk :: HieAST TypeIndex -> Bool
isFirstPatternMatchBranchOk :: HieAST TypeIndex -> Bool
isFirstPatternMatchBranchOk HieAST TypeIndex
c = HieFile -> HieAST TypeIndex -> PatternAst -> Bool
hieMatchPatternAst HieFile
hie HieAST TypeIndex
c PatternAst
patternMatchBranch Bool -> Bool -> Bool
&&
case (HieAST TypeIndex -> Bool)
-> [HieAST TypeIndex] -> [HieAST TypeIndex]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile HieAST TypeIndex -> Bool
isNotMatchArrow ([HieAST TypeIndex] -> [HieAST TypeIndex])
-> [HieAST TypeIndex] -> [HieAST TypeIndex]
forall a b. (a -> b) -> a -> b
$ HieAST TypeIndex -> [HieAST TypeIndex]
forall a. HieAST a -> [HieAST a]
nodeChildren HieAST TypeIndex
c of
[] -> Bool
False
[HieAST TypeIndex
x] -> HieFile -> HieAST TypeIndex -> PatternAst -> Bool
hieMatchPatternAst HieFile
hie HieAST TypeIndex
x PatternAst
notLiteral
HieAST TypeIndex
_:[HieAST TypeIndex]
_ -> Bool
True
where
isNotMatchArrow :: HieAST TypeIndex -> Bool
isNotMatchArrow :: HieAST TypeIndex -> Bool
isNotMatchArrow HieAST TypeIndex
n = HieFile -> HieAST TypeIndex -> PatternAst -> Bool
hieMatchPatternAst HieFile
hie HieAST TypeIndex
n (PatternAst -> Bool) -> PatternAst -> Bool
forall a b. (a -> b) -> a -> b
$ PatternAst -> PatternAst
forall a. PatternBool a => a -> a
neg (PatternAst -> PatternAst) -> PatternAst -> PatternAst
forall a b. (a -> b) -> a -> b
$ PatternAst -> PatternAst
patternMatchArrow PatternAst
forall a. PatternBool a => a
(?)
notLiteral :: PatternAst
notLiteral :: PatternAst
notLiteral = PatternAst -> PatternAst
forall a. PatternBool a => a -> a
neg
( Literal -> PatternAst
PatternAstConstant Literal
AnyLiteral
PatternAst -> PatternAst -> PatternAst
forall a. PatternBool a => a -> a -> a
||| PatternAst
literalPat
)
analyseInfix
:: HieFile
-> HieAST TypeIndex
-> State VisitorState ()
analyseInfix :: HieFile -> HieAST TypeIndex -> State VisitorState ()
analyseInfix HieFile
hie HieAST TypeIndex
curNode = do
HieAST TypeIndex -> State VisitorState ()
matchInfix HieAST TypeIndex
curNode
HieAST TypeIndex -> State VisitorState ()
matchOperator HieAST TypeIndex
curNode
where
matchInfix :: HieAST TypeIndex -> State VisitorState ()
matchInfix :: HieAST TypeIndex -> State VisitorState ()
matchInfix node :: HieAST TypeIndex
node@Node{[HieAST TypeIndex]
RealSrcSpan
SourcedNodeInfo TypeIndex
sourcedNodeInfo :: forall a. HieAST a -> SourcedNodeInfo a
nodeSpan :: forall a. HieAST a -> RealSrcSpan
nodeChildren :: forall a. HieAST a -> [HieAST a]
sourcedNodeInfo :: SourcedNodeInfo TypeIndex
nodeSpan :: RealSrcSpan
nodeChildren :: [HieAST TypeIndex]
..} = Bool -> State VisitorState () -> State VisitorState ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when
(HieFile -> HieAST TypeIndex -> PatternAst -> Bool
hieMatchPatternAst HieFile
hie HieAST TypeIndex
node PatternAst
fixity)
((Text -> State VisitorState ()) -> [Text] -> State VisitorState ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Text -> State VisitorState ()
addFixity ([Text] -> State VisitorState ())
-> [Text] -> State VisitorState ()
forall a b. (a -> b) -> a -> b
$ (HieAST TypeIndex -> [Text]) -> [HieAST TypeIndex] -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap HieAST TypeIndex -> [Text]
nodeIds [HieAST TypeIndex]
nodeChildren)
matchOperator :: HieAST TypeIndex -> State VisitorState ()
matchOperator :: HieAST TypeIndex -> State VisitorState ()
matchOperator node :: HieAST TypeIndex
node@Node{[HieAST TypeIndex]
RealSrcSpan
SourcedNodeInfo TypeIndex
sourcedNodeInfo :: forall a. HieAST a -> SourcedNodeInfo a
nodeSpan :: forall a. HieAST a -> RealSrcSpan
nodeChildren :: forall a. HieAST a -> [HieAST a]
sourcedNodeInfo :: SourcedNodeInfo TypeIndex
nodeSpan :: RealSrcSpan
nodeChildren :: [HieAST TypeIndex]
..} = Bool -> State VisitorState () -> State VisitorState ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when
(HieFile -> HieAST TypeIndex -> PatternAst -> Bool
hieMatchPatternAst HieFile
hie HieAST TypeIndex
node PatternAst
typeSig)
(Maybe [(Text, RealSrcSpan)]
-> ([(Text, RealSrcSpan)] -> State VisitorState ())
-> State VisitorState ()
forall (f :: * -> *) a.
Applicative f =>
Maybe a -> (a -> f ()) -> f ()
whenJust
((NonEmpty (HieAST TypeIndex) -> [(Text, RealSrcSpan)])
-> [HieAST TypeIndex] -> Maybe [(Text, RealSrcSpan)]
forall a b. (NonEmpty a -> b) -> [a] -> Maybe b
viaNonEmpty (HieAST TypeIndex -> [(Text, RealSrcSpan)]
extractOperatorName (HieAST TypeIndex -> [(Text, RealSrcSpan)])
-> (NonEmpty (HieAST TypeIndex) -> HieAST TypeIndex)
-> NonEmpty (HieAST TypeIndex)
-> [(Text, RealSrcSpan)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (HieAST TypeIndex) -> HieAST TypeIndex
forall (f :: * -> *) a. IsNonEmpty f a a "head" => f a -> a
head) [HieAST TypeIndex]
nodeChildren)
(((Text, RealSrcSpan) -> State VisitorState ())
-> [(Text, RealSrcSpan)] -> State VisitorState ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ ((Text -> RealSrcSpan -> State VisitorState ())
-> (Text, RealSrcSpan) -> State VisitorState ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> RealSrcSpan -> State VisitorState ()
addOpDecl))
)
nodeIds :: HieAST TypeIndex -> [Text]
nodeIds :: HieAST TypeIndex -> [Text]
nodeIds =
(Identifier -> [Text]) -> [Identifier] -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Identifier -> [Text]
fixityName
([Identifier] -> [Text])
-> (HieAST TypeIndex -> [Identifier]) -> HieAST TypeIndex -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Identifier (IdentifierDetails TypeIndex) -> [Identifier]
forall k a. Map k a -> [k]
Map.keys
(Map Identifier (IdentifierDetails TypeIndex) -> [Identifier])
-> (HieAST TypeIndex
-> Map Identifier (IdentifierDetails TypeIndex))
-> HieAST TypeIndex
-> [Identifier]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeInfo TypeIndex -> Map Identifier (IdentifierDetails TypeIndex)
forall a. NodeInfo a -> NodeIdentifiers a
nodeIdentifiers
(NodeInfo TypeIndex
-> Map Identifier (IdentifierDetails TypeIndex))
-> (HieAST TypeIndex -> NodeInfo TypeIndex)
-> HieAST TypeIndex
-> Map Identifier (IdentifierDetails TypeIndex)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HieAST TypeIndex -> NodeInfo TypeIndex
forall a. Ord a => HieAST a -> NodeInfo a
nodeInfo
fixityName :: Identifier -> [Text]
fixityName :: Identifier -> [Text]
fixityName = \case
Left ModuleName
_ -> []
Right Name
name -> [String -> Text
forall a. ToText a => a -> Text
toText (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ OccName -> String
occNameString (OccName -> String) -> OccName -> String
forall a b. (a -> b) -> a -> b
$ Name -> OccName
nameOccName Name
name]
extractOperatorName :: HieAST TypeIndex -> [(Text, RealSrcSpan)]
extractOperatorName :: HieAST TypeIndex -> [(Text, RealSrcSpan)]
extractOperatorName n :: HieAST TypeIndex
n@Node{[HieAST TypeIndex]
RealSrcSpan
SourcedNodeInfo TypeIndex
sourcedNodeInfo :: forall a. HieAST a -> SourcedNodeInfo a
nodeSpan :: forall a. HieAST a -> RealSrcSpan
nodeChildren :: forall a. HieAST a -> [HieAST a]
sourcedNodeInfo :: SourcedNodeInfo TypeIndex
nodeSpan :: RealSrcSpan
nodeChildren :: [HieAST TypeIndex]
..} =
(Identifier -> [(Text, RealSrcSpan)])
-> [Identifier] -> [(Text, RealSrcSpan)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (RealSrcSpan -> Identifier -> [(Text, RealSrcSpan)]
topLevelOperatorName RealSrcSpan
nodeSpan)
([Identifier] -> [(Text, RealSrcSpan)])
-> [Identifier] -> [(Text, RealSrcSpan)]
forall a b. (a -> b) -> a -> b
$ Map Identifier (IdentifierDetails TypeIndex) -> [Identifier]
forall k a. Map k a -> [k]
Map.keys
(Map Identifier (IdentifierDetails TypeIndex) -> [Identifier])
-> Map Identifier (IdentifierDetails TypeIndex) -> [Identifier]
forall a b. (a -> b) -> a -> b
$ NodeInfo TypeIndex -> Map Identifier (IdentifierDetails TypeIndex)
forall a. NodeInfo a -> NodeIdentifiers a
nodeIdentifiers (HieAST TypeIndex -> NodeInfo TypeIndex
forall a. Ord a => HieAST a -> NodeInfo a
Stan.Hie.Compat.nodeInfo HieAST TypeIndex
n)
topLevelOperatorName :: RealSrcSpan -> Identifier -> [(Text, RealSrcSpan)]
topLevelOperatorName :: RealSrcSpan -> Identifier -> [(Text, RealSrcSpan)]
topLevelOperatorName RealSrcSpan
srcSpan = \case
Left ModuleName
_ -> []
Right Name
name ->
let occName :: OccName
occName = Name -> OccName
nameOccName Name
name
in [(String -> Text
forall a. ToText a => a -> Text
toText (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ OccName -> String
occNameString OccName
occName, RealSrcSpan
srcSpan) | OccName -> Bool
isSymOcc OccName
occName]
createMatch
:: PatternAst
-> HieFile
-> HieAST TypeIndex
-> Slist RealSrcSpan
createMatch :: PatternAst -> HieFile -> HieAST TypeIndex -> Slist RealSrcSpan
createMatch PatternAst
patAst HieFile
hie HieAST TypeIndex
node =
Bool -> Slist RealSrcSpan -> Slist RealSrcSpan
forall m. Monoid m => Bool -> m -> m
memptyIfFalse (HieFile -> HieAST TypeIndex -> PatternAst -> Bool
hieMatchPatternAst HieFile
hie HieAST TypeIndex
node PatternAst
patAst) (RealSrcSpan -> Slist RealSrcSpan
forall a. a -> Slist a
S.one (RealSrcSpan -> Slist RealSrcSpan)
-> RealSrcSpan -> Slist RealSrcSpan
forall a b. (a -> b) -> a -> b
$ HieAST TypeIndex -> RealSrcSpan
forall a. HieAST a -> RealSrcSpan
nodeSpan HieAST TypeIndex
node)
matchAst
:: Id Inspection
-> PatternAst
-> HieFile
-> HieAST TypeIndex
-> State VisitorState ()
matchAst :: Id Inspection
-> PatternAst
-> HieFile
-> HieAST TypeIndex
-> State VisitorState ()
matchAst = (HieAST TypeIndex -> Bool)
-> Id Inspection
-> PatternAst
-> HieFile
-> HieAST TypeIndex
-> State VisitorState ()
matchAstWith (Bool -> HieAST TypeIndex -> Bool
forall a b. a -> b -> a
const Bool
True)
matchAstWith
:: (HieAST TypeIndex -> Bool)
-> Id Inspection
-> PatternAst
-> HieFile
-> HieAST TypeIndex
-> State VisitorState ()
matchAstWith :: (HieAST TypeIndex -> Bool)
-> Id Inspection
-> PatternAst
-> HieFile
-> HieAST TypeIndex
-> State VisitorState ()
matchAstWith HieAST TypeIndex -> Bool
check Id Inspection
insId PatternAst
patAst HieFile
hie node :: HieAST TypeIndex
node@Node{[HieAST TypeIndex]
RealSrcSpan
SourcedNodeInfo TypeIndex
sourcedNodeInfo :: forall a. HieAST a -> SourcedNodeInfo a
nodeSpan :: forall a. HieAST a -> RealSrcSpan
nodeChildren :: forall a. HieAST a -> [HieAST a]
sourcedNodeInfo :: SourcedNodeInfo TypeIndex
nodeSpan :: RealSrcSpan
nodeChildren :: [HieAST TypeIndex]
..} =
Bool -> State VisitorState () -> State VisitorState ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (HieFile -> HieAST TypeIndex -> PatternAst -> Bool
hieMatchPatternAst HieFile
hie HieAST TypeIndex
node PatternAst
patAst Bool -> Bool -> Bool
&& HieAST TypeIndex -> Bool
check HieAST TypeIndex
node) (State VisitorState () -> State VisitorState ())
-> State VisitorState () -> State VisitorState ()
forall a b. (a -> b) -> a -> b
$
Observation -> State VisitorState ()
addObservation (Observation -> State VisitorState ())
-> Observation -> State VisitorState ()
forall a b. (a -> b) -> a -> b
$ Id Inspection -> HieFile -> RealSrcSpan -> Observation
mkObservation Id Inspection
insId HieFile
hie RealSrcSpan
nodeSpan