{-# LANGUAGE StrictData #-} module Language.Cimple.SemCheck.Includes ( collectIncludes , normaliseIncludes ) where import Control.Monad.State.Lazy (State) import qualified Control.Monad.State.Lazy as State import Data.Text (Text) import qualified Data.Text as Text import Language.Cimple.AST (Node (..)) import Language.Cimple.Lexer (Lexeme (..)) import Language.Cimple.Tokens (LexemeClass (..)) import Language.Cimple.TranslationUnit (TranslationUnit) import Language.Cimple.TraverseAst (AstActions (..), defaultActions, traverseAst) import System.FilePath (joinPath, splitPath, takeDirectory) collectIncludes :: [FilePath] -> TranslationUnit Text -> [FilePath] -> Either String ((), FilePath, [FilePath]) collectIncludes :: [FilePath] -> TranslationUnit Text -> [FilePath] -> Either FilePath ((), FilePath, [FilePath]) collectIncludes [FilePath] sources (FilePath file, [Node (Lexeme Text)] _) [FilePath] includes = case (FilePath -> Bool) -> [FilePath] -> [FilePath] forall a. (a -> Bool) -> [a] -> [a] filter (Bool -> Bool not (Bool -> Bool) -> (FilePath -> Bool) -> FilePath -> Bool forall b c a. (b -> c) -> (a -> b) -> a -> c . (FilePath -> [FilePath] -> Bool forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool `elem` [FilePath] sources)) [FilePath] includes of [] -> ((), FilePath, [FilePath]) -> Either FilePath ((), FilePath, [FilePath]) forall a b. b -> Either a b Right ((), FilePath file, [FilePath] includes) FilePath missing:[FilePath] _ -> FilePath -> Either FilePath ((), FilePath, [FilePath]) forall a b. a -> Either a b Left (FilePath -> Either FilePath ((), FilePath, [FilePath])) -> FilePath -> Either FilePath ((), FilePath, [FilePath]) forall a b. (a -> b) -> a -> b $ FilePath file FilePath -> FilePath -> FilePath forall a. Semigroup a => a -> a -> a <> FilePath " includes missing " FilePath -> FilePath -> FilePath forall a. Semigroup a => a -> a -> a <> FilePath missing relativeTo :: FilePath -> FilePath -> FilePath relativeTo :: FilePath -> FilePath -> FilePath relativeTo FilePath "." FilePath file = FilePath file relativeTo FilePath dir FilePath file = [FilePath] -> [FilePath] -> FilePath go (FilePath -> [FilePath] splitPath FilePath dir) (FilePath -> [FilePath] splitPath FilePath file) where go :: [FilePath] -> [FilePath] -> FilePath go [FilePath] d (FilePath "../":[FilePath] f) = [FilePath] -> [FilePath] -> FilePath go ([FilePath] -> [FilePath] forall a. [a] -> [a] init [FilePath] d) [FilePath] f go [FilePath] d [FilePath] f = [FilePath] -> FilePath joinPath ([FilePath] d [FilePath] -> [FilePath] -> [FilePath] forall a. [a] -> [a] -> [a] ++ [FilePath] f) normaliseIncludes :: TranslationUnit Text -> (TranslationUnit Text, [FilePath]) normaliseIncludes :: TranslationUnit Text -> (TranslationUnit Text, [FilePath]) normaliseIncludes (FilePath file, [Node (Lexeme Text)] ast) = ((FilePath file, [Node (Lexeme Text)] ast'), [FilePath] includes) where ([Node (Lexeme Text)] ast', [FilePath] includes) = State [FilePath] [Node (Lexeme Text)] -> [FilePath] -> ([Node (Lexeme Text)], [FilePath]) forall s a. State s a -> s -> (a, s) State.runState (AstActions (State [FilePath]) Text -> [Node (Lexeme Text)] -> State [FilePath] [Node (Lexeme Text)] forall a (f :: * -> *). (TraverseAst a, Applicative f) => AstActions f Text -> a -> f a traverseAst (FilePath -> AstActions (State [FilePath]) Text go (FilePath -> FilePath takeDirectory FilePath file)) [Node (Lexeme Text)] ast) [] go :: FilePath -> AstActions (State [FilePath]) Text go :: FilePath -> AstActions (State [FilePath]) Text go FilePath dir = AstActions (State [FilePath]) Text forall (f :: * -> *) lexeme. Applicative f => AstActions f lexeme defaultActions { doNode :: FilePath -> Node (Lexeme Text) -> State [FilePath] (Node (Lexeme Text)) -> State [FilePath] (Node (Lexeme Text)) doNode = \FilePath _ Node (Lexeme Text) node State [FilePath] (Node (Lexeme Text)) act -> case Node (Lexeme Text) node of PreprocInclude (L AlexPosn spos LexemeClass LitString Text include) -> do let includePath :: FilePath includePath = FilePath -> FilePath -> FilePath relativeTo FilePath dir (FilePath -> FilePath) -> FilePath -> FilePath forall a b. (a -> b) -> a -> b $ Text -> FilePath tread Text include ([FilePath] -> [FilePath]) -> State [FilePath] () forall s (m :: * -> *). MonadState s m => (s -> s) -> m () State.modify (FilePath includePath FilePath -> [FilePath] -> [FilePath] forall a. a -> [a] -> [a] :) Node (Lexeme Text) -> State [FilePath] (Node (Lexeme Text)) forall (m :: * -> *) a. Monad m => a -> m a return (Node (Lexeme Text) -> State [FilePath] (Node (Lexeme Text))) -> Node (Lexeme Text) -> State [FilePath] (Node (Lexeme Text)) forall a b. (a -> b) -> a -> b $ Lexeme Text -> Node (Lexeme Text) forall lexeme. lexeme -> Node lexeme PreprocInclude (AlexPosn -> LexemeClass -> Text -> Lexeme Text forall text. AlexPosn -> LexemeClass -> text -> Lexeme text L AlexPosn spos LexemeClass LitString (FilePath -> Text tshow FilePath includePath)) Node (Lexeme Text) _ -> State [FilePath] (Node (Lexeme Text)) act } where tshow :: FilePath -> Text tshow = FilePath -> Text Text.pack (FilePath -> Text) -> (FilePath -> FilePath) -> FilePath -> Text forall b c a. (b -> c) -> (a -> b) -> a -> c . FilePath -> FilePath forall a. Show a => a -> FilePath show tread :: Text -> FilePath tread = FilePath -> FilePath forall a. Read a => FilePath -> a read (FilePath -> FilePath) -> (Text -> FilePath) -> Text -> FilePath forall b c a. (b -> c) -> (a -> b) -> a -> c . Text -> FilePath Text.unpack