{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE RecordWildCards            #-}

module Language.ATS.Package.PackageSet ( ATSPackageSet (..)
                                       , setBuildPlan
                                       , displayList
                                       ) where

import qualified Data.ByteString.Lazy       as BSL
import           Data.Dependency
import           Data.List                  (nubBy)
import qualified Data.Map                   as M
import qualified Data.Set                   as S
import qualified Data.Text                  as T
import           Language.ATS.Package.Error
import           Language.ATS.Package.Type
import           Quaalude

newtype ATSPackageSet = ATSPackageSet { ATSPackageSet -> [ATSDependency]
_atsPkgSet :: [ ATSDependency ] }
    deriving (InputNormalizer -> Decoder ATSPackageSet
(InputNormalizer -> Decoder ATSPackageSet)
-> FromDhall ATSPackageSet
forall a. (InputNormalizer -> Decoder a) -> FromDhall a
autoWith :: InputNormalizer -> Decoder ATSPackageSet
$cautoWith :: InputNormalizer -> Decoder ATSPackageSet
FromDhall)

atsPkgSet :: Lens' ATSPackageSet [ATSDependency]
atsPkgSet :: ([ATSDependency] -> f [ATSDependency])
-> ATSPackageSet -> f ATSPackageSet
atsPkgSet [ATSDependency] -> f [ATSDependency]
f ATSPackageSet
s = ([ATSDependency] -> ATSPackageSet)
-> f [ATSDependency] -> f ATSPackageSet
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\[ATSDependency]
x -> ATSPackageSet
s { _atsPkgSet :: [ATSDependency]
_atsPkgSet = [ATSDependency]
x }) ([ATSDependency] -> f [ATSDependency]
f (ATSPackageSet -> [ATSDependency]
_atsPkgSet ATSPackageSet
s))

instance Pretty Version where
    pretty :: Version -> Doc
pretty Version
v = String -> Doc
text (Version -> String
forall a. Show a => a -> String
show Version
v)

instance Pretty ATSDependency where
    pretty :: ATSDependency -> Doc
pretty (ATSDependency Text
ln Text
_ Text
url Maybe Text
md Version
v [LibDep]
_ [LibDep]
_ [LibDep]
_ [Text]
_) = Doc -> Doc
dullyellow (String -> Doc
text (Text -> String
unpack Text
ln)) Doc -> Doc -> Doc
<#> Int -> Doc -> Doc
indent Int
4 (Maybe Text -> Doc -> Doc
g Maybe Text
md Doc
"url:" Doc -> Doc -> Doc
<+> String -> Doc
text (Text -> String
unpack Text
url) Doc -> Doc -> Doc
<#> Doc
"version:" Doc -> Doc -> Doc
<+> Version -> Doc
forall a. Pretty a => a -> Doc
pretty Version
v) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
hardline
        where g :: Maybe Text -> Doc -> Doc
g (Just Text
d) = (Doc
"description:" Doc -> Doc -> Doc
<+> String -> Doc
text (Text -> String
unpack Text
d) Doc -> Doc -> Doc
<#>)
              g Maybe Text
Nothing  = Doc -> Doc
forall a. a -> a
id

sameName :: [ATSDependency] -> [ATSDependency]
sameName :: [ATSDependency] -> [ATSDependency]
sameName = [ATSDependency] -> [ATSDependency]
forall a. [a] -> [a]
reverse ([ATSDependency] -> [ATSDependency])
-> ([ATSDependency] -> [ATSDependency])
-> [ATSDependency]
-> [ATSDependency]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ATSDependency -> ATSDependency -> Bool)
-> [ATSDependency] -> [ATSDependency]
forall a. (a -> a -> Bool) -> [a] -> [a]
nubBy ATSDependency -> ATSDependency -> Bool
go ([ATSDependency] -> [ATSDependency])
-> ([ATSDependency] -> [ATSDependency])
-> [ATSDependency]
-> [ATSDependency]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ATSDependency] -> [ATSDependency]
forall a. [a] -> [a]
reverse
    where go :: ATSDependency -> ATSDependency -> Bool
go = (Text -> Text -> Bool)
-> (ATSDependency -> Text)
-> ATSDependency
-> ATSDependency
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
(==) ATSDependency -> Text
libName

instance Pretty ATSPackageSet where
    pretty :: ATSPackageSet -> Doc
pretty (ATSPackageSet [ATSDependency]
ds) = [Doc] -> Doc
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (Doc -> [Doc] -> [Doc]
punctuate Doc
hardline (ATSDependency -> Doc
forall a. Pretty a => a -> Doc
pretty (ATSDependency -> Doc) -> [ATSDependency] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ATSDependency] -> [ATSDependency]
sameName [ATSDependency]
ds))

displayList :: String -> IO ()
displayList :: String -> IO ()
displayList = Doc -> IO ()
putDoc (Doc -> IO ()) -> (ATSPackageSet -> Doc) -> ATSPackageSet -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ATSPackageSet -> Doc
forall a. Pretty a => a -> Doc
pretty (ATSPackageSet -> IO ())
-> (String -> IO ATSPackageSet) -> String -> IO ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Bool -> String -> IO ATSPackageSet
listDeps Bool
True

listDeps :: Bool -- ^ Whether to sort dependencies
         -> String -- ^ URL of package set
         -> IO ATSPackageSet
listDeps :: Bool -> String -> IO ATSPackageSet
listDeps Bool
b = (ATSPackageSet -> ATSPackageSet)
-> IO ATSPackageSet -> IO ATSPackageSet
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ATSPackageSet -> ATSPackageSet
s (IO ATSPackageSet -> IO ATSPackageSet)
-> (String -> IO ATSPackageSet) -> String -> IO ATSPackageSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Decoder ATSPackageSet -> Text -> IO ATSPackageSet
forall a. Decoder a -> Text -> IO a
input Decoder ATSPackageSet
forall a. FromDhall a => Decoder a
auto (Text -> IO ATSPackageSet)
-> (String -> Text) -> String -> IO ATSPackageSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
    where s :: ATSPackageSet -> ATSPackageSet
s = (ATSPackageSet -> ATSPackageSet)
-> (ATSPackageSet -> ATSPackageSet)
-> Bool
-> ATSPackageSet
-> ATSPackageSet
forall a. a -> a -> Bool -> a
bool ATSPackageSet -> ATSPackageSet
forall a. a -> a
id ATSPackageSet -> ATSPackageSet
s' Bool
b
          s' :: ATSPackageSet -> ATSPackageSet
s' = ASetter ATSPackageSet ATSPackageSet [ATSDependency] [ATSDependency]
-> ([ATSDependency] -> [ATSDependency])
-> ATSPackageSet
-> ATSPackageSet
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter ATSPackageSet ATSPackageSet [ATSDependency] [ATSDependency]
Lens' ATSPackageSet [ATSDependency]
atsPkgSet ((ATSDependency -> ATSDependency -> Ordering)
-> [ATSDependency] -> [ATSDependency]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (Text -> Text -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Text -> Text -> Ordering)
-> (ATSDependency -> Text)
-> ATSDependency
-> ATSDependency
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
&: ATSDependency -> Text
libName))

setBuildPlan :: FilePath -- ^ Filepath for cache inside @.atspkg@
             -> DepSelector
             -> Maybe String -- ^ Arguments
             -> String -- ^ URL of package set to use.
             -> [(String, ATSConstraint)] -- ^ Libraries we want
             -> IO [[ATSDependency]]
setBuildPlan :: String
-> DepSelector
-> Maybe String
-> String
-> [(String, ATSConstraint)]
-> IO [[ATSDependency]]
setBuildPlan String
p DepSelector
getDeps Maybe String
mStr String
url [(String, ATSConstraint)]
deps = do
    Bool
b <- String -> IO Bool
doesFileExist String
depCache
    Bool
b' <- Maybe String -> String -> IO Bool
forall (m :: * -> *) a.
(MonadIO m, Binary a) =>
a -> String -> m Bool
shouldWrite Maybe String
mStr (String
".atspkg" String -> String -> String
</> String
"args")
    IO [[ATSDependency]]
-> IO [[ATSDependency]] -> Bool -> IO [[ATSDependency]]
forall a. a -> a -> Bool -> a
bool IO [[ATSDependency]]
setBuildPlan' (ByteString -> [[ATSDependency]]
forall a. Binary a => ByteString -> a
decode (ByteString -> [[ATSDependency]])
-> IO ByteString -> IO [[ATSDependency]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO ByteString
BSL.readFile String
depCache) (Bool
b Bool -> Bool -> Bool
&& Bool
b')

    where depCache :: String
depCache = String
".atspkg/buildplan-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
p
          setBuildPlan' :: IO [[ATSDependency]]
setBuildPlan' = do
            ATSPackageSet
pkgSet <- Bool -> String -> IO ATSPackageSet
listDeps Bool
False String
url
            case DepSelector
-> ATSPackageSet
-> [(String, ATSConstraint)]
-> DepM [[ATSDependency]]
mkBuildPlan DepSelector
getDeps ATSPackageSet
pkgSet [(String, ATSConstraint)]
deps of
                Left ResolveError
x  -> ResolveError -> IO [[ATSDependency]]
forall a. ResolveError -> IO a
resolutionFailed ResolveError
x
                Right [[ATSDependency]]
x -> Bool -> String -> IO ()
createDirectoryIfMissing Bool
True String
".atspkg" IO () -> IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
                           String -> ByteString -> IO ()
BSL.writeFile String
depCache ([[ATSDependency]] -> ByteString
forall a. Binary a => a -> ByteString
encode [[ATSDependency]]
x) IO () -> [[ATSDependency]] -> IO [[ATSDependency]]
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$>
                           [[ATSDependency]]
x

mkBuildPlan :: DepSelector
            -> ATSPackageSet
            -> [(String, ATSConstraint)]
            -> DepM [[ATSDependency]]
mkBuildPlan :: DepSelector
-> ATSPackageSet
-> [(String, ATSConstraint)]
-> DepM [[ATSDependency]]
mkBuildPlan DepSelector
getDeps aps :: ATSPackageSet
aps@(ATSPackageSet [ATSDependency]
ps) [(String, ATSConstraint)]
names = Either ResolveError [[Dependency]] -> DepM [[ATSDependency]]
finalize (Either ResolveError [[Dependency]] -> DepM [[ATSDependency]])
-> ([ATSDependency] -> Either ResolveError [[Dependency]])
-> [ATSDependency]
-> DepM [[ATSDependency]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([[Dependency]] -> [[Dependency]])
-> Either ResolveError [[Dependency]]
-> Either ResolveError [[Dependency]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[Dependency]] -> [[Dependency]]
forall a. Ord a => [[a]] -> [[a]]
nubSpecial (Either ResolveError [[Dependency]]
 -> Either ResolveError [[Dependency]])
-> ([ATSDependency] -> Either ResolveError [[Dependency]])
-> [ATSDependency]
-> Either ResolveError [[Dependency]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Dependency] -> Either ResolveError [[Dependency]]
resolve ([Dependency] -> Either ResolveError [[Dependency]])
-> ([ATSDependency] -> [Dependency])
-> [ATSDependency]
-> Either ResolveError [[Dependency]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ATSDependency -> Dependency) -> [ATSDependency] -> [Dependency]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Dependency -> Dependency
selfDepend (Dependency -> Dependency)
-> (ATSDependency -> Dependency) -> ATSDependency -> Dependency
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DepSelector -> ATSDependency -> Dependency
asDep DepSelector
getDeps) ([ATSDependency] -> DepM [[ATSDependency]])
-> ([(String, ATSConstraint)]
    -> Either ResolveError [ATSDependency])
-> [(String, ATSConstraint)]
-> DepM [[ATSDependency]]
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< [(String, ATSConstraint)] -> Either ResolveError [ATSDependency]
forall b. [(String, b)] -> Either ResolveError [ATSDependency]
stringBuildPlan ([(String, ATSConstraint)] -> DepM [[ATSDependency]])
-> [(String, ATSConstraint)] -> DepM [[ATSDependency]]
forall a b. (a -> b) -> a -> b
$ [(String, ATSConstraint)]
names
    where finalize :: Either ResolveError [[Dependency]] -> DepM [[ATSDependency]]
finalize = ([[Dependency]] -> [[ATSDependency]])
-> Either ResolveError [[Dependency]] -> DepM [[ATSDependency]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([Dependency] -> [ATSDependency])
-> [[Dependency]] -> [[ATSDependency]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Dependency -> ATSDependency) -> [Dependency] -> [ATSDependency]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ATSPackageSet -> Dependency -> ATSDependency
lookupVersions ATSPackageSet
aps)))
          resolve :: [Dependency] -> Either ResolveError [[Dependency]]
resolve = PackageSet Dependency
-> [Dependency] -> Either ResolveError [[Dependency]]
resolveDependencies (DepSelector -> ATSPackageSet -> PackageSet Dependency
atsPkgsToPkgs DepSelector
libDeps ATSPackageSet
aps)
          selfDepend :: Dependency -> Dependency
selfDepend (Dependency String
ln [(String, Constraint Version)]
ds Version
v) = case String -> [(String, ATSConstraint)] -> Maybe ATSConstraint
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
ln [(String, ATSConstraint)]
names of
                Just ATSConstraint
v' -> String -> [(String, Constraint Version)] -> Version -> Dependency
Dependency String
ln ((String
ln, ATSConstraint -> Constraint Version
canonicalize ATSConstraint
v') (String, Constraint Version)
-> [(String, Constraint Version)] -> [(String, Constraint Version)]
forall a. a -> [a] -> [a]
: [(String, Constraint Version)]
ds) Version
v
                Maybe ATSConstraint
Nothing -> String -> [(String, Constraint Version)] -> Version -> Dependency
Dependency String
ln [(String, Constraint Version)]
ds Version
v
          stringBuildPlan :: [(String, b)] -> Either ResolveError [ATSDependency]
stringBuildPlan [(String, b)]
names' = [Either ResolveError ATSDependency]
-> Either ResolveError [ATSDependency]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [ String
-> [(String, ATSDependency)] -> Either ResolveError ATSDependency
forall b. String -> [(String, b)] -> Either ResolveError b
lookup' String
x [(String, ATSDependency)]
libs | (String
x, b
_) <- [(String, b)]
names' ]
              where libs :: [(String, ATSDependency)]
libs = (Text -> String
unpack (Text -> String)
-> (ATSDependency -> Text) -> ATSDependency -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ATSDependency -> Text
libName (ATSDependency -> String)
-> (ATSDependency -> ATSDependency)
-> ATSDependency
-> (String, ATSDependency)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& ATSDependency -> ATSDependency
forall a. a -> a
id) (ATSDependency -> (String, ATSDependency))
-> [ATSDependency] -> [(String, ATSDependency)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ATSDependency]
ps
                    lookup' :: String -> [(String, b)] -> Either ResolveError b
lookup' String
k [(String, b)]
vs = case String -> [(String, b)] -> Maybe b
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
k [(String, b)]
vs of
                        Just b
x  -> b -> Either ResolveError b
forall a b. b -> Either a b
Right b
x
                        Maybe b
Nothing -> ResolveError -> Either ResolveError b
forall a b. a -> Either a b
Left (String -> ResolveError
NotPresent String
k)

canonicalize :: ATSConstraint -> Constraint Version
canonicalize :: ATSConstraint -> Constraint Version
canonicalize (ATSConstraint (Just Version
l) Maybe Version
Nothing)  = Version -> Constraint Version
forall a. a -> Constraint a
GreaterThanEq Version
l
canonicalize (ATSConstraint Maybe Version
Nothing (Just Version
u))  = Version -> Constraint Version
forall a. a -> Constraint a
LessThanEq Version
u
canonicalize (ATSConstraint Maybe Version
Nothing Maybe Version
Nothing)   = Constraint Version
forall a. Constraint a
None
canonicalize (ATSConstraint (Just Version
l) (Just Version
u)) = Constraint Version -> Constraint Version -> Constraint Version
forall a. Constraint a -> Constraint a -> Constraint a
Bounded (Version -> Constraint Version
forall a. a -> Constraint a
GreaterThanEq Version
l) (Version -> Constraint Version
forall a. a -> Constraint a
LessThanEq Version
u)

asDep :: DepSelector
      -> ATSDependency
      -> Dependency
asDep :: DepSelector -> ATSDependency -> Dependency
asDep DepSelector
getDeps d :: ATSDependency
d@ATSDependency{[LibDep]
[Text]
Maybe Text
Text
Version
$sel:script:ATSDependency :: ATSDependency -> [Text]
$sel:libCDeps:ATSDependency :: DepSelector
$sel:libBldDeps:ATSDependency :: DepSelector
$sel:libVersion:ATSDependency :: ATSDependency -> Version
$sel:description:ATSDependency :: ATSDependency -> Maybe Text
$sel:url:ATSDependency :: ATSDependency -> Text
$sel:dir:ATSDependency :: ATSDependency -> Text
script :: [Text]
libCDeps :: [LibDep]
libBldDeps :: [LibDep]
libDeps :: [LibDep]
libVersion :: Version
description :: Maybe Text
url :: Text
dir :: Text
libName :: Text
$sel:libDeps:ATSDependency :: DepSelector
$sel:libName:ATSDependency :: ATSDependency -> Text
..} = String -> [(String, Constraint Version)] -> Version -> Dependency
Dependency (Text -> String
unpack Text
libName) (LibDep -> (String, Constraint Version)
g (LibDep -> (String, Constraint Version))
-> [LibDep] -> [(String, Constraint Version)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DepSelector
getDeps ATSDependency
d) Version
libVersion
    where g :: LibDep -> (String, Constraint Version)
g = Text -> String
unpack (Text -> String)
-> (ATSConstraint -> Constraint Version)
-> LibDep
-> (String, Constraint Version)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** ATSConstraint -> Constraint Version
canonicalize

atsPkgsToPkgs :: DepSelector
              -> ATSPackageSet
              -> PackageSet Dependency
atsPkgsToPkgs :: DepSelector -> ATSPackageSet -> PackageSet Dependency
atsPkgsToPkgs DepSelector
getDeps (ATSPackageSet [ATSDependency]
deps) = Map String (Set Dependency) -> PackageSet Dependency
forall a. Map String (Set a) -> PackageSet a
PackageSet (Map String (Set Dependency) -> PackageSet Dependency)
-> Map String (Set Dependency) -> PackageSet Dependency
forall a b. (a -> b) -> a -> b
$ ((Map String (Set Dependency) -> Map String (Set Dependency))
 -> (Map String (Set Dependency) -> Map String (Set Dependency))
 -> Map String (Set Dependency)
 -> Map String (Set Dependency))
-> (Map String (Set Dependency) -> Map String (Set Dependency))
-> [Map String (Set Dependency) -> Map String (Set Dependency)]
-> Map String (Set Dependency)
-> Map String (Set Dependency)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Map String (Set Dependency) -> Map String (Set Dependency))
-> (Map String (Set Dependency) -> Map String (Set Dependency))
-> Map String (Set Dependency)
-> Map String (Set Dependency)
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) Map String (Set Dependency) -> Map String (Set Dependency)
forall a. a -> a
id [Map String (Set Dependency) -> Map String (Set Dependency)]
inserts Map String (Set Dependency)
forall a. Monoid a => a
mempty
    where inserts :: [Map String (Set Dependency) -> Map String (Set Dependency)]
inserts = ATSDependency
-> Map String (Set Dependency) -> Map String (Set Dependency)
insert (ATSDependency
 -> Map String (Set Dependency) -> Map String (Set Dependency))
-> [ATSDependency]
-> [Map String (Set Dependency) -> Map String (Set Dependency)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ATSDependency]
deps
          insert :: ATSDependency
-> Map String (Set Dependency) -> Map String (Set Dependency)
insert ATSDependency
dep = (Set Dependency -> Set Dependency -> Set Dependency)
-> String
-> Set Dependency
-> Map String (Set Dependency)
-> Map String (Set Dependency)
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith
            (\Set Dependency
_ -> Dependency -> Set Dependency -> Set Dependency
forall a. Ord a => a -> Set a -> Set a
S.insert (DepSelector -> ATSDependency -> Dependency
asDep DepSelector
getDeps ATSDependency
dep))
            (Text -> String
unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ ATSDependency -> Text
libName ATSDependency
dep)
            (Dependency -> Set Dependency
forall a. a -> Set a
S.singleton (DepSelector -> ATSDependency -> Dependency
asDep DepSelector
getDeps ATSDependency
dep))

lookupVersions :: ATSPackageSet -> Dependency -> ATSDependency
lookupVersions :: ATSPackageSet -> Dependency -> ATSDependency
lookupVersions (ATSPackageSet [ATSDependency]
deps) (Dependency String
name [(String, Constraint Version)]
_ Version
v) = [ATSDependency] -> ATSDependency
forall a. [a] -> a
head ((ATSDependency -> Bool) -> [ATSDependency] -> [ATSDependency]
forall a. (a -> Bool) -> [a] -> [a]
filter ATSDependency -> Bool
f [ATSDependency]
deps)
    where f :: ATSDependency -> Bool
f = Bool -> Bool -> Bool
(&&) (Bool -> Bool -> Bool)
-> (ATSDependency -> Bool) -> ATSDependency -> Bool -> Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ATSDependency -> Bool
matchName (ATSDependency -> Bool -> Bool)
-> (ATSDependency -> Bool) -> ATSDependency -> Bool
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ATSDependency -> Bool
matchVersion
          libName' :: ATSDependency -> String
libName' = Text -> String
unpack (Text -> String)
-> (ATSDependency -> Text) -> ATSDependency -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ATSDependency -> Text
libName
          matchName :: ATSDependency -> Bool
matchName = (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
name) (String -> Bool)
-> (ATSDependency -> String) -> ATSDependency -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ATSDependency -> String
libName'
          matchVersion :: ATSDependency -> Bool
matchVersion = (Version -> Version -> Bool
forall a. Eq a => a -> a -> Bool
== Version
v) (Version -> Bool)
-> (ATSDependency -> Version) -> ATSDependency -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ATSDependency -> Version
libVersion