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))
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
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
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
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)
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