{-# 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