{-# LANGUAGE Rank2Types, PatternGuards, TupleSections #-}
module CabalCargs.BuildInfo
( field
) where
import Distribution.PackageDescription (BuildInfo(..))
import Distribution.Compiler (PerCompilerFlavor(..))
import Control.Lens
import qualified CabalCargs.Fields as F
import qualified CabalLenses as CL
import Language.Haskell.Extension (Extension(..), KnownExtension(..), Language(..))
field :: F.Field -> Traversal' BuildInfo [String]
field F.Hs_Source_Dirs = CL.hsSourceDirsL
field F.Ghc_Options = CL.optionsL . ghcOptionsL
field F.Default_Extensions = oldAndDefaultExtensionsL . extsToStrings
field F.Default_Language = CL.defaultLanguageL . langToString
field F.Cpp_Options = CL.cppOptionsL
field F.C_Sources = CL.cSourcesL
field F.Cc_Options = CL.ccOptionsL
field F.Extra_Lib_Dirs = CL.extraLibDirsL
field F.Extra_Libraries = CL.extraLibsL
field F.Ld_Options = CL.ldOptionsL
field F.Include_Dirs = CL.includeDirsL
field F.Includes = CL.includesL
field F.Build_Depends = nopLens
field F.Package_Db = nopLens
field F.Root_Dir = nopLens
field F.Autogen_Hs_Source_Dirs = nopLens
field F.Autogen_Include_Dirs = nopLens
field F.Autogen_Includes = nopLens
field F.Hdevtools_Socket = nopLens
oldAndDefaultExtensionsL :: Lens' BuildInfo [Extension]
oldAndDefaultExtensionsL = lens getter setter
where
getter buildInfo = oldExtensions buildInfo ++ defaultExtensions buildInfo
setter buildInfo exts = buildInfo { defaultExtensions = exts }
extsToStrings :: Iso' [Extension] [String]
extsToStrings = iso (map toString) (map toExt)
where
toString ext =
case ext of
EnableExtension knownExt -> show knownExt
DisableExtension knownExt -> "No" ++ show knownExt
UnknownExtension unknownExt -> unknownExt
toExt ('N':'o':rest)
| [(ext, _)] <- reads rest :: [(KnownExtension, String)]
= DisableExtension ext
toExt str
| [(ext, _)] <- reads str :: [(KnownExtension, String)]
= EnableExtension ext
| otherwise
= UnknownExtension str
langToString :: Iso' (Maybe Language) [String]
langToString = iso toString toLang
where
toString Nothing = []
toString (Just lang) =
case lang of
UnknownLanguage l -> [l]
_ -> [show lang]
toLang (str:[])
| [(lang, _)] <- reads str :: [(Language, String)]
= Just lang
| otherwise
= Just $ UnknownLanguage str
toLang _ = Nothing
nopLens :: Lens' BuildInfo [String]
nopLens = lens (const []) const
ghcOptionsL :: Lens' (PerCompilerFlavor [String]) [String]
ghcOptionsL = lens getter setter
where
getter (PerCompilerFlavor ghcOpts _) = ghcOpts
setter (PerCompilerFlavor _ ghcjsOpts) ghcOpts = PerCompilerFlavor ghcOpts ghcjsOpts