module HaskellCI.Config.PackageScope where

import HaskellCI.Prelude

import qualified Distribution.Compat.CharParsing as C
import qualified Distribution.Parsec             as C
import qualified Distribution.Pretty             as C
import qualified Text.PrettyPrint                as PP

data PackageScope
    = PackageScopeNone
    | PackageScopeLocal
    | PackageScopeAll
  deriving (PackageScope -> PackageScope -> Bool
(PackageScope -> PackageScope -> Bool)
-> (PackageScope -> PackageScope -> Bool) -> Eq PackageScope
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PackageScope -> PackageScope -> Bool
== :: PackageScope -> PackageScope -> Bool
$c/= :: PackageScope -> PackageScope -> Bool
/= :: PackageScope -> PackageScope -> Bool
Eq, Int -> PackageScope -> ShowS
[PackageScope] -> ShowS
PackageScope -> String
(Int -> PackageScope -> ShowS)
-> (PackageScope -> String)
-> ([PackageScope] -> ShowS)
-> Show PackageScope
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PackageScope -> ShowS
showsPrec :: Int -> PackageScope -> ShowS
$cshow :: PackageScope -> String
show :: PackageScope -> String
$cshowList :: [PackageScope] -> ShowS
showList :: [PackageScope] -> ShowS
Show)

instance C.Parsec PackageScope where
    parsec :: forall (m :: * -> *). CabalParsing m => m PackageScope
parsec = 
            PackageScope
PackageScopeNone  PackageScope -> m String -> m PackageScope
forall a b. a -> m b -> m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> m String
forall (m :: * -> *). CharParsing m => String -> m String
C.string String
"none"
        m PackageScope -> m PackageScope -> m PackageScope
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> PackageScope
PackageScopeLocal PackageScope -> m String -> m PackageScope
forall a b. a -> m b -> m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> m String
forall (m :: * -> *). CharParsing m => String -> m String
C.string String
"local"
        m PackageScope -> m PackageScope -> m PackageScope
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> PackageScope
PackageScopeAll   PackageScope -> m String -> m PackageScope
forall a b. a -> m b -> m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> m String
forall (m :: * -> *). CharParsing m => String -> m String
C.string String
"all"

instance C.Pretty PackageScope where
    pretty :: PackageScope -> Doc
pretty PackageScope
PackageScopeNone  = String -> Doc
PP.text String
"none"
    pretty PackageScope
PackageScopeLocal = String -> Doc
PP.text String
"local"
    pretty PackageScope
PackageScopeAll   = String -> Doc
PP.text String
"all"