{- |
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)
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 arr :: Array TypeIndex HieTypeFlat
arr pat :: PatternType
pat i :: 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 _ PatternTypeAnything = Bool
True
    satisfyPattern t :: HieTypeFlat
t (PatternTypeNeg p :: PatternType
p) =
        Bool -> Bool
not (HieTypeFlat -> PatternType -> Bool
satisfyPattern HieTypeFlat
t PatternType
p)
    satisfyPattern t :: HieTypeFlat
t (PatternTypeOr p1 :: PatternType
p1 p2 :: PatternType
p2) =
           HieTypeFlat -> PatternType -> Bool
satisfyPattern HieTypeFlat
t PatternType
p1
        Bool -> Bool -> Bool
|| HieTypeFlat -> PatternType -> Bool
satisfyPattern HieTypeFlat
t PatternType
p2
    satisfyPattern t :: HieTypeFlat
t (PatternTypeAnd p1 :: PatternType
p1 p2 :: 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
name) (PatternTypeName nameMeta :: NameMeta
nameMeta []) =
        NameMeta -> Name -> Bool
compareNames NameMeta
nameMeta Name
name
    satisfyPattern
        (HTyConApp IfaceTyCon{..} (HieArgs hieArgs :: [(Bool, TypeIndex)]
hieArgs))
        (PatternTypeName nameMeta :: NameMeta
nameMeta args :: [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 (\(_, ix :: TypeIndex
ix) a :: PatternType
a -> PatternType -> TypeIndex -> Bool
match PatternType
a TypeIndex
ix) [(Bool, TypeIndex)]
hieArgs [PatternType]
args
    satisfyPattern (HFunTy i1 :: TypeIndex
i1 i2 :: TypeIndex
i2) (PatternTypeFun p1 :: PatternType
p1 p2 :: PatternType
p2) =
           PatternType -> TypeIndex -> Bool
match PatternType
p1 TypeIndex
i1
        Bool -> Bool -> Bool
&& PatternType -> TypeIndex -> Bool
match PatternType
p2 TypeIndex
i2
    satisfyPattern (HQualTy _ ix :: TypeIndex
ix) p :: PatternType
p = PatternType -> TypeIndex -> Bool
match PatternType
p TypeIndex
ix
    satisfyPattern (HForAllTy _ ix :: TypeIndex
ix) p :: PatternType
p = PatternType -> TypeIndex -> Bool
match PatternType
p TypeIndex
ix
    satisfyPattern _flat :: HieTypeFlat
_flat _p :: PatternType
_p = Bool
False