module Utils.ThankYouStars.Package (
      dependentRepos
    , getCabalFiles
    , readCabalFile
    , readHackageDB
    ) where

import Utils.ThankYouStars.GitHub

import           Data.List
    ( isInfixOf
    , isPrefixOf
    )
import           Data.List.Split                               ( splitOneOf )
import qualified Data.Map                                      as M
import           Data.Maybe
import qualified Data.Set                                      as S
import           Distribution.Hackage.DB
    ( HackageDB
    , cabalFile
    , hackageTarball
    , readTarball
    )
import           Distribution.Package
import           Distribution.PackageDescription
import           Distribution.PackageDescription.Configuration
    ( flattenPackageDescription
    )
import           Distribution.PackageDescription.Parsec
    ( readGenericPackageDescription
    )
import           Distribution.Verbosity                        ( normal )
import           System.Directory
    ( getCurrentDirectory
    , getPermissions
    , listDirectory
    , searchable
    )
import           System.FilePath
    ( combine
    , takeExtension
    )

getCabalFiles :: IO (S.Set FilePath)
getCabalFiles :: IO (Set FilePath)
getCabalFiles = IO FilePath
getCurrentDirectory IO FilePath -> (FilePath -> IO (Set FilePath)) -> IO (Set FilePath)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> IO (Set FilePath)
searchCabalFiles

searchCabalFiles :: FilePath -> IO (S.Set FilePath)
searchCabalFiles :: FilePath -> IO (Set FilePath)
searchCabalFiles FilePath
fp = do
    Permissions
p <- FilePath -> IO Permissions
getPermissions FilePath
fp
    if Permissions -> Bool
searchable Permissions
p
        then do
            [FilePath]
children <- (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> FilePath -> FilePath
combine FilePath
fp) ([FilePath] -> [FilePath])
-> ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter FilePath -> Bool
visible ([FilePath] -> [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO [FilePath]
listDirectory FilePath
fp
            [Set FilePath] -> Set FilePath
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
S.unions ([Set FilePath] -> Set FilePath)
-> IO [Set FilePath] -> IO (Set FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FilePath -> IO (Set FilePath)) -> [FilePath] -> IO [Set FilePath]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM FilePath -> IO (Set FilePath)
searchCabalFiles [FilePath]
children
        else do
            if FilePath -> FilePath
takeExtension FilePath
fp FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
".cabal"
                then Set FilePath -> IO (Set FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (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
S.singleton FilePath
fp
                else Set FilePath -> IO (Set FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (Set FilePath -> IO (Set FilePath))
-> Set FilePath -> IO (Set FilePath)
forall a b. (a -> b) -> a -> b
$ Set FilePath
forall a. Set a
S.empty

visible :: FilePath -> Bool
visible :: FilePath -> Bool
visible FilePath
fp = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ FilePath
"." FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` FilePath
fp

readCabalFile :: FilePath -> IO GenericPackageDescription
readCabalFile :: FilePath -> IO GenericPackageDescription
readCabalFile = Verbosity -> FilePath -> IO GenericPackageDescription
readGenericPackageDescription Verbosity
normal

dependentRepos :: HackageDB -> GenericPackageDescription -> S.Set GitHubRepo
dependentRepos :: HackageDB -> GenericPackageDescription -> Set GitHubRepo
dependentRepos HackageDB
db GenericPackageDescription
desc = (Maybe GitHubRepo -> GitHubRepo)
-> Set (Maybe GitHubRepo) -> Set GitHubRepo
forall b a. Ord b => (a -> b) -> Set a -> Set b
S.map Maybe GitHubRepo -> GitHubRepo
forall a. HasCallStack => Maybe a -> a
fromJust (Set (Maybe GitHubRepo) -> Set GitHubRepo)
-> Set (Maybe GitHubRepo) -> Set GitHubRepo
forall a b. (a -> b) -> a -> b
$ (Maybe GitHubRepo -> Bool)
-> Set (Maybe GitHubRepo) -> Set (Maybe GitHubRepo)
forall a. (a -> Bool) -> Set a -> Set a
S.filter Maybe GitHubRepo -> Bool
forall a. Maybe a -> Bool
isJust Set (Maybe GitHubRepo)
mRepos
    where
        excepts :: [PackageName]
excepts = [FilePath -> PackageName
mkPackageName FilePath
"base", GenericPackageDescription -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageName GenericPackageDescription
desc]
        pkgs :: Set PackageName
pkgs    = (PackageName -> Set PackageName -> Set PackageName)
-> Set PackageName -> [PackageName] -> Set PackageName
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr PackageName -> Set PackageName -> Set PackageName
forall a. Ord a => a -> Set a -> Set a
S.delete (GenericPackageDescription -> Set PackageName
allDependencies GenericPackageDescription
desc) [PackageName]
excepts
        mRepos :: Set (Maybe GitHubRepo)
mRepos  = (PackageName -> Maybe GitHubRepo)
-> Set PackageName -> Set (Maybe GitHubRepo)
forall b a. Ord b => (a -> b) -> Set a -> Set b
S.map ((PackageName -> HackageDB -> Maybe GitHubRepo)
-> HackageDB -> PackageName -> Maybe GitHubRepo
forall a b c. (a -> b -> c) -> b -> a -> c
flip PackageName -> HackageDB -> Maybe GitHubRepo
lookupRepo (HackageDB -> PackageName -> Maybe GitHubRepo)
-> HackageDB -> PackageName -> Maybe GitHubRepo
forall a b. (a -> b) -> a -> b
$ HackageDB
db) Set PackageName
pkgs

allDependencies :: GenericPackageDescription -> S.Set PackageName
allDependencies :: GenericPackageDescription -> Set PackageName
allDependencies = [PackageName] -> Set PackageName
forall a. Ord a => [a] -> Set a
S.fromList ([PackageName] -> Set PackageName)
-> (GenericPackageDescription -> [PackageName])
-> GenericPackageDescription
-> Set PackageName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Dependency -> PackageName) -> [Dependency] -> [PackageName]
forall a b. (a -> b) -> [a] -> [b]
map Dependency -> PackageName
toPackageName ([Dependency] -> [PackageName])
-> (GenericPackageDescription -> [Dependency])
-> GenericPackageDescription
-> [PackageName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageDescription -> [Dependency]
allBuildDepends (PackageDescription -> [Dependency])
-> (GenericPackageDescription -> PackageDescription)
-> GenericPackageDescription
-> [Dependency]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenericPackageDescription -> PackageDescription
flattenPackageDescription
    where
        toPackageName :: Dependency -> PackageName
toPackageName (Dependency PackageName
name VersionRange
_ Set LibraryName
_) = PackageName
name

lookupRepo :: PackageName -> HackageDB -> Maybe GitHubRepo
lookupRepo :: PackageName -> HackageDB -> Maybe GitHubRepo
lookupRepo PackageName
pkg HackageDB
db = [GitHubRepo] -> Maybe GitHubRepo
forall a. [a] -> Maybe a
listToMaybe ([GitHubRepo] -> Maybe GitHubRepo)
-> ([SourceRepo] -> [GitHubRepo])
-> [SourceRepo]
-> Maybe GitHubRepo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe GitHubRepo] -> [GitHubRepo]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe GitHubRepo] -> [GitHubRepo])
-> ([SourceRepo] -> [Maybe GitHubRepo])
-> [SourceRepo]
-> [GitHubRepo]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SourceRepo -> Maybe GitHubRepo)
-> [SourceRepo] -> [Maybe GitHubRepo]
forall a b. (a -> b) -> [a] -> [b]
map SourceRepo -> Maybe GitHubRepo
parseRepo ([SourceRepo] -> Maybe GitHubRepo)
-> [SourceRepo] -> Maybe GitHubRepo
forall a b. (a -> b) -> a -> b
$ [SourceRepo]
repos
    where
        repos :: [SourceRepo]
repos   = [SourceRepo] -> Maybe [SourceRepo] -> [SourceRepo]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [SourceRepo] -> [SourceRepo])
-> Maybe [SourceRepo] -> [SourceRepo]
forall a b. (a -> b) -> a -> b
$ Map Version VersionData -> [SourceRepo]
forall a. Map a VersionData -> [SourceRepo]
toRepos (Map Version VersionData -> [SourceRepo])
-> Maybe (Map Version VersionData) -> Maybe [SourceRepo]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PackageName -> HackageDB -> Maybe (Map Version VersionData)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup PackageName
pkg HackageDB
db
        toRepos :: Map a VersionData -> [SourceRepo]
toRepos = PackageDescription -> [SourceRepo]
sourceRepos (PackageDescription -> [SourceRepo])
-> (Map a VersionData -> PackageDescription)
-> Map a VersionData
-> [SourceRepo]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenericPackageDescription -> PackageDescription
flattenPackageDescription (GenericPackageDescription -> PackageDescription)
-> (Map a VersionData -> GenericPackageDescription)
-> Map a VersionData
-> PackageDescription
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VersionData -> GenericPackageDescription
cabalFile (VersionData -> GenericPackageDescription)
-> (Map a VersionData -> VersionData)
-> Map a VersionData
-> GenericPackageDescription
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, VersionData) -> VersionData
forall a b. (a, b) -> b
snd ((a, VersionData) -> VersionData)
-> (Map a VersionData -> (a, VersionData))
-> Map a VersionData
-> VersionData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map a VersionData -> (a, VersionData)
forall k a. Map k a -> (k, a)
M.findMax

parseRepo :: SourceRepo -> Maybe GitHubRepo
parseRepo :: SourceRepo -> Maybe GitHubRepo
parseRepo SourceRepo
src = case (SourceRepo -> Maybe RepoType
repoType SourceRepo
src, SourceRepo -> Maybe FilePath
repoLocation SourceRepo
src) of
    (Just RepoType
Git, Just FilePath
loc) -> FilePath -> Maybe GitHubRepo
parseLocation FilePath
loc
    (Maybe RepoType, Maybe FilePath)
_                    -> Maybe GitHubRepo
forall a. Maybe a
Nothing

-- TODO: Too naive parsing
parseLocation :: String -> Maybe GitHubRepo
parseLocation :: FilePath -> Maybe GitHubRepo
parseLocation FilePath
loc
    | Bool
isGitHub Bool -> Bool -> Bool
&& [FilePath] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FilePath]
ps Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
5 =
        GitHubRepo -> Maybe GitHubRepo
forall a. a -> Maybe a
Just (GitHubRepo -> Maybe GitHubRepo) -> GitHubRepo -> Maybe GitHubRepo
forall a b. (a -> b) -> a -> b
$ GitHubRepo :: FilePath -> FilePath -> GitHubRepo
GitHubRepo { owner :: FilePath
owner = [FilePath]
ps [FilePath] -> Int -> FilePath
forall a. [a] -> Int -> a
!! Int
4, repo :: FilePath
repo = [FilePath]
ps [FilePath] -> Int -> FilePath
forall a. [a] -> Int -> a
!! Int
5 }
    | Bool
otherwise     = Maybe GitHubRepo
forall a. Maybe a
Nothing
    where
        isGitHub :: Bool
isGitHub = FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isInfixOf FilePath
"github.com" FilePath
loc
        ps :: [FilePath]
ps       = FilePath -> FilePath -> [FilePath]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOneOf FilePath
"/." FilePath
loc

readHackageDB :: IO HackageDB
readHackageDB :: IO HackageDB
readHackageDB = IO FilePath
hackageTarball IO FilePath -> (FilePath -> IO HackageDB) -> IO HackageDB
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe UTCTime -> FilePath -> IO HackageDB
readTarball Maybe UTCTime
forall a. Maybe a
Nothing