{-# LANGUAGE Strict #-}
module Tokstyle.Common
    ( functionName
    , isPointer
    , semEq
    , skip
    , (>+>)
    ) where

import           Data.Fix        (Fix (..))
import qualified Data.List       as List
import           Data.Text       (Text)
import           Language.Cimple (Lexeme (..), LexemeClass (..), Node,
                                  NodeF (..), removeSloc)


isPointer :: Node (Lexeme Text) -> Bool
isPointer :: Node (Lexeme Text) -> Bool
isPointer Node (Lexeme Text)
x = case Node (Lexeme Text) -> NodeF (Lexeme Text) (Node (Lexeme Text))
forall (f :: * -> *). Fix f -> f (Fix f)
unFix Node (Lexeme Text)
x of
    VarDecl Node (Lexeme Text)
ty Lexeme Text
_ [] -> Node (Lexeme Text) -> Bool
isPointer Node (Lexeme Text)
ty
    VarDecl{}       -> Bool
True
    TyConst Node (Lexeme Text)
ty      -> Node (Lexeme Text) -> Bool
isPointer Node (Lexeme Text)
ty
    TyOwner Node (Lexeme Text)
ty      -> Node (Lexeme Text) -> Bool
isPointer Node (Lexeme Text)
ty
    TyPointer{}     -> Bool
True
    TyStd{}         -> Bool
False
    TyStruct{}      -> Bool
False
    TyUserDefined{} -> Bool
False
    NodeF (Lexeme Text) (Node (Lexeme Text))
_               -> [Char] -> Bool
forall a. HasCallStack => [Char] -> a
error ([Char] -> Bool) -> [Char] -> Bool
forall a b. (a -> b) -> a -> b
$ Node (Lexeme Text) -> [Char]
forall a. Show a => a -> [Char]
show Node (Lexeme Text)
x


-- | Extract the name of a function, possibly inside an attribute node.
--
-- Non-function nodes result in 'Nothing'.
functionName :: Show a => Node (Lexeme a) -> Maybe a
functionName :: Node (Lexeme a) -> Maybe a
functionName (Fix (FunctionPrototype Node (Lexeme a)
_ (L AlexPosn
_ LexemeClass
IdVar a
name) [Node (Lexeme a)]
_)) = a -> Maybe a
forall a. a -> Maybe a
Just a
name
functionName (Fix (FunctionDecl Scope
_ Node (Lexeme a)
proto  )) = Node (Lexeme a) -> Maybe a
forall a. Show a => Node (Lexeme a) -> Maybe a
functionName Node (Lexeme a)
proto
functionName (Fix (FunctionDefn Scope
_ Node (Lexeme a)
proto Node (Lexeme a)
_)) = Node (Lexeme a) -> Maybe a
forall a. Show a => Node (Lexeme a) -> Maybe a
functionName Node (Lexeme a)
proto
functionName (Fix (AttrPrintf Lexeme a
_ Lexeme a
_ Node (Lexeme a)
entity))  = Node (Lexeme a) -> Maybe a
forall a. Show a => Node (Lexeme a) -> Maybe a
functionName Node (Lexeme a)
entity
functionName (Fix (NonNull [Lexeme a]
_ [Lexeme a]
_ Node (Lexeme a)
entity))     = Node (Lexeme a) -> Maybe a
forall a. Show a => Node (Lexeme a) -> Maybe a
functionName Node (Lexeme a)
entity
functionName Node (Lexeme a)
_                              = Maybe a
forall a. Maybe a
Nothing


-- Semantic equality: nodes are the same, except for source locations.
semEq :: Node (Lexeme Text) -> Node (Lexeme Text) -> Bool
semEq :: Node (Lexeme Text) -> Node (Lexeme Text) -> Bool
semEq Node (Lexeme Text)
a Node (Lexeme Text)
b = Node (Lexeme Text) -> Node (Lexeme Text)
removeSloc Node (Lexeme Text)
a Node (Lexeme Text) -> Node (Lexeme Text) -> Bool
forall a. Eq a => a -> a -> Bool
== Node (Lexeme Text) -> Node (Lexeme Text)
removeSloc Node (Lexeme Text)
b


-- Don't apply the linter to certain files.
skip :: [FilePath] -> (FilePath, [Node (Lexeme Text)]) -> (FilePath, [Node (Lexeme Text)])
skip :: [[Char]]
-> ([Char], [Node (Lexeme Text)]) -> ([Char], [Node (Lexeme Text)])
skip [[Char]]
fps ([Char]
fp, [Node (Lexeme Text)]
_) | ([Char] -> Bool) -> [[Char]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ([Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`List.isSuffixOf` [Char]
fp) [[Char]]
fps = ([Char]
fp, [])
skip [[Char]]
_ ([Char], [Node (Lexeme Text)])
tu = ([Char], [Node (Lexeme Text)])
tu

(>+>) :: Monad m => (t -> m ()) -> (t -> m ()) -> t -> m ()
>+> :: (t -> m ()) -> (t -> m ()) -> t -> m ()
(>+>) t -> m ()
f t -> m ()
g t
x = t -> m ()
f t
x m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> t -> m ()
g t
x