{-# LANGUAGE PatternGuards, TupleSections #-}

module Input.Set(setStackage, setPlatform, setGHC) where

import Control.Applicative
import Data.List.Extra
import System.IO.Extra
import qualified Data.Set as Set
import Prelude


-- | Return information about which items are in a particular set.
setStackage :: FilePath -> IO (Set.Set String)
setStackage :: FilePath -> IO (Set FilePath)
setStackage FilePath
file = [FilePath] -> Set FilePath
forall a. Ord a => [a] -> Set a
Set.fromList ([FilePath] -> Set FilePath)
-> (FilePath -> [FilePath]) -> FilePath -> Set FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [FilePath]
forall a. [a]
stackOverflow) ([FilePath] -> [FilePath])
-> (FilePath -> [FilePath]) -> FilePath -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> [FilePath]
f ([FilePath] -> [FilePath])
-> (FilePath -> [FilePath]) -> FilePath -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
lines (FilePath -> Set FilePath) -> IO FilePath -> IO (Set FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO FilePath
readFile' FilePath
file
    where
        stackOverflow :: [a]
stackOverflow = [] -- ["telegram-api","pinchot","gogol-dfareporting"] -- see https://github.com/ndmitchell/hoogle/issues/167

        f :: [FilePath] -> [FilePath]
f (FilePath
x:[FilePath]
xs) | Just FilePath
x <- FilePath -> FilePath -> Maybe FilePath
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix FilePath
"constraints:" FilePath
x =
                    (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map ((FilePath, FilePath) -> FilePath
forall a b. (a, b) -> a
fst ((FilePath, FilePath) -> FilePath)
-> (FilePath -> (FilePath, FilePath)) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> (FilePath, FilePath)
word1) ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (FilePath
" " FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ (Char
' 'Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:FilePath
x) FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath]
xs
                 | Bool
otherwise = [FilePath] -> [FilePath]
f [FilePath]
xs
        f [] = []


setPlatform :: FilePath -> IO (Set.Set String)
setPlatform :: FilePath -> IO (Set FilePath)
setPlatform FilePath
file = FilePath -> [FilePath] -> IO (Set FilePath)
setPlatformWith FilePath
file [FilePath
"incGHCLib",FilePath
"incLib"]

setPlatformWith :: FilePath -> [String] -> IO (Set.Set String)
setPlatformWith :: FilePath -> [FilePath] -> IO (Set FilePath)
setPlatformWith FilePath
file [FilePath]
names = do
    [FilePath]
src <- FilePath -> [FilePath]
lines (FilePath -> [FilePath]) -> IO FilePath -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO FilePath
readFile' FilePath
file
    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. Ord a => [a] -> Set a
Set.fromList [FilePath -> FilePath
forall a. Read a => FilePath -> a
read FilePath
lib | FilePath
",":FilePath
name:FilePath
lib:[FilePath]
_ <- (FilePath -> [FilePath]) -> [FilePath] -> [[FilePath]]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> [FilePath]
words [FilePath]
src, FilePath
name FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath]
names]

setGHC :: FilePath -> IO (Set.Set String)
setGHC :: FilePath -> IO (Set FilePath)
setGHC FilePath
file = FilePath -> [FilePath] -> IO (Set FilePath)
setPlatformWith FilePath
file [FilePath
"incGHCLib"]