{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE OverloadedStrings #-}
module Tokstyle.Analysis.AccessPath
    ( AccessPath (..)
    , isPathPrefixOf
    , pathDepth
    ) where

import           Prettyprinter (Pretty (..))

-- | Access path to a variable or part of it.
data AccessPath
    = PathVar String
    | PathParam Int
    | PathReturn
    | PathDeref AccessPath
    | PathField AccessPath String
    | PathIndex AccessPath String
    deriving (Int -> AccessPath -> ShowS
[AccessPath] -> ShowS
AccessPath -> String
(Int -> AccessPath -> ShowS)
-> (AccessPath -> String)
-> ([AccessPath] -> ShowS)
-> Show AccessPath
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AccessPath] -> ShowS
$cshowList :: [AccessPath] -> ShowS
show :: AccessPath -> String
$cshow :: AccessPath -> String
showsPrec :: Int -> AccessPath -> ShowS
$cshowsPrec :: Int -> AccessPath -> ShowS
Show, AccessPath -> AccessPath -> Bool
(AccessPath -> AccessPath -> Bool)
-> (AccessPath -> AccessPath -> Bool) -> Eq AccessPath
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AccessPath -> AccessPath -> Bool
$c/= :: AccessPath -> AccessPath -> Bool
== :: AccessPath -> AccessPath -> Bool
$c== :: AccessPath -> AccessPath -> Bool
Eq, Eq AccessPath
Eq AccessPath
-> (AccessPath -> AccessPath -> Ordering)
-> (AccessPath -> AccessPath -> Bool)
-> (AccessPath -> AccessPath -> Bool)
-> (AccessPath -> AccessPath -> Bool)
-> (AccessPath -> AccessPath -> Bool)
-> (AccessPath -> AccessPath -> AccessPath)
-> (AccessPath -> AccessPath -> AccessPath)
-> Ord AccessPath
AccessPath -> AccessPath -> Bool
AccessPath -> AccessPath -> Ordering
AccessPath -> AccessPath -> AccessPath
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 :: AccessPath -> AccessPath -> AccessPath
$cmin :: AccessPath -> AccessPath -> AccessPath
max :: AccessPath -> AccessPath -> AccessPath
$cmax :: AccessPath -> AccessPath -> AccessPath
>= :: AccessPath -> AccessPath -> Bool
$c>= :: AccessPath -> AccessPath -> Bool
> :: AccessPath -> AccessPath -> Bool
$c> :: AccessPath -> AccessPath -> Bool
<= :: AccessPath -> AccessPath -> Bool
$c<= :: AccessPath -> AccessPath -> Bool
< :: AccessPath -> AccessPath -> Bool
$c< :: AccessPath -> AccessPath -> Bool
compare :: AccessPath -> AccessPath -> Ordering
$ccompare :: AccessPath -> AccessPath -> Ordering
$cp1Ord :: Eq AccessPath
Ord)

instance Pretty AccessPath where
    pretty :: AccessPath -> Doc ann
pretty = \case
        PathVar String
s     -> String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
s
        PathParam Int
i   -> Doc ann
"param" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Int -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Int
i
        AccessPath
PathReturn    -> Doc ann
"<return value>"
        PathDeref AccessPath
p   -> Doc ann
"*" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> AccessPath -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty AccessPath
p
        PathField AccessPath
p String
s -> AccessPath -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty AccessPath
p Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"->" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
s
        PathIndex AccessPath
p String
i -> AccessPath -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty AccessPath
p Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"[" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
i Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"]"

-- | Check if the first path is a prefix of (or equal to) the second.
-- e.g. "p" is a prefix of "p->f".
isPathPrefixOf :: AccessPath -> AccessPath -> Bool
isPathPrefixOf :: AccessPath -> AccessPath -> Bool
isPathPrefixOf AccessPath
p1 AccessPath
p2               | AccessPath
p1 AccessPath -> AccessPath -> Bool
forall a. Eq a => a -> a -> Bool
== AccessPath
p2 = Bool
True
isPathPrefixOf AccessPath
p1 (PathDeref AccessPath
p2)   = AccessPath
p1 AccessPath -> AccessPath -> Bool
`isPathPrefixOf` AccessPath
p2
isPathPrefixOf AccessPath
p1 (PathField AccessPath
p2 String
_) = AccessPath
p1 AccessPath -> AccessPath -> Bool
`isPathPrefixOf` AccessPath
p2
isPathPrefixOf AccessPath
p1 (PathIndex AccessPath
p2 String
_) = AccessPath
p1 AccessPath -> AccessPath -> Bool
`isPathPrefixOf` AccessPath
p2
isPathPrefixOf AccessPath
PathReturn AccessPath
_        = Bool
False
isPathPrefixOf AccessPath
_ AccessPath
_                 = Bool
False

pathDepth :: AccessPath -> Int
pathDepth :: AccessPath -> Int
pathDepth = \case
    PathVar String
_     -> Int
1
    PathParam Int
_   -> Int
1
    AccessPath
PathReturn    -> Int
1
    PathDeref AccessPath
p   -> Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ AccessPath -> Int
pathDepth AccessPath
p
    PathField AccessPath
p String
_ -> Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ AccessPath -> Int
pathDepth AccessPath
p
    PathIndex AccessPath
p String
_ -> Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ AccessPath -> Int
pathDepth AccessPath
p