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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Installed -> Installed -> Bool
$c/= :: Installed -> Installed -> Bool
== :: Installed -> Installed -> Bool
$c== :: Installed -> Installed -> Bool
Eq, Int -> Installed -> ShowS
[Installed] -> ShowS
Installed -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Installed] -> ShowS
$cshowList :: [Installed] -> ShowS
show :: Installed -> String
$cshow :: Installed -> String
showsPrec :: Int -> Installed -> ShowS
$cshowsPrec :: Int -> 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.<> forall a. Pretty a => a -> Doc
C.pretty PackageName
pn
    pretty (Remove PackageName
pn)   = Char -> Doc
PP.char Char
'-' Doc -> Doc -> Doc
PP.<> 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 forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *). CharParsing m => Char -> m Char
C.char Char
'+' forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool
False forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *). CharParsing m => Char -> m Char
C.char Char
'-'
        PackageName
pn <- forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
C.parsec
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case (Bool
s, PackageName
pn 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InstalledNormalised] -> ShowS
$cshowList :: [InstalledNormalised] -> ShowS
show :: InstalledNormalised -> String
$cshow :: InstalledNormalised -> String
showsPrec :: Int -> InstalledNormalised -> ShowS
$cshowsPrec :: Int -> 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 = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' InstalledNormalised -> Installed -> InstalledNormalised
f (Set PackageName -> InstalledNormalised
InstalledDiff forall a. Set a
S.empty) where
    f :: InstalledNormalised -> Installed -> InstalledNormalised
    f :: InstalledNormalised -> Installed -> InstalledNormalised
f InstalledNormalised
_ Installed
InstalledNone = Set PackageName -> InstalledNormalised
InstalledOnly forall a. Set a
S.empty
    f InstalledNormalised
_ Installed
InstalledAll  = Set PackageName -> InstalledNormalised
InstalledDiff forall a. Set a
S.empty

    f (InstalledDiff Set PackageName
s) (Remove PackageName
p) = Set PackageName -> InstalledNormalised
InstalledDiff (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 (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 (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 (forall a. Ord a => a -> Set a -> Set a
S.insert PackageName
p Set PackageName
s)