-- |Utilities for parsing imports from Haskell source files.
module Data.Prune.ImportParser where

import Prelude

import Control.Applicative ((<|>), optional, some)
import Control.Arrow (left)
import Control.Monad (void)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Control.Monad.Logger (MonadLogger, logDebug, logError)
import Data.List (isPrefixOf)
import Data.Map (Map)
import Data.Maybe (fromMaybe)
import Data.Set (Set)
import Data.Text (pack)
import Data.Traversable (for)
import Data.Void (Void)
import Text.Megaparsec (Parsec, between, oneOf, parse)
import Text.Megaparsec.Char (alphaNumChar, char, space, string, symbolChar, upperChar)
import qualified Data.Map as Map
import qualified Data.Set as Set

import qualified Data.Prune.Types as T

type Parser = Parsec Void String

padded :: Parser a -> Parser a
padded :: Parser a -> Parser a
padded = ParsecT Void String Identity ()
-> ParsecT Void String Identity () -> Parser a -> Parser a
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between ParsecT Void String Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space ParsecT Void String Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space

quoted :: Parser a -> Parser a
quoted :: Parser a -> Parser a
quoted = ParsecT Void String Identity String
-> ParsecT Void String Identity String -> Parser a -> Parser a
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (String -> ParsecT Void String Identity String
ptoken String
"\"") (String -> ParsecT Void String Identity String
ptoken String
"\"")

ptoken :: String -> Parser String
ptoken :: String -> ParsecT Void String Identity String
ptoken = ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall a. Parser a -> Parser a
padded (ParsecT Void String Identity String
 -> ParsecT Void String Identity String)
-> (String -> ParsecT Void String Identity String)
-> String
-> ParsecT Void String Identity String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ParsecT Void String Identity String
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string

operator :: Parser String
operator :: ParsecT Void String Identity String
operator = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String)
-> ParsecT Void String Identity [String]
-> ParsecT Void String Identity String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ParsecT Void String Identity String]
-> ParsecT Void String Identity [String]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [String -> ParsecT Void String Identity String
ptoken String
"(", ParsecT Void String Identity String
symbolChars, String -> ParsecT Void String Identity String
ptoken String
")"]

symbolChars :: Parser String
symbolChars :: ParsecT Void String Identity String
symbolChars = ParsecT Void String Identity Char
-> ParsecT Void String Identity String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some ([Token String] -> ParsecT Void String Identity (Token String)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
oneOf (String
"!#$%&*+./<=>?@^|-~:\\" :: String)) ParsecT Void String Identity String
-> ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void String Identity Char
-> ParsecT Void String Identity String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some ParsecT Void String Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
symbolChar

symbol' :: Parser String
symbol' :: ParsecT Void String Identity String
symbol' = ParsecT Void String Identity String
operator ParsecT Void String Identity String
-> ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void String Identity Char
-> ParsecT Void String Identity String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some (ParsecT Void String Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
alphaNumChar ParsecT Void String Identity Char
-> ParsecT Void String Identity Char
-> ParsecT Void String Identity Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Token String] -> ParsecT Void String Identity (Token String)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
oneOf (String
"._'" :: String))

symbol :: Parser String
symbol :: ParsecT Void String Identity String
symbol = ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall a. Parser a -> Parser a
padded ParsecT Void String Identity String
symbol'

moduleName :: Parser String
moduleName :: ParsecT Void String Identity String
moduleName = ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall a. Parser a -> Parser a
padded (ParsecT Void String Identity String
 -> ParsecT Void String Identity String)
-> ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall a b. (a -> b) -> a -> b
$ ([String] -> String)
-> ParsecT Void String Identity [String]
-> ParsecT Void String Identity String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [String] -> String
forall a. Monoid a => [a] -> a
mconcat (ParsecT Void String Identity [String]
 -> ParsecT Void String Identity String)
-> ParsecT Void String Identity [String]
-> ParsecT Void String Identity String
forall a b. (a -> b) -> a -> b
$ ParsecT Void String Identity String
-> ParsecT Void String Identity [String]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some (ParsecT Void String Identity String
 -> ParsecT Void String Identity [String])
-> ParsecT Void String Identity String
-> ParsecT Void String Identity [String]
forall a b. (a -> b) -> a -> b
$ ([String] -> String)
-> ParsecT Void String Identity [String]
-> ParsecT Void String Identity String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [String] -> String
forall a. Monoid a => [a] -> a
mconcat (ParsecT Void String Identity [String]
 -> ParsecT Void String Identity String)
-> ParsecT Void String Identity [String]
-> ParsecT Void String Identity String
forall a b. (a -> b) -> a -> b
$ [ParsecT Void String Identity String]
-> ParsecT Void String Identity [String]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [(Char -> String -> String
forall a. a -> [a] -> [a]
:[]) (Char -> String)
-> ParsecT Void String Identity Char
-> ParsecT Void String Identity String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void String Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
upperChar, ParsecT Void String Identity String
symbol']

pkgName :: Parser String
pkgName :: ParsecT Void String Identity String
pkgName = ParsecT Void String Identity Char
-> ParsecT Void String Identity String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some (ParsecT Void String Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
alphaNumChar ParsecT Void String Identity Char
-> ParsecT Void String Identity Char
-> ParsecT Void String Identity Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Token String -> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'-')

oneImport :: Parser T.ModuleName
oneImport :: Parser ModuleName
oneImport = ParsecT Void String Identity String
-> ParsecT Void String Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Tokens String -> ParsecT Void String Identity (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens String
"import") ParsecT Void String Identity ()
-> ParsecT Void String Identity ()
-> ParsecT Void String Identity ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void String Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space
  ParsecT Void String Identity ()
-> ParsecT Void String Identity (Maybe ())
-> ParsecT Void String Identity (Maybe ())
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void String Identity ()
-> ParsecT Void String Identity (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT Void String Identity String
-> ParsecT Void String Identity String
-> ParsecT Void String Identity ()
-> ParsecT Void String Identity ()
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between ParsecT Void String Identity String
"{-#" ParsecT Void String Identity String
"#-}" (ParsecT Void String Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space ParsecT Void String Identity ()
-> ParsecT Void String Identity ()
-> ParsecT Void String Identity ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void String Identity String
-> ParsecT Void String Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Tokens String -> ParsecT Void String Identity (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens String
"SOURCE") ParsecT Void String Identity ()
-> ParsecT Void String Identity ()
-> ParsecT Void String Identity ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void String Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space) ParsecT Void String Identity ()
-> ParsecT Void String Identity ()
-> ParsecT Void String Identity ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void String Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space)
  ParsecT Void String Identity (Maybe ())
-> ParsecT Void String Identity (Maybe ())
-> ParsecT Void String Identity (Maybe ())
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void String Identity ()
-> ParsecT Void String Identity (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT Void String Identity String
-> ParsecT Void String Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Tokens String -> ParsecT Void String Identity (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens String
"qualified") ParsecT Void String Identity ()
-> ParsecT Void String Identity ()
-> ParsecT Void String Identity ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void String Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space)
  ParsecT Void String Identity (Maybe ())
-> ParsecT Void String Identity (Maybe ())
-> ParsecT Void String Identity (Maybe ())
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void String Identity ()
-> ParsecT Void String Identity (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT Void String Identity String
-> ParsecT Void String Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall a. Parser a -> Parser a
padded (ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall a. Parser a -> Parser a
quoted ParsecT Void String Identity String
pkgName)) ParsecT Void String Identity ()
-> ParsecT Void String Identity ()
-> ParsecT Void String Identity ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void String Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space)
  ParsecT Void String Identity (Maybe ())
-> Parser ModuleName -> Parser ModuleName
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> ModuleName
T.ModuleName (Text -> ModuleName) -> (String -> Text) -> String -> ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack (String -> ModuleName)
-> ParsecT Void String Identity String -> Parser ModuleName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT Void String Identity String
symbol ParsecT Void String Identity String
-> ParsecT Void String Identity ()
-> ParsecT Void String Identity String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void String Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space))

dependencyName :: Parser T.DependencyName
dependencyName :: Parser DependencyName
dependencyName = ParsecT Void String Identity String
-> ParsecT Void String Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Tokens String -> ParsecT Void String Identity (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens String
"name:") ParsecT Void String Identity ()
-> ParsecT Void String Identity ()
-> ParsecT Void String Identity ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void String Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space
  ParsecT Void String Identity ()
-> Parser DependencyName -> Parser DependencyName
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> DependencyName
T.DependencyName (Text -> DependencyName)
-> (String -> Text) -> String -> DependencyName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack (String -> DependencyName)
-> ParsecT Void String Identity String -> Parser DependencyName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void String Identity String
pkgName)

exposedModules :: Parser (Set T.ModuleName)
exposedModules :: Parser (Set ModuleName)
exposedModules = ParsecT Void String Identity String
-> ParsecT Void String Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Tokens String -> ParsecT Void String Identity (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens String
"exposed-modules:") ParsecT Void String Identity ()
-> ParsecT Void String Identity ()
-> ParsecT Void String Identity ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void String Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space
  ParsecT Void String Identity ()
-> Parser (Set ModuleName) -> Parser (Set ModuleName)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ([ModuleName] -> Set ModuleName
forall a. Ord a => [a] -> Set a
Set.fromList ([ModuleName] -> Set ModuleName)
-> ParsecT Void String Identity [ModuleName]
-> Parser (Set ModuleName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ModuleName -> ParsecT Void String Identity [ModuleName]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some (Text -> ModuleName
T.ModuleName (Text -> ModuleName) -> (String -> Text) -> String -> ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack (String -> ModuleName)
-> ParsecT Void String Identity String -> Parser ModuleName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void String Identity String
moduleName))

-- |Parse a Haskell source file's imports.
parseFileImports :: FilePath -> IO (Either String (Set T.ModuleName))
parseFileImports :: String -> IO (Either String (Set ModuleName))
parseFileImports String
fp = do
  (ParseErrorBundle String Void -> String)
-> Either (ParseErrorBundle String Void) (Set ModuleName)
-> Either String (Set ModuleName)
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left ParseErrorBundle String Void -> String
forall a. Show a => a -> String
show (Either (ParseErrorBundle String Void) (Set ModuleName)
 -> Either String (Set ModuleName))
-> (String
    -> Either (ParseErrorBundle String Void) (Set ModuleName))
-> String
-> Either String (Set ModuleName)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([ModuleName] -> Set ModuleName)
-> Either (ParseErrorBundle String Void) [ModuleName]
-> Either (ParseErrorBundle String Void) (Set ModuleName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [ModuleName] -> Set ModuleName
forall a. Ord a => [a] -> Set a
Set.fromList (Either (ParseErrorBundle String Void) [ModuleName]
 -> Either (ParseErrorBundle String Void) (Set ModuleName))
-> (String -> Either (ParseErrorBundle String Void) [ModuleName])
-> String
-> Either (ParseErrorBundle String Void) (Set ModuleName)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Either (ParseErrorBundle String Void) ModuleName)
-> [String] -> Either (ParseErrorBundle String Void) [ModuleName]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Parser ModuleName
-> String
-> String
-> Either (ParseErrorBundle String Void) ModuleName
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
parse Parser ModuleName
oneImport String
fp) ([String] -> Either (ParseErrorBundle String Void) [ModuleName])
-> (String -> [String])
-> String
-> Either (ParseErrorBundle String Void) [ModuleName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
"import ") ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines
    (String -> Either String (Set ModuleName))
-> IO String -> IO (Either String (Set ModuleName))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO String
readFile String
fp

-- |Parse name from the `ghc-pkg` field description.
parseDependencyName :: String -> Either String (Maybe T.DependencyName)
parseDependencyName :: String -> Either String (Maybe DependencyName)
parseDependencyName String
input =
  if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
input
    then Maybe DependencyName -> Either String (Maybe DependencyName)
forall a b. b -> Either a b
Right Maybe DependencyName
forall a. Maybe a
Nothing
    else (ParseErrorBundle String Void -> String)
-> Either (ParseErrorBundle String Void) (Maybe DependencyName)
-> Either String (Maybe DependencyName)
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left ParseErrorBundle String Void -> String
forall a. Show a => a -> String
show (Either (ParseErrorBundle String Void) (Maybe DependencyName)
 -> Either String (Maybe DependencyName))
-> (String
    -> Either (ParseErrorBundle String Void) (Maybe DependencyName))
-> String
-> Either String (Maybe DependencyName)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DependencyName -> Maybe DependencyName)
-> Either (ParseErrorBundle String Void) DependencyName
-> Either (ParseErrorBundle String Void) (Maybe DependencyName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DependencyName -> Maybe DependencyName
forall a. a -> Maybe a
Just (Either (ParseErrorBundle String Void) DependencyName
 -> Either (ParseErrorBundle String Void) (Maybe DependencyName))
-> (String -> Either (ParseErrorBundle String Void) DependencyName)
-> String
-> Either (ParseErrorBundle String Void) (Maybe DependencyName)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser DependencyName
-> String
-> String
-> Either (ParseErrorBundle String Void) DependencyName
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
parse Parser DependencyName
dependencyName String
"" (String -> Either String (Maybe DependencyName))
-> String -> Either String (Maybe DependencyName)
forall a b. (a -> b) -> a -> b
$ String
input

-- |Parse exposed modules from the `ghc-pkg` field description.
parseExposedModules :: String -> Either String (Set T.ModuleName)
parseExposedModules :: String -> Either String (Set ModuleName)
parseExposedModules String
input =
  if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
input
    then Set ModuleName -> Either String (Set ModuleName)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Set ModuleName
forall a. Monoid a => a
mempty
    else (ParseErrorBundle String Void -> String)
-> Either (ParseErrorBundle String Void) (Set ModuleName)
-> Either String (Set ModuleName)
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left ParseErrorBundle String Void -> String
forall a. Show a => a -> String
show (Either (ParseErrorBundle String Void) (Set ModuleName)
 -> Either String (Set ModuleName))
-> Either (ParseErrorBundle String Void) (Set ModuleName)
-> Either String (Set ModuleName)
forall a b. (a -> b) -> a -> b
$ Parser (Set ModuleName)
-> String
-> String
-> Either (ParseErrorBundle String Void) (Set ModuleName)
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
parse Parser (Set ModuleName)
exposedModules String
"" String
input

-- |Get the dependencies used by a list of modules imported by a Haskell source file.
getUsedDependencies :: Map T.ModuleName (Set T.DependencyName) -> Set T.ModuleName -> Set T.DependencyName
getUsedDependencies :: Map ModuleName (Set DependencyName)
-> Set ModuleName -> Set DependencyName
getUsedDependencies Map ModuleName (Set DependencyName)
dependencyByModule = (ModuleName -> Set DependencyName -> Set DependencyName)
-> Set DependencyName -> [ModuleName] -> Set DependencyName
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ModuleName -> Set DependencyName -> Set DependencyName
go Set DependencyName
forall a. Monoid a => a
mempty ([ModuleName] -> Set DependencyName)
-> (Set ModuleName -> [ModuleName])
-> Set ModuleName
-> Set DependencyName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set ModuleName -> [ModuleName]
forall a. Set a -> [a]
Set.toList
  where
    go :: ModuleName -> Set DependencyName -> Set DependencyName
go ModuleName
next Set DependencyName
acc = Set DependencyName
acc Set DependencyName -> Set DependencyName -> Set DependencyName
forall a. Semigroup a => a -> a -> a
<> Set DependencyName
-> Maybe (Set DependencyName) -> Set DependencyName
forall a. a -> Maybe a -> a
fromMaybe Set DependencyName
forall a. Monoid a => a
mempty (ModuleName
-> Map ModuleName (Set DependencyName)
-> Maybe (Set DependencyName)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ModuleName
next Map ModuleName (Set DependencyName)
dependencyByModule)

-- |Get the dependencies used by a thing to compile by (1) parsing each source file's imports, (2) getting the
-- dependencies each of those files use, and (3) smooshing all the dependencies together to return.
getCompilableUsedDependencies :: (MonadIO m, MonadLogger m) => Map T.ModuleName (Set T.DependencyName) -> T.Compilable -> m (Set T.DependencyName)
getCompilableUsedDependencies :: Map ModuleName (Set DependencyName)
-> Compilable -> m (Set DependencyName)
getCompilableUsedDependencies Map ModuleName (Set DependencyName)
dependencyByModule T.Compilable {Set String
Set DependencyName
CompilableName
CompilableType
compilableFiles :: Compilable -> Set String
compilableDependencies :: Compilable -> Set DependencyName
compilableType :: Compilable -> CompilableType
compilableName :: Compilable -> CompilableName
compilableFiles :: Set String
compilableDependencies :: Set DependencyName
compilableType :: CompilableType
compilableName :: CompilableName
..} = ([Set DependencyName] -> Set DependencyName)
-> m [Set DependencyName] -> m (Set DependencyName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Set DependencyName] -> Set DependencyName
forall a. Monoid a => [a] -> a
mconcat (m [Set DependencyName] -> m (Set DependencyName))
-> ((String -> m (Set DependencyName)) -> m [Set DependencyName])
-> (String -> m (Set DependencyName))
-> m (Set DependencyName)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String]
-> (String -> m (Set DependencyName)) -> m [Set DependencyName]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (Set String -> [String]
forall a. Set a -> [a]
Set.toList Set String
compilableFiles) ((String -> m (Set DependencyName)) -> m (Set DependencyName))
-> (String -> m (Set DependencyName)) -> m (Set DependencyName)
forall a b. (a -> b) -> a -> b
$ \String
fp -> do
  IO (Either String (Set ModuleName))
-> m (Either String (Set ModuleName))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO (Either String (Set ModuleName))
parseFileImports String
fp) m (Either String (Set ModuleName))
-> (Either String (Set ModuleName) -> m (Set DependencyName))
-> m (Set DependencyName)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Left String
err -> do
      Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
pack :: String -> Text
$logError (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Failed to parse imports for " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
pack String
fp Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" due to " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
pack (String -> String
forall a. Show a => a -> String
show String
err)
      Set DependencyName -> m (Set DependencyName)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Set DependencyName
forall a. Monoid a => a
mempty
    Right Set ModuleName
moduleNames -> do
      Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
pack :: String -> Text
$logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Got module names for " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
pack String
fp Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
pack (Set ModuleName -> String
forall a. Show a => a -> String
show Set ModuleName
moduleNames)
      let usedDependencies :: Set DependencyName
usedDependencies = Map ModuleName (Set DependencyName)
-> Set ModuleName -> Set DependencyName
getUsedDependencies Map ModuleName (Set DependencyName)
dependencyByModule Set ModuleName
moduleNames
      Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
pack :: String -> Text
$logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Got dependency names for " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
pack String
fp Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
pack (Set DependencyName -> String
forall a. Show a => a -> String
show Set DependencyName
usedDependencies)
      Set DependencyName -> m (Set DependencyName)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Set DependencyName
usedDependencies