Types.hs

-- |Description: Types for pruning.
module Data.Prune.Types where

import Prelude

import Data.Aeson ((.:), FromJSON, parseJSON, withObject)
import Data.Set (Set)
import Data.Text (Text, pack, unpack)
import Distribution.Types.Dependency (Dependency)
import Distribution.Types.GenericPackageDescription (GenericPackageDescription)
import Distribution.Types.UnqualComponentName (UnqualComponentName)
import qualified Distribution.Types.Dependency as Dependency
import qualified Distribution.Types.PackageName as PackageName
import qualified Distribution.Types.UnqualComponentName as UnqualComponentName

data BuildSystem = Stack | CabalProject | Cabal
  deriving (Eq, Ord, Bounded, Enum)

instance Show BuildSystem where
  show = \case
    Stack -> "stack"
    CabalProject -> "cabal-project"
    Cabal -> "cabal"

parseBuildSystem :: String -> Maybe BuildSystem
parseBuildSystem = \case
  "stack" -> Just Stack
  "cabal-project" -> Just CabalProject
  "cabal" -> Just Cabal
  _ -> Nothing

allBuildSystems :: [BuildSystem]
allBuildSystems = [minBound..maxBound]

data Verbosity = Silent | Error | Info | Debug
  deriving (Eq, Ord, Bounded, Enum)

instance Show Verbosity where
  show = \case
    Silent -> "silent"
    Error -> "error"
    Info -> "info"
    Debug -> "debug"

parseVerbosity :: String -> Maybe Verbosity
parseVerbosity = \case
  "silent" -> Just Silent
  "error" -> Just Error
  "info" -> Just Info
  "debug" -> Just Debug
  _ -> Nothing

allVerbosities :: [Verbosity]
allVerbosities = [minBound..maxBound]

-- |The type of the thing to compile.
data CompilableType
  = CompilableTypeLibrary
  | CompilableTypeExecutable
  | CompilableTypeTest
  | CompilableTypeBenchmark
  deriving (Eq, Ord)

instance Show CompilableType where
  show = \case
    CompilableTypeLibrary -> "library"
    CompilableTypeExecutable -> "executable"
    CompilableTypeTest -> "test"
    CompilableTypeBenchmark -> "benchmark"

-- |The name of the thing to compile.
newtype CompilableName = CompilableName { unCompilableName :: Text }
  deriving (Eq, Ord)

instance Show CompilableName where
  show = unpack . unCompilableName

-- |The name of the dependency as listed in package.yaml
data DependencyName = DependencyName { unDependencyName :: Text }
  deriving (Eq, Ord)

instance Show DependencyName where
  show = unpack . unDependencyName

-- |A qualified module name, like @Foo.Bar@
data ModuleName = ModuleName { unModuleName :: Text }
  deriving (Eq, Ord)

instance Show ModuleName where
  show = unpack . unModuleName

-- |A thing to compile.
data Compilable = Compilable
  { compilableName :: CompilableName
  , compilableType :: CompilableType
  , compilableDependencies :: Set DependencyName
  -- ^ The list of dependencies less the common dependencies.
  , compilableFiles :: Set FilePath
  -- ^ The files under `source-dirs`.
  }
  deriving (Eq, Ord, Show)

data Package = Package
  { packageName :: Text
  -- ^ The name of the package.
  , packageFile :: FilePath
  -- ^ The location of the cabal file.
  , packageDescription :: GenericPackageDescription
  -- ^ The path to the config file.
  , packageBaseDependencies :: Set DependencyName
  -- ^ The list of common dependencies.
  , packageCompilables :: [Compilable]
  -- ^ The things to compile in the package.
  }
  deriving (Eq, Show)

data StackYaml = StackYaml
  { stackYamlPackages :: [FilePath]
  -- ^ The list of packages in stack.yaml. FIXME not every package is this way.
  }
  deriving (Eq, Ord, Show)

instance FromJSON StackYaml where
  parseJSON = withObject "StackYaml" $ \obj ->
    StackYaml
      <$> obj .: "packages"

data ShouldApply = ShouldNotApply | ShouldApply | ShouldApplyNoVerify
  deriving (Eq, Ord, Bounded, Enum)

instance Show ShouldApply where
  show = \case
    ShouldNotApply -> "no-apply"
    ShouldApply -> "apply"
    ShouldApplyNoVerify -> "apply-no-verify"

validateShouldApply :: (Bool, Bool) -> ShouldApply
validateShouldApply = \case
  (_, True) -> ShouldApplyNoVerify
  (True, False) -> ShouldApply
  (False, False) -> ShouldNotApply

allApply :: [ShouldApply]
allApply = [minBound..maxBound]

data ApplyStrategy = ApplyStrategySafe | ApplyStrategySmart
  deriving (Eq, Ord, Bounded, Enum)

instance Show ApplyStrategy where
  show = \case
    ApplyStrategySafe -> "safe"
    ApplyStrategySmart -> "smart"

parseApplyStrategy :: String -> Maybe ApplyStrategy
parseApplyStrategy = \case
  "safe" -> Just ApplyStrategySafe
  "smart" -> Just ApplyStrategySmart
  _ -> Nothing

allApplyStrategies :: [ApplyStrategy]
allApplyStrategies = [minBound..maxBound]

mkDependencyName :: Dependency -> DependencyName
mkDependencyName = DependencyName . pack . PackageName.unPackageName . Dependency.depPkgName

mkCompilableName :: UnqualComponentName -> CompilableName
mkCompilableName = CompilableName . pack . UnqualComponentName.unUnqualComponentName

headMay :: [a] -> Maybe a
headMay = \case
  [] -> Nothing
  x:_ -> Just x

lastMay :: [a] -> Maybe a
lastMay = headMay . reverse

ifM :: Monad m => m Bool -> m a -> m a -> m a
ifM b t f = do x <- b; if x then t else f

whenM :: Monad m => m Bool -> m () -> m ()
whenM b t = ifM b t (pure ())

unlessM :: Monad m => m Bool -> m () -> m ()
unlessM b = whenM (not <$> b)