module Data.Prune.Package where

import Prelude

import Data.Map (Map)
import Data.Set (Set)
import Data.Text (Text, pack)
import Data.Traversable (for)
import Hpack.Config
  ( Section, decodeOptionsTarget, decodeResultPackage, defaultDecodeOptions, packageBenchmarks
  , packageConfig, packageExecutables, packageInternalLibraries, packageLibrary, packageName
  , packageTests, readPackageConfig, sectionDependencies, sectionSourceDirs, unDependencies
  )
import System.Directory (doesDirectoryExist, listDirectory, pathIsSymbolicLink)
import System.FilePath.Posix ((</>), isExtensionOf)
import qualified Data.ByteString as BS
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.Yaml as Yaml

import qualified Data.Prune.Types as T

listFilesRecursive :: FilePath -> IO (Set FilePath)
listFilesRecursive :: FilePath -> IO (Set FilePath)
listFilesRecursive FilePath
dir = do
  [FilePath]
dirs <- FilePath -> IO [FilePath]
listDirectory FilePath
dir
  ([Set FilePath] -> Set FilePath)
-> IO [Set FilePath] -> IO (Set FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Set FilePath] -> Set FilePath
forall a. Monoid a => [a] -> a
mconcat (IO [Set FilePath] -> IO (Set FilePath))
-> ((FilePath -> IO (Set FilePath)) -> IO [Set FilePath])
-> (FilePath -> IO (Set FilePath))
-> IO (Set FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> (FilePath -> IO (Set FilePath)) -> IO [Set FilePath]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [FilePath]
dirs ((FilePath -> IO (Set FilePath)) -> IO (Set FilePath))
-> (FilePath -> IO (Set FilePath)) -> IO (Set FilePath)
forall a b. (a -> b) -> a -> b
$ \case
    -- don't include "hidden" directories, i.e. those that start with a '.'
    Char
'.' : FilePath
_ -> Set FilePath -> IO (Set FilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Set FilePath
forall a. Monoid a => a
mempty
    FilePath
fn -> do
      let
        path :: FilePath
path = if FilePath
dir FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"." then FilePath
fn else FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
fn
      Bool
isDir <- FilePath -> IO Bool
doesDirectoryExist FilePath
path
      Bool
isSymlink <- FilePath -> IO Bool
pathIsSymbolicLink FilePath
path
      case (Bool
isSymlink, Bool
isDir) of
        (Bool
True, Bool
_) -> Set FilePath -> IO (Set FilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Set FilePath
forall a. Monoid a => a
mempty
        (Bool
_, Bool
True) -> FilePath -> IO (Set FilePath)
listFilesRecursive FilePath
path
        (Bool, Bool)
_ -> Set FilePath -> IO (Set FilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Set FilePath -> IO (Set FilePath))
-> Set FilePath -> IO (Set FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> Set FilePath
forall a. a -> Set a
Set.singleton FilePath
path

getSectionDependencyNames :: Section a -> Set T.DependencyName
getSectionDependencyNames :: Section a -> Set DependencyName
getSectionDependencyNames = [DependencyName] -> Set DependencyName
forall a. Ord a => [a] -> Set a
Set.fromList ([DependencyName] -> Set DependencyName)
-> (Section a -> [DependencyName])
-> Section a
-> Set DependencyName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> DependencyName) -> [FilePath] -> [DependencyName]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> DependencyName
T.DependencyName (Text -> DependencyName)
-> (FilePath -> Text) -> FilePath -> DependencyName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
pack) ([FilePath] -> [DependencyName])
-> (Section a -> [FilePath]) -> Section a -> [DependencyName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map FilePath DependencyInfo -> [FilePath]
forall k a. Map k a -> [k]
Map.keys (Map FilePath DependencyInfo -> [FilePath])
-> (Section a -> Map FilePath DependencyInfo)
-> Section a
-> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dependencies -> Map FilePath DependencyInfo
unDependencies (Dependencies -> Map FilePath DependencyInfo)
-> (Section a -> Dependencies)
-> Section a
-> Map FilePath DependencyInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Section a -> Dependencies
forall a. Section a -> Dependencies
sectionDependencies

getSectionFiles :: FilePath -> Section a -> IO (Set FilePath)
getSectionFiles :: FilePath -> Section a -> IO (Set FilePath)
getSectionFiles FilePath
fp Section a
section = ([Set FilePath] -> Set FilePath)
-> IO [Set FilePath] -> IO (Set FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Set FilePath] -> Set FilePath
forall a. Monoid a => [a] -> a
mconcat (IO [Set FilePath] -> IO (Set FilePath))
-> ((FilePath -> IO (Set FilePath)) -> IO [Set FilePath])
-> (FilePath -> IO (Set FilePath))
-> IO (Set FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> (FilePath -> IO (Set FilePath)) -> IO [Set FilePath]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (Section a -> [FilePath]
forall a. Section a -> [FilePath]
sectionSourceDirs Section a
section) ((FilePath -> IO (Set FilePath)) -> IO (Set FilePath))
-> (FilePath -> IO (Set FilePath)) -> IO (Set FilePath)
forall a b. (a -> b) -> a -> b
$ \FilePath
dir -> do
  Set FilePath
allFiles <- FilePath -> IO (Set FilePath)
listFilesRecursive (FilePath -> IO (Set FilePath)) -> FilePath -> IO (Set FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath
fp FilePath -> FilePath -> FilePath
</> FilePath
dir
  Set FilePath -> IO (Set FilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Set FilePath -> IO (Set FilePath))
-> Set FilePath -> IO (Set FilePath)
forall a b. (a -> b) -> a -> b
$ (FilePath -> Bool) -> Set FilePath -> Set FilePath
forall a. (a -> Bool) -> Set a -> Set a
Set.filter (FilePath -> FilePath -> Bool
isExtensionOf FilePath
"hs") Set FilePath
allFiles

getSectionCompilables :: FilePath -> T.CompilableType -> Set T.DependencyName -> Map String (Section a) -> IO [T.Compilable]
getSectionCompilables :: FilePath
-> CompilableType
-> Set DependencyName
-> Map FilePath (Section a)
-> IO [Compilable]
getSectionCompilables FilePath
fp CompilableType
typ Set DependencyName
baseDependencies Map FilePath (Section a)
sections = [(FilePath, Section a)]
-> ((FilePath, Section a) -> IO Compilable) -> IO [Compilable]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (Map FilePath (Section a) -> [(FilePath, Section a)]
forall k a. Map k a -> [(k, a)]
Map.toList Map FilePath (Section a)
sections) (((FilePath, Section a) -> IO Compilable) -> IO [Compilable])
-> ((FilePath, Section a) -> IO Compilable) -> IO [Compilable]
forall a b. (a -> b) -> a -> b
$ \(FilePath
name, Section a
section) -> do
  Set FilePath
sourceFiles <- FilePath -> Section a -> IO (Set FilePath)
forall a. FilePath -> Section a -> IO (Set FilePath)
getSectionFiles FilePath
fp Section a
section
  Compilable -> IO Compilable
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Compilable -> IO Compilable) -> Compilable -> IO Compilable
forall a b. (a -> b) -> a -> b
$ CompilableName
-> CompilableType
-> Set DependencyName
-> Set FilePath
-> Compilable
T.Compilable (Text -> CompilableName
T.CompilableName (FilePath -> Text
pack FilePath
name)) CompilableType
typ (Set DependencyName -> Set DependencyName -> Set DependencyName
forall a. Ord a => Set a -> Set a -> Set a
Set.difference (Section a -> Set DependencyName
forall a. Section a -> Set DependencyName
getSectionDependencyNames Section a
section) Set DependencyName
baseDependencies) Set FilePath
sourceFiles

parsePackageYaml :: FilePath -> IO T.Package
parsePackageYaml :: FilePath -> IO Package
parsePackageYaml FilePath
fp = do
  Package
package <- (FilePath -> IO Package)
-> (DecodeResult -> IO Package)
-> Either FilePath DecodeResult
-> IO Package
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either FilePath -> IO Package
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (Package -> IO Package
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Package -> IO Package)
-> (DecodeResult -> Package) -> DecodeResult -> IO Package
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DecodeResult -> Package
decodeResultPackage) (Either FilePath DecodeResult -> IO Package)
-> IO (Either FilePath DecodeResult) -> IO Package
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< DecodeOptions -> IO (Either FilePath DecodeResult)
readPackageConfig (DecodeOptions
defaultDecodeOptions { decodeOptionsTarget :: FilePath
decodeOptionsTarget = FilePath
fp FilePath -> FilePath -> FilePath
</> FilePath
packageConfig })
  let baseDependencies :: Set DependencyName
baseDependencies = Set DependencyName
-> (Section Library -> Set DependencyName)
-> Maybe (Section Library)
-> Set DependencyName
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Set DependencyName
forall a. Monoid a => a
mempty Section Library -> Set DependencyName
forall a. Section a -> Set DependencyName
getSectionDependencyNames (Maybe (Section Library) -> Set DependencyName)
-> Maybe (Section Library) -> Set DependencyName
forall a b. (a -> b) -> a -> b
$ Package -> Maybe (Section Library)
packageLibrary Package
package
  [Compilable]
libraries         <- FilePath
-> CompilableType
-> Set DependencyName
-> Map FilePath (Section Library)
-> IO [Compilable]
forall a.
FilePath
-> CompilableType
-> Set DependencyName
-> Map FilePath (Section a)
-> IO [Compilable]
getSectionCompilables FilePath
fp CompilableType
T.CompilableTypeLibrary    Set DependencyName
baseDependencies (Map FilePath (Section Library) -> IO [Compilable])
-> Map FilePath (Section Library) -> IO [Compilable]
forall a b. (a -> b) -> a -> b
$ Map FilePath (Section Library)
-> (Section Library -> Map FilePath (Section Library))
-> Maybe (Section Library)
-> Map FilePath (Section Library)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Map FilePath (Section Library)
forall a. Monoid a => a
mempty (FilePath -> Section Library -> Map FilePath (Section Library)
forall k a. k -> a -> Map k a
Map.singleton (Package -> FilePath
packageName Package
package)) (Maybe (Section Library) -> Map FilePath (Section Library))
-> Maybe (Section Library) -> Map FilePath (Section Library)
forall a b. (a -> b) -> a -> b
$ Package -> Maybe (Section Library)
packageLibrary Package
package
  [Compilable]
internalLibraries <- FilePath
-> CompilableType
-> Set DependencyName
-> Map FilePath (Section Library)
-> IO [Compilable]
forall a.
FilePath
-> CompilableType
-> Set DependencyName
-> Map FilePath (Section a)
-> IO [Compilable]
getSectionCompilables FilePath
fp CompilableType
T.CompilableTypeLibrary    Set DependencyName
baseDependencies (Map FilePath (Section Library) -> IO [Compilable])
-> Map FilePath (Section Library) -> IO [Compilable]
forall a b. (a -> b) -> a -> b
$ Package -> Map FilePath (Section Library)
packageInternalLibraries Package
package
  [Compilable]
executables       <- FilePath
-> CompilableType
-> Set DependencyName
-> Map FilePath (Section Executable)
-> IO [Compilable]
forall a.
FilePath
-> CompilableType
-> Set DependencyName
-> Map FilePath (Section a)
-> IO [Compilable]
getSectionCompilables FilePath
fp CompilableType
T.CompilableTypeExecutable Set DependencyName
baseDependencies (Map FilePath (Section Executable) -> IO [Compilable])
-> Map FilePath (Section Executable) -> IO [Compilable]
forall a b. (a -> b) -> a -> b
$ Package -> Map FilePath (Section Executable)
packageExecutables Package
package
  [Compilable]
tests             <- FilePath
-> CompilableType
-> Set DependencyName
-> Map FilePath (Section Executable)
-> IO [Compilable]
forall a.
FilePath
-> CompilableType
-> Set DependencyName
-> Map FilePath (Section a)
-> IO [Compilable]
getSectionCompilables FilePath
fp CompilableType
T.CompilableTypeTest       Set DependencyName
baseDependencies (Map FilePath (Section Executable) -> IO [Compilable])
-> Map FilePath (Section Executable) -> IO [Compilable]
forall a b. (a -> b) -> a -> b
$ Package -> Map FilePath (Section Executable)
packageTests Package
package
  [Compilable]
benchmarks        <- FilePath
-> CompilableType
-> Set DependencyName
-> Map FilePath (Section Executable)
-> IO [Compilable]
forall a.
FilePath
-> CompilableType
-> Set DependencyName
-> Map FilePath (Section a)
-> IO [Compilable]
getSectionCompilables FilePath
fp CompilableType
T.CompilableTypeBenchmark  Set DependencyName
baseDependencies (Map FilePath (Section Executable) -> IO [Compilable])
-> Map FilePath (Section Executable) -> IO [Compilable]
forall a b. (a -> b) -> a -> b
$ Package -> Map FilePath (Section Executable)
packageBenchmarks Package
package
  Package -> IO Package
forall (f :: * -> *) a. Applicative f => a -> f a
pure Package :: Text -> Set DependencyName -> [Compilable] -> Package
T.Package
    { packageName :: Text
packageName = FilePath -> Text
pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ Package -> FilePath
packageName Package
package
    , packageBaseDependencies :: Set DependencyName
packageBaseDependencies = Set DependencyName
baseDependencies
    , packageCompilables :: [Compilable]
packageCompilables = [Compilable]
libraries [Compilable] -> [Compilable] -> [Compilable]
forall a. Semigroup a => a -> a -> a
<> [Compilable]
internalLibraries [Compilable] -> [Compilable] -> [Compilable]
forall a. Semigroup a => a -> a -> a
<> [Compilable]
executables [Compilable] -> [Compilable] -> [Compilable]
forall a. Semigroup a => a -> a -> a
<> [Compilable]
tests [Compilable] -> [Compilable] -> [Compilable]
forall a. Semigroup a => a -> a -> a
<> [Compilable]
benchmarks
    }

parseStackYaml :: FilePath -> [Text] -> IO [T.Package]
parseStackYaml :: FilePath -> [Text] -> IO [Package]
parseStackYaml FilePath
stackYamlFile [Text]
packages = do
  T.StackYaml {[FilePath]
stackYamlPackages :: StackYaml -> [FilePath]
stackYamlPackages :: [FilePath]
..} <- (ParseException -> IO StackYaml)
-> (StackYaml -> IO StackYaml)
-> Either ParseException StackYaml
-> IO StackYaml
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (FilePath -> IO StackYaml
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> IO StackYaml)
-> (ParseException -> FilePath) -> ParseException -> IO StackYaml
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath
"Couldn't parse stack.yaml due to " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<>) (FilePath -> FilePath)
-> (ParseException -> FilePath) -> ParseException -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseException -> FilePath
forall a. Show a => a -> FilePath
show) StackYaml -> IO StackYaml
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ParseException StackYaml -> IO StackYaml)
-> (ByteString -> Either ParseException StackYaml)
-> ByteString
-> IO StackYaml
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either ParseException StackYaml
forall a. FromJSON a => ByteString -> Either ParseException a
Yaml.decodeEither' (ByteString -> IO StackYaml) -> IO ByteString -> IO StackYaml
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FilePath -> IO ByteString
BS.readFile FilePath
stackYamlFile
  [Package]
rawPackages <- (FilePath -> IO Package) -> [FilePath] -> IO [Package]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse FilePath -> IO Package
parsePackageYaml [FilePath]
stackYamlPackages
  if [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
packages
    then [Package] -> IO [Package]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Package]
rawPackages
    else [Package] -> IO [Package]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Package] -> IO [Package]) -> [Package] -> IO [Package]
forall a b. (a -> b) -> a -> b
$ (Package -> Bool) -> [Package] -> [Package]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Text -> [Text] -> Bool) -> [Text] -> Text -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem [Text]
packages (Text -> Bool) -> (Package -> Text) -> Package -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Package -> Text
T.packageName) [Package]
rawPackages