module HaskellCI.Config.Installed where

import HaskellCI.Prelude

import qualified Data.Set                        as S
import qualified Distribution.Compat.CharParsing as C
import qualified Distribution.Parsec             as C
import qualified Distribution.Pretty             as C
import qualified Distribution.Types.PackageName  as C
import qualified Text.PrettyPrint                as PP

-------------------------------------------------------------------------------
-- Single action
-------------------------------------------------------------------------------

data Installed
    = InstalledAll
    | InstalledNone
    | Add C.PackageName
    | Remove C.PackageName
  deriving (Installed -> Installed -> Bool
(Installed -> Installed -> Bool)
-> (Installed -> Installed -> Bool) -> Eq Installed
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Installed -> Installed -> Bool
== :: Installed -> Installed -> Bool
$c/= :: Installed -> Installed -> Bool
/= :: Installed -> Installed -> Bool
Eq, Int -> Installed -> ShowS
[Installed] -> ShowS
Installed -> String
(Int -> Installed -> ShowS)
-> (Installed -> String)
-> ([Installed] -> ShowS)
-> Show Installed
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Installed -> ShowS
showsPrec :: Int -> Installed -> ShowS
$cshow :: Installed -> String
show :: Installed -> String
$cshowList :: [Installed] -> ShowS
showList :: [Installed] -> ShowS
Show)

instance C.Pretty Installed where
    pretty :: Installed -> Doc
pretty Installed
InstalledAll  = String -> Doc
PP.text String
"+all"
    pretty Installed
InstalledNone = String -> Doc
PP.text String
"-all"
    pretty (Add PackageName
pn)      = Char -> Doc
PP.char Char
'+' Doc -> Doc -> Doc
PP.<> PackageName -> Doc
forall a. Pretty a => a -> Doc
C.pretty PackageName
pn
    pretty (Remove PackageName
pn)   = Char -> Doc
PP.char Char
'-' Doc -> Doc -> Doc
PP.<> PackageName -> Doc
forall a. Pretty a => a -> Doc
C.pretty PackageName
pn

instance C.Parsec Installed where
    parsec :: forall (m :: * -> *). CabalParsing m => m Installed
parsec = do
        Bool
s <- Bool
True Bool -> m Char -> m Bool
forall a b. a -> m b -> m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
C.char Char
'+' m Bool -> m Bool -> m Bool
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool
False Bool -> m Char -> m Bool
forall a b. a -> m b -> m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
C.char Char
'-'
        PackageName
pn <- m PackageName
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
forall (m :: * -> *). CabalParsing m => m PackageName
C.parsec
        Installed -> m Installed
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Installed -> m Installed) -> Installed -> m Installed
forall a b. (a -> b) -> a -> b
$ case (Bool
s, PackageName
pn PackageName -> PackageName -> Bool
forall a. Eq a => a -> a -> Bool
== String -> PackageName
C.mkPackageName String
"all") of
            (Bool
True,  Bool
True)  -> Installed
InstalledAll
            (Bool
True,  Bool
False) -> PackageName -> Installed
Add PackageName
pn
            (Bool
False, Bool
True)  -> Installed
InstalledNone
            (Bool
False, Bool
False) -> PackageName -> Installed
Remove PackageName
pn

-------------------------------------------------------------------------------
-- Normalised
-------------------------------------------------------------------------------

data InstalledNormalised
    = InstalledDiff (S.Set C.PackageName)
    | InstalledOnly (S.Set C.PackageName)
  deriving Int -> InstalledNormalised -> ShowS
[InstalledNormalised] -> ShowS
InstalledNormalised -> String
(Int -> InstalledNormalised -> ShowS)
-> (InstalledNormalised -> String)
-> ([InstalledNormalised] -> ShowS)
-> Show InstalledNormalised
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InstalledNormalised -> ShowS
showsPrec :: Int -> InstalledNormalised -> ShowS
$cshow :: InstalledNormalised -> String
show :: InstalledNormalised -> String
$cshowList :: [InstalledNormalised] -> ShowS
showList :: [InstalledNormalised] -> ShowS
Show

-- | Normalised
--
-- >>> parseI = maybe (error "foo") id . traverse C.simpleParsec
-- >>> normaliseInstalled $ parseI ["-Cabal"]
-- InstalledDiff (fromList [PackageName "Cabal"])
--
-- >>> normaliseInstalled $ parseI ["-all"]
-- InstalledOnly (fromList [])
--
-- >>> normaliseInstalled $ parseI ["-all", "+transformers"]
-- InstalledOnly (fromList [PackageName "transformers"])
--
normaliseInstalled :: [Installed] -> InstalledNormalised
normaliseInstalled :: [Installed] -> InstalledNormalised
normaliseInstalled = (InstalledNormalised -> Installed -> InstalledNormalised)
-> InstalledNormalised -> [Installed] -> InstalledNormalised
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' InstalledNormalised -> Installed -> InstalledNormalised
f (Set PackageName -> InstalledNormalised
InstalledDiff Set PackageName
forall a. Set a
S.empty) where
    f :: InstalledNormalised -> Installed -> InstalledNormalised
    f :: InstalledNormalised -> Installed -> InstalledNormalised
f InstalledNormalised
_ Installed
InstalledNone = Set PackageName -> InstalledNormalised
InstalledOnly Set PackageName
forall a. Set a
S.empty
    f InstalledNormalised
_ Installed
InstalledAll  = Set PackageName -> InstalledNormalised
InstalledDiff Set PackageName
forall a. Set a
S.empty

    f (InstalledDiff Set PackageName
s) (Remove PackageName
p) = Set PackageName -> InstalledNormalised
InstalledDiff (PackageName -> Set PackageName -> Set PackageName
forall a. Ord a => a -> Set a -> Set a
S.insert PackageName
p Set PackageName
s)
    f (InstalledDiff Set PackageName
s) (Add PackageName
p)    = Set PackageName -> InstalledNormalised
InstalledDiff (PackageName -> Set PackageName -> Set PackageName
forall a. Ord a => a -> Set a -> Set a
S.delete PackageName
p Set PackageName
s)

    f (InstalledOnly Set PackageName
s) (Remove PackageName
p) = Set PackageName -> InstalledNormalised
InstalledOnly (PackageName -> Set PackageName -> Set PackageName
forall a. Ord a => a -> Set a -> Set a
S.delete PackageName
p Set PackageName
s)
    f (InstalledOnly Set PackageName
s) (Add PackageName
p)    = Set PackageName -> InstalledNormalised
InstalledOnly (PackageName -> Set PackageName -> Set PackageName
forall a. Ord a => a -> Set a -> Set a
S.insert PackageName
p Set PackageName
s)