TopSort.hs

-- | Topological sort for @.chs@ files according to @{\#import\#}@s.
module Distribution.C2Hs.TopSort ( reorderC2Hs ) where

import           Control.Applicative                  (pure)
import           Data.Functor                         (($>))
import           Data.Traversable                     (traverse)
import           Distribution.Compat.Graph            (Node (..),
                                                       fromDistinctList,
                                                       revTopSort)
import           Distribution.ModuleName              (ModuleName, toFilePath)
import           Distribution.Parsec                  (simpleParsec)
import           Distribution.Simple.PreProcess.Types (Suffix (..))
import           Distribution.Simple.Utils            (findFileWithExtension,
                                                       warn)
import           Distribution.Verbosity               (Verbosity)
import           Language.Haskell.CHs.Deps            (getFileImports)

-- | Given a list of 'ModuleName's, sort it according to @c2hs@ @{\#import\#}@
-- declarations.
reorderC2Hs :: Verbosity
            -> [FilePath] -- ^ Source directories
            -> [ModuleName] -- ^ Module names
            -> IO [ModuleName] -- ^ Sorted modules
reorderC2Hs v dirs preMods = do

    chsFiles <- traverse findCHS preMods

    modDeps <- traverse (extractDeps v) (zip preMods chsFiles)

    pure $ fmap (\(N m _ _) -> m) (revTopSort $ fromDistinctList modDeps)

        where findCHS = findFileWithExtension [Suffix ".chs"] dirs . toFilePath

-- | Given a 'ModuleName' and its corresponding filepath, return a 'Node'
-- with its associated @c2hs@ dependencies
extractDeps :: Verbosity -> (ModuleName, Maybe FilePath) -> IO (Node ModuleName ModuleName)
extractDeps _ (m, Nothing) = pure (N m m [])
extractDeps v (m, Just f) = do
    res <- getFileImports f
    mods <- case res of
        Right ms -> case traverse simpleParsec ms of
            Just ms' -> pure ms'
            Nothing -> warn v ("Cannot parse module name in .chs file " ++ f) $> []
        Left err -> warn v ("Cannot parse c2hs import in " ++ f ++ ": " ++ err) $> []
    pure (N m m mods)