{-# LANGUAGE Strict     #-}
{-# LANGUAGE StrictData #-}
module Language.Cimple.SemCheck.Includes
  ( collectIncludes
  , normaliseIncludes
  ) where

import           Control.Monad.State.Strict      (State)
import qualified Control.Monad.State.Strict      as State
import           Data.Fix                        (Fix (..))
import           Data.Text                       (Text)
import qualified Data.Text                       as Text
import           Language.Cimple.Ast             (NodeF (..))
import           Language.Cimple.Lexer           (Lexeme (..))
import           Language.Cimple.MapAst          (IdentityActions, doNode,
                                                  identityActions, mapAst)
import           Language.Cimple.Tokens          (LexemeClass (..))
import           Language.Cimple.TranslationUnit (TranslationUnit)
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' :: FilePath -> IdentityActions (State [FilePath]) Text
normaliseIncludes' :: FilePath -> IdentityActions (State [FilePath]) Text
normaliseIncludes' FilePath
dir = IdentityActions (State [FilePath]) Text
forall (f :: * -> *) text. Applicative f => AstActions f text text
identityActions
    { 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
            Fix (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
$ NodeF (Lexeme Text) (Node (Lexeme Text)) -> Node (Lexeme Text)
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NodeF (Lexeme Text) (Node (Lexeme Text)) -> Node (Lexeme Text))
-> NodeF (Lexeme Text) (Node (Lexeme Text)) -> Node (Lexeme Text)
forall a b. (a -> b) -> a -> b
$ Lexeme Text -> NodeF (Lexeme Text) (Node (Lexeme Text))
forall lexeme a. lexeme -> NodeF lexeme a
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


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 (IdentityActions (State [FilePath]) Text
-> [Node (Lexeme Text)]
-> StateT
     [FilePath] Identity (Mapped Text Text [Node (Lexeme Text)])
forall itext otext a (f :: * -> *).
(MapAst itext otext a, Applicative f) =>
AstActions f itext otext -> a -> f (Mapped itext otext a)
mapAst (FilePath -> IdentityActions (State [FilePath]) Text
normaliseIncludes' (FilePath -> FilePath
takeDirectory FilePath
file)) [Node (Lexeme Text)]
ast) []