{-# LANGUAGE CPP #-}
{-# LANGUAGE PatternSynonyms #-}

module Distribution.ArchHs.Compat
  ( pattern PkgFlag,
    PkgFlag,
    licenseFile,
  )
where

import Data.Maybe (listToMaybe)
import Distribution.Types.ConfVar
import Distribution.Types.Flag
import Distribution.Types.PackageDescription (PackageDescription, licenseFiles)
#if MIN_VERSION_Cabal(3,6,0)
import Distribution.Utils.Path (getSymbolicPath)
#endif

pattern PkgFlag :: FlagName -> ConfVar
{-# COMPLETE PkgFlag #-}

#if MIN_VERSION_Cabal(3,4,0)
type PkgFlag = PackageFlag
pattern $bPkgFlag :: FlagName -> ConfVar
$mPkgFlag :: forall {r}. ConfVar -> (FlagName -> r) -> ((# #) -> r) -> r
PkgFlag x = PackageFlag x
#else
type PkgFlag = Flag
pattern PkgFlag x = Flag x
#endif

licenseFile :: PackageDescription -> Maybe FilePath
#if MIN_VERSION_Cabal(3,6,0)
licenseFile :: PackageDescription -> Maybe FilePath
licenseFile = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall from to. SymbolicPath from to -> FilePath
getSymbolicPath forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Maybe a
listToMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageDescription -> [SymbolicPath PackageDir LicenseFile]
licenseFiles
#else
licenseFile = listToMaybe . licenseFiles
#endif