{- |
Copyright: (c) 2020 Kowainik
SPDX-License-Identifier: MPL-2.0
Maintainer: Kowainik <xrom.xkov@gmail.com>

Some 'Stan.Inspection.Inspection's require to know about types and some
mechanism to match types to the given 'PatternType'. This information on types/type
expressions is taken from @HIE files@ in a more suitable view.

Let's take a look at the function @foo@:

@
foo :: NonEmpty String -> Int
@

In @HIE@ files it will be stored as an 'Array' like this:

@
  1 -> "Int"      []
  2 -> "String"   []
  3 -> "NonEmpty" [ 2 ]
  4 -> FunType    3 1
@

This module contains an implementation of the process of retrieval of this
information from there.
-}

module Stan.Hie.MatchType
    ( hieMatchPatternType
    ) where

import Data.Array (Array)

import Stan.Core.List (checkWith)
import Stan.Ghc.Compat (IfaceTyCon (..), IfaceTyConInfo (..), PromotionFlag (NotPromoted))
import Stan.Hie.Compat (HieArgs (..), HieType (..), HieTypeFlat, TypeIndex, hFunTy2)
import Stan.NameMeta (compareNames)
import Stan.Pattern.Type (PatternType (..))

import qualified Data.Array as Arr


{- | Matching function that searches the array of types recursively.
-}
hieMatchPatternType
    :: Array TypeIndex HieTypeFlat  -- ^ Array of all types in HIE file
    -> PatternType  -- ^ Our search query
    -> TypeIndex   -- ^ Index of the current expression type
    -> Bool  -- ^ If matched type is found
hieMatchPatternType :: Array TypeIndex HieTypeFlat -> PatternType -> TypeIndex -> Bool
hieMatchPatternType Array TypeIndex HieTypeFlat
arr PatternType
pat TypeIndex
i = HieTypeFlat
curFlat HieTypeFlat -> PatternType -> Bool
`satisfyPattern` PatternType
pat
  where
    curFlat :: HieTypeFlat
    curFlat :: HieTypeFlat
curFlat = Array TypeIndex HieTypeFlat
arr Array TypeIndex HieTypeFlat -> TypeIndex -> HieTypeFlat
forall i e. Ix i => Array i e -> i -> e
Arr.! TypeIndex
i

    match :: PatternType -> TypeIndex -> Bool
    match :: PatternType -> TypeIndex -> Bool
match = Array TypeIndex HieTypeFlat -> PatternType -> TypeIndex -> Bool
hieMatchPatternType Array TypeIndex HieTypeFlat
arr

    satisfyPattern :: HieTypeFlat -> PatternType -> Bool
    satisfyPattern :: HieTypeFlat -> PatternType -> Bool
satisfyPattern HieTypeFlat
_ PatternType
PatternTypeAnything = Bool
True
    satisfyPattern HieTypeFlat
t (PatternTypeNeg PatternType
p) =
        Bool -> Bool
not (HieTypeFlat -> PatternType -> Bool
satisfyPattern HieTypeFlat
t PatternType
p)
    satisfyPattern HieTypeFlat
t (PatternTypeOr PatternType
p1 PatternType
p2) =
           HieTypeFlat -> PatternType -> Bool
satisfyPattern HieTypeFlat
t PatternType
p1
        Bool -> Bool -> Bool
|| HieTypeFlat -> PatternType -> Bool
satisfyPattern HieTypeFlat
t PatternType
p2
    satisfyPattern HieTypeFlat
t (PatternTypeAnd PatternType
p1 PatternType
p2) =
           HieTypeFlat -> PatternType -> Bool
satisfyPattern HieTypeFlat
t PatternType
p1
        Bool -> Bool -> Bool
&& HieTypeFlat -> PatternType -> Bool
satisfyPattern HieTypeFlat
t PatternType
p2
    satisfyPattern (HTyVarTy Name
name) (PatternTypeName NameMeta
nameMeta []) =
        NameMeta -> Name -> Bool
compareNames NameMeta
nameMeta Name
name
    satisfyPattern
        (HTyConApp IfaceTyCon{Name
IfaceTyConInfo
ifaceTyConName :: Name
ifaceTyConInfo :: IfaceTyConInfo
ifaceTyConName :: IfaceTyCon -> Name
ifaceTyConInfo :: IfaceTyCon -> IfaceTyConInfo
..} (HieArgs [(Bool, TypeIndex)]
hieArgs))
        (PatternTypeName NameMeta
nameMeta [PatternType]
args)
      =
        IfaceTyConInfo -> PromotionFlag
ifaceTyConIsPromoted IfaceTyConInfo
ifaceTyConInfo PromotionFlag -> PromotionFlag -> Bool
forall a. Eq a => a -> a -> Bool
== PromotionFlag
NotPromoted
        Bool -> Bool -> Bool
&& NameMeta -> Name -> Bool
compareNames NameMeta
nameMeta Name
ifaceTyConName
        Bool -> Bool -> Bool
&& ((Bool, TypeIndex) -> PatternType -> Bool)
-> [(Bool, TypeIndex)] -> [PatternType] -> Bool
forall a b. (a -> b -> Bool) -> [a] -> [b] -> Bool
checkWith (\(Bool
_, TypeIndex
ix) PatternType
a -> PatternType -> TypeIndex -> Bool
match PatternType
a TypeIndex
ix) [(Bool, TypeIndex)]
hieArgs [PatternType]
args
    satisfyPattern HieTypeFlat
t (PatternTypeFun PatternType
p1 PatternType
p2)
      | Just (TypeIndex
i1, TypeIndex
i2) <- HieTypeFlat -> Maybe (TypeIndex, TypeIndex)
forall b. HieType b -> Maybe (b, b)
hFunTy2 HieTypeFlat
t =
           PatternType -> TypeIndex -> Bool
match PatternType
p1 TypeIndex
i1
        Bool -> Bool -> Bool
&& PatternType -> TypeIndex -> Bool
match PatternType
p2 TypeIndex
i2
    satisfyPattern (HQualTy TypeIndex
_ TypeIndex
ix) PatternType
p = PatternType -> TypeIndex -> Bool
match PatternType
p TypeIndex
ix
    satisfyPattern (HForAllTy ((Name, TypeIndex), ForAllTyFlag)
_ TypeIndex
ix) PatternType
p = PatternType -> TypeIndex -> Bool
match PatternType
p TypeIndex
ix
    satisfyPattern HieTypeFlat
_flat PatternType
_p = Bool
False