{-# LANGUAGE LambdaCase #-}

-- | Support for CABAL_FEATURES="..." in haskell-cabal .ebuild files.
-- See haskell-cabal.eclass for details on each of those.
module Portage.EBuild.CabalFeature (CabalFeature(..)) where

import Portage.EBuild.Render

-- | Type representing @CABAL_FEATURES@ in an ebuild.
data CabalFeature = Lib
                  | Profile
                  | Haddock
                  | Hoogle
                  | HsColour
                  | TestSuite
    deriving CabalFeature -> CabalFeature -> Bool
(CabalFeature -> CabalFeature -> Bool)
-> (CabalFeature -> CabalFeature -> Bool) -> Eq CabalFeature
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CabalFeature -> CabalFeature -> Bool
$c/= :: CabalFeature -> CabalFeature -> Bool
== :: CabalFeature -> CabalFeature -> Bool
$c== :: CabalFeature -> CabalFeature -> Bool
Eq

instance Render CabalFeature where
    render :: CabalFeature -> String
render = \case
                 CabalFeature
Lib        -> String
"lib"
                 CabalFeature
Profile    -> String
"profile"
                 CabalFeature
Haddock    -> String
"haddock"
                 CabalFeature
Hoogle     -> String
"hoogle"
                 CabalFeature
HsColour   -> String
"hscolour"
                 CabalFeature
TestSuite  -> String
"test-suite"