Deps.x

{
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
-- | This contains a partial lexer for @.chs@ files; enough to extract
-- information from @{\#import\#}@ declarations.
--
-- This is lenient in that it will not reject things like
-- {\# import const Data.Char \#}
module Language.Haskell.CHs.Deps ( getImports
                                 , getFileImports
                                 ) where

import Control.Applicative ((<$>))
import qualified Data.ByteString.Lazy as BSL
import qualified Data.ByteString.Lazy.Char8 as ASCII
}

%wrapper "monad-bytestring"

$module = [A-Za-z\.]

tokens :-

    $white+                      ;
    <0> "--".*                   ;

    <0> "{-"                     { \_ _ -> nested_comment }

    <chs> "import"               { \_ _ -> alex Import }
    <chs> "qualified"            ;

    <chs> "type"                 { \_ _ -> alex End }
    <chs> "typedef"              { \_ _ -> alex End }
    <chs> "enum"                 { \_ _ -> alex End }
    <chs> "fun"                  { \_ _ -> alex End }
    <chs> "sizeof"               { \_ _ -> alex End }
    <chs> "alignof"              { \_ _ -> alex End }
    <chs> "const"                { \_ _ -> alex End }
    <chs> "call"                 { \_ _ -> alex End }
    <chs> "get"                  { \_ _ -> alex End }
    <chs> "set"                  { \_ _ -> alex End }
    <chs> "offsetof"             { \_ _ -> alex End }

    <chs> "#}"                   { begin 0 }
    <0> "{#"                     { begin chs }
     
                                 -- this is safe because we only allow ASCII module names
    <chs> $module+               { tok (\_ s -> alex (Module $ ASCII.unpack s)) }

    <0> [^\{]+                   ;
    <0> $printable               ;
    <chs> [^\#$module]+          ;

{

data Token = Import
           | Module String
           | End

tok f (p,_,s,_) len = f p (BSL.take len s)

alex :: a -> Alex a
alex = pure

alexEOF :: Alex Token
alexEOF = pure End

-- | Given a 'BSL.ByteString' containing C2Hs, return a list of modules it @{\#import\#}@s.
getImports :: BSL.ByteString -> Either String [String]
getImports = fmap extractDeps . lexC

getFileImports :: FilePath -> IO (Either String [String])
getFileImports = fmap getImports . BSL.readFile

-- from: https://github.com/simonmar/alex/blob/master/examples/haskell.x#L128
nested_comment :: Alex Token
nested_comment = go 1 =<< alexGetInput

    where go :: Int -> AlexInput -> Alex Token
          go 0 input = alexSetInput input *> alexMonadScan
          go n input =
            case alexGetByte input of
                Nothing -> err input
                Just (c, input') ->
                    case c of
                        45 ->
                            case alexGetByte input' of
                                Nothing -> err input'
                                Just (125,input_) -> go (n-1) input_
                                Just (_,input_) -> go n input_
                        123 ->
                            case alexGetByte input' of
                                Nothing -> err input'
                                Just (c',input_) -> go (addLevel c' $ n) input_
                        _ -> go n input'

          addLevel c' = if c' == 45 then (+1) else id

          err (pos,_,_,_) =
            let (AlexPn _ line col) = pos in
                alexError ("Error in nested comment at line " ++ show line ++ ", column " ++ show col)

extractDeps :: [Token] -> [String]
extractDeps []                   = []
extractDeps (Import:Module s:xs) = s : extractDeps xs
extractDeps (_:xs)               = extractDeps xs

lexC :: BSL.ByteString -> Either String [Token]
lexC = flip runAlex loop

loop :: Alex [Token]
loop = do
    tok' <- alexMonadScan
    case tok' of
        End -> pure []
        _ -> (tok' :) <$> loop

}