{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Stack.Types.CompCollection
( CompCollection
, getBuildableSet
, getBuildableSetText
, getBuildableListText
, getBuildableListAs
, foldAndMakeCollection
, hasBuildableComponent
, collectionLookup
, collectionKeyValueList
, collectionMember
, foldComponentToAnotherCollection
) where
import qualified Data.Map as M
import qualified Data.Set as Set
import Stack.Prelude
import Stack.Types.Component
( HasBuildInfo, HasName, StackBuildInfo (..)
, StackUnqualCompName (..)
)
data CompCollection component = CompCollection
{ forall component.
CompCollection component -> InnerCollection component
buildableOnes :: {-# UNPACK #-} !(InnerCollection component)
, forall component.
CompCollection component -> Set StackUnqualCompName
unbuildableOnes :: Set StackUnqualCompName
}
deriving (Int -> CompCollection component -> ShowS
[CompCollection component] -> ShowS
CompCollection component -> String
(Int -> CompCollection component -> ShowS)
-> (CompCollection component -> String)
-> ([CompCollection component] -> ShowS)
-> Show (CompCollection component)
forall component.
Show component =>
Int -> CompCollection component -> ShowS
forall component.
Show component =>
[CompCollection component] -> ShowS
forall component.
Show component =>
CompCollection component -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall component.
Show component =>
Int -> CompCollection component -> ShowS
showsPrec :: Int -> CompCollection component -> ShowS
$cshow :: forall component.
Show component =>
CompCollection component -> String
show :: CompCollection component -> String
$cshowList :: forall component.
Show component =>
[CompCollection component] -> ShowS
showList :: [CompCollection component] -> ShowS
Show)
instance Semigroup (CompCollection component) where
CompCollection component
a <> :: CompCollection component
-> CompCollection component -> CompCollection component
<> CompCollection component
b = CompCollection
{ buildableOnes :: InnerCollection component
buildableOnes = CompCollection component
a.buildableOnes InnerCollection component
-> InnerCollection component -> InnerCollection component
forall a. Semigroup a => a -> a -> a
<> CompCollection component
b.buildableOnes
, unbuildableOnes :: Set StackUnqualCompName
unbuildableOnes = CompCollection component
a.unbuildableOnes Set StackUnqualCompName
-> Set StackUnqualCompName -> Set StackUnqualCompName
forall a. Semigroup a => a -> a -> a
<> CompCollection component
b.unbuildableOnes
}
instance Monoid (CompCollection component) where
mempty :: CompCollection component
mempty = CompCollection
{ buildableOnes :: InnerCollection component
buildableOnes = InnerCollection component
forall a. Monoid a => a
mempty
, unbuildableOnes :: Set StackUnqualCompName
unbuildableOnes = Set StackUnqualCompName
forall a. Monoid a => a
mempty
}
instance Foldable CompCollection where
foldMap :: forall m a. Monoid m => (a -> m) -> CompCollection a -> m
foldMap a -> m
fn CompCollection a
collection = (a -> m) -> Map StackUnqualCompName a -> m
forall m a. Monoid m => (a -> m) -> Map StackUnqualCompName a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
fn CompCollection a
collection.buildableOnes
foldr' :: forall a b. (a -> b -> b) -> b -> CompCollection a -> b
foldr' a -> b -> b
fn b
c CompCollection a
collection = (a -> b -> b) -> b -> Map StackUnqualCompName a -> b
forall a b k. (a -> b -> b) -> b -> Map k a -> b
M.foldr' a -> b -> b
fn b
c CompCollection a
collection.buildableOnes
null :: forall a. CompCollection a -> Bool
null = Map StackUnqualCompName a -> Bool
forall k a. Map k a -> Bool
M.null (Map StackUnqualCompName a -> Bool)
-> (CompCollection a -> Map StackUnqualCompName a)
-> CompCollection a
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.buildableOnes)
type InnerCollection component = Map StackUnqualCompName component
addComponent ::
HasName component
=> component
-> InnerCollection component
-> InnerCollection component
addComponent :: forall component.
HasName component =>
component -> InnerCollection component -> InnerCollection component
addComponent component
component = StackUnqualCompName
-> component
-> Map StackUnqualCompName component
-> Map StackUnqualCompName component
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert component
component.name component
component
foldAndMakeCollection ::
(HasBuildInfo compB, HasName compB, Foldable sourceCollection)
=> (compA -> compB)
-> sourceCollection compA
-> CompCollection compB
foldAndMakeCollection :: forall compB (sourceCollection :: * -> *) compA.
(HasBuildInfo compB, HasName compB, Foldable sourceCollection) =>
(compA -> compB) -> sourceCollection compA -> CompCollection compB
foldAndMakeCollection compA -> compB
mapFn = (CompCollection compB -> compA -> CompCollection compB)
-> CompCollection compB
-> sourceCollection compA
-> CompCollection compB
forall b a. (b -> a -> b) -> b -> sourceCollection a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' CompCollection compB -> compA -> CompCollection compB
compIterator CompCollection compB
forall a. Monoid a => a
mempty
where
compIterator :: CompCollection compB -> compA -> CompCollection compB
compIterator CompCollection compB
existingCollection compA
component =
CompCollection compB -> compB -> CompCollection compB
forall {r} {r}.
(HasField "name" r StackUnqualCompName,
HasField "buildable" r Bool, HasField "buildInfo" r r) =>
CompCollection r -> r -> CompCollection r
compCreator CompCollection compB
existingCollection (compA -> compB
mapFn compA
component)
compCreator :: CompCollection r -> r -> CompCollection r
compCreator CompCollection r
existingCollection r
component
| r
component.buildInfo.buildable = CompCollection r
existingCollection
{ buildableOnes =
addComponent component existingCollection.buildableOnes
}
| Bool
otherwise = CompCollection r
existingCollection
{ unbuildableOnes =
Set.insert component.name existingCollection.unbuildableOnes
}
getBuildableSet :: CompCollection component -> Set StackUnqualCompName
getBuildableSet :: forall component.
CompCollection component -> Set StackUnqualCompName
getBuildableSet = Map StackUnqualCompName component -> Set StackUnqualCompName
forall k a. Map k a -> Set k
M.keysSet (Map StackUnqualCompName component -> Set StackUnqualCompName)
-> (CompCollection component -> Map StackUnqualCompName component)
-> CompCollection component
-> Set StackUnqualCompName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.buildableOnes)
getBuildableSetText :: CompCollection component -> Set Text
getBuildableSetText :: forall component. CompCollection component -> Set Text
getBuildableSetText = (StackUnqualCompName -> Text)
-> Set StackUnqualCompName -> Set Text
forall a b. (a -> b) -> Set a -> Set b
Set.mapMonotonic (.unqualCompToText) (Set StackUnqualCompName -> Set Text)
-> (CompCollection component -> Set StackUnqualCompName)
-> CompCollection component
-> Set Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompCollection component -> Set StackUnqualCompName
forall component.
CompCollection component -> Set StackUnqualCompName
getBuildableSet
getBuildableListText :: CompCollection component -> [Text]
getBuildableListText :: forall component. CompCollection component -> [Text]
getBuildableListText = (StackUnqualCompName -> Text) -> CompCollection component -> [Text]
forall something component.
(StackUnqualCompName -> something)
-> CompCollection component -> [something]
getBuildableListAs (.unqualCompToText)
getBuildableListAs ::
(StackUnqualCompName -> something)
-> CompCollection component
-> [something]
getBuildableListAs :: forall something component.
(StackUnqualCompName -> something)
-> CompCollection component -> [something]
getBuildableListAs StackUnqualCompName -> something
fn = (StackUnqualCompName -> [something] -> [something])
-> [something] -> Set StackUnqualCompName -> [something]
forall a b. (a -> b -> b) -> b -> Set a -> b
Set.foldr' (\StackUnqualCompName
v [something]
l -> StackUnqualCompName -> something
fn StackUnqualCompName
vsomething -> [something] -> [something]
forall a. a -> [a] -> [a]
:[something]
l) [] (Set StackUnqualCompName -> [something])
-> (CompCollection component -> Set StackUnqualCompName)
-> CompCollection component
-> [something]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompCollection component -> Set StackUnqualCompName
forall component.
CompCollection component -> Set StackUnqualCompName
getBuildableSet
hasBuildableComponent :: CompCollection component -> Bool
hasBuildableComponent :: forall a. CompCollection a -> Bool
hasBuildableComponent = Bool -> Bool
not (Bool -> Bool)
-> (CompCollection component -> Bool)
-> CompCollection component
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set StackUnqualCompName -> Bool
forall a. Set a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Set StackUnqualCompName -> Bool)
-> (CompCollection component -> Set StackUnqualCompName)
-> CompCollection component
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompCollection component -> Set StackUnqualCompName
forall component.
CompCollection component -> Set StackUnqualCompName
getBuildableSet
collectionLookup ::
Text
-> CompCollection component
-> Maybe component
collectionLookup :: forall component.
Text -> CompCollection component -> Maybe component
collectionLookup Text
needle CompCollection component
haystack =
StackUnqualCompName
-> Map StackUnqualCompName component -> Maybe component
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Text -> StackUnqualCompName
StackUnqualCompName Text
needle) CompCollection component
haystack.buildableOnes
collectionKeyValueList :: CompCollection component -> [(Text, component)]
collectionKeyValueList :: forall component. CompCollection component -> [(Text, component)]
collectionKeyValueList CompCollection component
haystack =
(\(StackUnqualCompName Text
k, !component
v) -> (Text
k, component
v))
((StackUnqualCompName, component) -> (Text, component))
-> [(StackUnqualCompName, component)] -> [(Text, component)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map StackUnqualCompName component
-> [(StackUnqualCompName, component)]
forall k a. Map k a -> [(k, a)]
M.toList CompCollection component
haystack.buildableOnes
collectionMember ::
Text
-> CompCollection component
-> Bool
collectionMember :: forall component. Text -> CompCollection component -> Bool
collectionMember Text
needle CompCollection component
haystack = Maybe component -> Bool
forall a. Maybe a -> Bool
isJust (Maybe component -> Bool) -> Maybe component -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> CompCollection component -> Maybe component
forall component.
Text -> CompCollection component -> Maybe component
collectionLookup Text
needle CompCollection component
haystack
foldComponentToAnotherCollection ::
(Monad m)
=> CompCollection component
-> (component -> m a -> m a)
-> m a
-> m a
foldComponentToAnotherCollection :: forall (m :: * -> *) component a.
Monad m =>
CompCollection component -> (component -> m a -> m a) -> m a -> m a
foldComponentToAnotherCollection CompCollection component
collection component -> m a -> m a
fn m a
initialValue =
(component -> m a -> m a)
-> m a -> Map StackUnqualCompName component -> m a
forall a b k. (a -> b -> b) -> b -> Map k a -> b
M.foldr' component -> m a -> m a
fn m a
initialValue CompCollection component
collection.buildableOnes