{-# Language TemplateHaskell, PatternGuards #-}

module CabalLenses.CondVars
   ( CondVars(..)
   , fromDefaults
   , enableFlag
   , disableFlag
   , eval
   ) where

import qualified Distribution.PackageDescription as PD
import Distribution.PackageDescription (Condition(..))
import Distribution.Types.Flag (PackageFlag(..))
import qualified Distribution.System as S
import Distribution.System (OS(..), Arch(..))
import Distribution.Compiler (CompilerFlavor(..), buildCompilerFlavor)
import Distribution.Version (Version, withinRange)
import qualified Data.HashMap.Strict as HM
import Control.Lens

type FlagName = String
type FlagMap  = HM.HashMap FlagName Bool


-- | The variables that are used to resolve the conditionals inside of the cabal file.
--   Holds the enable state of the cabal flags, the used OS, ARCH, CompilerFlavor and
--   compiler version.
data CondVars = CondVars
   { CondVars -> FlagMap
flags           :: FlagMap          -- ^ the enable state of the flags, initialized with the default flag values in the cabal file
   , CondVars -> OS
os              :: OS               -- ^ the used OS, by default the one cabal was build on
   , CondVars -> Arch
arch            :: Arch             -- ^ the used ARCH, by default the one cabal was build on
   , CondVars -> CompilerFlavor
compilerFlavor  :: CompilerFlavor   -- ^ the used CompilerFlavor, by default the one cabal was build on
   , CondVars -> Maybe Version
compilerVersion :: Maybe Version    -- ^ the user specified compiler version
   } deriving (Int -> CondVars -> ShowS
[CondVars] -> ShowS
CondVars -> FlagName
forall a.
(Int -> a -> ShowS) -> (a -> FlagName) -> ([a] -> ShowS) -> Show a
showList :: [CondVars] -> ShowS
$cshowList :: [CondVars] -> ShowS
show :: CondVars -> FlagName
$cshow :: CondVars -> FlagName
showsPrec :: Int -> CondVars -> ShowS
$cshowsPrec :: Int -> CondVars -> ShowS
Show)


makeLensesFor [ ("flags", "flagsL")
              ] ''CondVars


-- | Create a 'CondVars' from the default flags of the cabal package description.
--   The 'os', 'arch' and 'compilerFlavor' fields are initialized by the ones the cabal library was build on.
fromDefaults :: PD.GenericPackageDescription -> CondVars
fromDefaults :: GenericPackageDescription -> CondVars
fromDefaults GenericPackageDescription
pkgDescrp = CondVars { flags :: FlagMap
flags           = FlagMap
flags
                                  , os :: OS
os              = OS
S.buildOS
                                  , arch :: Arch
arch            = Arch
S.buildArch
                                  , compilerFlavor :: CompilerFlavor
compilerFlavor  = CompilerFlavor
buildCompilerFlavor
                                  , compilerVersion :: Maybe Version
compilerVersion = forall a. Maybe a
Nothing
                                  }
   where
      flags :: FlagMap
flags = forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map PackageFlag -> (FlagName, Bool)
nameWithDflt (GenericPackageDescription -> [PackageFlag]
PD.genPackageFlags GenericPackageDescription
pkgDescrp)

      nameWithDflt :: PackageFlag -> (FlagName, Bool)
nameWithDflt MkPackageFlag { flagName :: PackageFlag -> FlagName
PD.flagName = FlagName
name, flagDefault :: PackageFlag -> Bool
PD.flagDefault = Bool
dflt } =
         (FlagName -> FlagName
PD.unFlagName FlagName
name, Bool
dflt)


-- | Enable the given flag in 'CondVars'.
enableFlag :: FlagName -> CondVars -> CondVars
enableFlag :: FlagName -> CondVars -> CondVars
enableFlag FlagName
flag CondVars
condVars =
   CondVars
condVars forall a b. a -> (a -> b) -> b
& Lens' CondVars FlagMap
flagsL forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert FlagName
flag Bool
True


-- | Disable the given flag in 'CondVars'.
disableFlag :: FlagName -> CondVars -> CondVars
disableFlag :: FlagName -> CondVars -> CondVars
disableFlag FlagName
flag CondVars
condVars =
   CondVars
condVars forall a b. a -> (a -> b) -> b
& Lens' CondVars FlagMap
flagsL forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert FlagName
flag Bool
False


-- | Evaluate the 'Condition' using the 'CondVars'.
eval :: CondVars -> Condition PD.ConfVar -> Bool
eval :: CondVars -> Condition ConfVar -> Bool
eval CondVars
condVars = Condition ConfVar -> Bool
eval'
   where
      eval' :: Condition ConfVar -> Bool
eval' (Var ConfVar
var)    = ConfVar -> Bool
hasVar ConfVar
var
      eval' (Lit Bool
val)    = Bool
val
      eval' (CNot Condition ConfVar
c)     = Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Condition ConfVar -> Bool
eval' Condition ConfVar
c
      eval' (COr Condition ConfVar
c1 Condition ConfVar
c2)  = Condition ConfVar -> Bool
eval' Condition ConfVar
c1 Bool -> Bool -> Bool
|| Condition ConfVar -> Bool
eval' Condition ConfVar
c2
      eval' (CAnd Condition ConfVar
c1 Condition ConfVar
c2) = Condition ConfVar -> Bool
eval' Condition ConfVar
c1 Bool -> Bool -> Bool
&& Condition ConfVar -> Bool
eval' Condition ConfVar
c2

      hasVar :: ConfVar -> Bool
hasVar (PD.OS OS
osVar)     = OS
osVar forall a. Eq a => a -> a -> Bool
== CondVars -> OS
os CondVars
condVars
      hasVar (PD.Arch Arch
archVar) = Arch
archVar forall a. Eq a => a -> a -> Bool
== CondVars -> Arch
arch CondVars
condVars
      hasVar (PD.Impl CompilerFlavor
cflavor VersionRange
vrange)
         | Just Version
version <- CondVars -> Maybe Version
compilerVersion CondVars
condVars
         = CompilerFlavor
cflavor forall a. Eq a => a -> a -> Bool
== CondVars -> CompilerFlavor
compilerFlavor CondVars
condVars Bool -> Bool -> Bool
&& Version
version Version -> VersionRange -> Bool
`withinRange` VersionRange
vrange

         | Bool
otherwise
         = CompilerFlavor
cflavor forall a. Eq a => a -> a -> Bool
== CondVars -> CompilerFlavor
compilerFlavor CondVars
condVars

      hasVar (PD.PackageFlag FlagName
name)
         | Just Bool
v <- forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup (FlagName -> FlagName
PD.unFlagName FlagName
name) (CondVars -> FlagMap
flags CondVars
condVars)
         = Bool
v

         | Bool
otherwise
         = Bool
False