{-# 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
(Int -> CondVars -> ShowS)
-> (CondVars -> FlagName) -> ([CondVars] -> ShowS) -> Show CondVars
forall a.
(Int -> a -> ShowS) -> (a -> FlagName) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CondVars -> ShowS
showsPrec :: Int -> CondVars -> ShowS
$cshow :: CondVars -> FlagName
show :: CondVars -> FlagName
$cshowList :: [CondVars] -> ShowS
showList :: [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 = Maybe Version
forall a. Maybe a
Nothing
                                  }
   where
      flags :: FlagMap
flags = [(FlagName, Bool)] -> FlagMap
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList ([(FlagName, Bool)] -> FlagMap) -> [(FlagName, Bool)] -> FlagMap
forall a b. (a -> b) -> a -> b
$ (PackageFlag -> (FlagName, Bool))
-> [PackageFlag] -> [(FlagName, Bool)]
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 CondVars -> (CondVars -> CondVars) -> CondVars
forall a b. a -> (a -> b) -> b
& (FlagMap -> Identity FlagMap) -> CondVars -> Identity CondVars
Lens' CondVars FlagMap
flagsL ((FlagMap -> Identity FlagMap) -> CondVars -> Identity CondVars)
-> (FlagMap -> FlagMap) -> CondVars -> CondVars
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ FlagName -> Bool -> FlagMap -> FlagMap
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 CondVars -> (CondVars -> CondVars) -> CondVars
forall a b. a -> (a -> b) -> b
& (FlagMap -> Identity FlagMap) -> CondVars -> Identity CondVars
Lens' CondVars FlagMap
flagsL ((FlagMap -> Identity FlagMap) -> CondVars -> Identity CondVars)
-> (FlagMap -> FlagMap) -> CondVars -> CondVars
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ FlagName -> Bool -> FlagMap -> FlagMap
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 (Bool -> Bool) -> Bool -> Bool
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 OS -> OS -> Bool
forall a. Eq a => a -> a -> Bool
== CondVars -> OS
os CondVars
condVars
      hasVar (PD.Arch Arch
archVar) = Arch
archVar Arch -> Arch -> Bool
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 CompilerFlavor -> CompilerFlavor -> Bool
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 CompilerFlavor -> CompilerFlavor -> Bool
forall a. Eq a => a -> a -> Bool
== CondVars -> CompilerFlavor
compilerFlavor CondVars
condVars

      hasVar (PD.PackageFlag FlagName
name)
         | Just Bool
v <- FlagName -> FlagMap -> Maybe Bool
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