module Distribution.Client.Dynamic.PackageDescription
(
Target(..)
, TargetInfo(..)
, PackageDescription()
, targets
, targetName, isLibrary, isExecutable, isTest, isBench
, _name, _mainModule, _info, _dependencies, _sourceDirs, _includeDirs, _ghcOptions, _cppOptions, _extensions, _buildable, _otherModules, _enabled
) where
import Control.Applicative
import Data.Default
import qualified Data.Traversable as T
import Data.Version
import Distribution.Client.Dynamic.Query
import Language.Haskell.Exts.Syntax
import Language.Haskell.Generate
data PackageDescription
data BuildInfo
data CompilerFlavor
data Extension
data Dependency
data ModuleName
instance Eq CompilerFlavor where _ == _ = undefined
data TargetInfo = Library [String]
| Executable String FilePath
| TestSuite String (Maybe FilePath)
| BenchSuite String (Maybe FilePath)
deriving (Show, Eq, Read, Ord)
_name :: Applicative f => (String -> f String) -> TargetInfo -> f TargetInfo
_name _ v@(Library _) = pure v
_name f (Executable n p) = flip Executable p <$> f n
_name f (TestSuite n p) = flip TestSuite p <$> f n
_name f (BenchSuite n p) = flip BenchSuite p <$> f n
_mainModule :: Applicative f => (FilePath -> f FilePath) -> TargetInfo -> f TargetInfo
_mainModule _ v@(Library _) = pure v
_mainModule f (Executable n p) = Executable n <$> f p
_mainModule f (TestSuite n p) = TestSuite n <$> T.traverse f p
_mainModule f (BenchSuite n p) = BenchSuite n <$> T.traverse f p
instance Default TargetInfo where
def = Library []
data Target = Target
{
info :: TargetInfo
, dependencies :: [(String, Maybe Version)]
, sourceDirs :: [FilePath]
, includeDirs :: [FilePath]
, ghcOptions :: [String]
, cppOptions :: [String]
, extensions :: [String]
, buildable :: Bool
, otherModules :: [String]
, enabled :: Bool
} deriving (Show, Eq, Read)
instance Default Target where
def = Target def def def def def def def True def True
(<&>) :: Functor f => f a -> (a -> b) -> f b
(<&>) = flip fmap
_info :: Functor f => (TargetInfo -> f TargetInfo) -> Target -> f Target
_info f t = f (info t) <&> \i -> t { info = i }
_dependencies :: Functor f => ([(String, Maybe Version)] -> f [(String, Maybe Version)]) -> Target -> f Target
_dependencies f t = f (dependencies t) <&> \d -> t { dependencies = d }
_sourceDirs :: Functor f => ([FilePath] -> f [FilePath]) -> Target -> f Target
_sourceDirs f t = f (sourceDirs t) <&> \d -> t { sourceDirs = d }
_includeDirs :: Functor f => ([FilePath] -> f [FilePath]) -> Target -> f Target
_includeDirs f t = f (includeDirs t) <&> \d -> t { includeDirs = d }
_ghcOptions :: Functor f => ([String] -> f [String]) -> Target -> f Target
_ghcOptions f t = f (ghcOptions t) <&> \o -> t { ghcOptions = o }
_cppOptions :: Functor f => ([String] -> f [String]) -> Target -> f Target
_cppOptions f t = f (cppOptions t) <&> \o -> t { cppOptions = o }
_extensions :: Functor f => ([String] -> f [String]) -> Target -> f Target
_extensions f t = f (extensions t) <&> \e -> t { extensions = e }
_buildable :: Functor f => (Bool -> f Bool) -> Target -> f Target
_buildable f t = f (buildable t) <&> \b -> t { buildable = b }
_otherModules :: Functor f => ([String] -> f [String]) -> Target -> f Target
_otherModules f t = f (otherModules t) <&> \m -> t { otherModules = m }
_enabled :: Functor f => (Bool -> f Bool) -> Target -> f Target
_enabled f t = f (enabled t) <&> \e -> t { enabled = e }
targetName :: Target -> String
targetName t = case info t of
(Library _) -> ""
(Executable n _) -> n
(TestSuite n _) -> n
(BenchSuite n _) -> n
isLibrary :: Target -> Bool
isLibrary t = case info t of
(Library _) -> True
_ -> False
isExecutable :: Target -> Bool
isExecutable t = case info t of
(Executable _ _) -> True
_ -> False
isTest :: Target -> Bool
isTest t = case info t of
(TestSuite _ _) -> True
_ -> False
isBench :: Target -> Bool
isBench t = case info t of
(BenchSuite _ _) -> True
_ -> False
buildable' :: Selector BuildInfo Bool
buildable' = selector $ const $ useValue "Distribution.PackageDescription" $ Ident "buildable"
hsSourceDirs' :: Selector BuildInfo [FilePath]
hsSourceDirs' = selector $ const $ useValue "Distribution.PackageDescription" $ Ident "hsSourceDirs"
includeDirs' :: Selector BuildInfo [FilePath]
includeDirs' = selector $ const $ useValue "Distribution.PackageDescription" $ Ident "includeDirs"
extensions' :: Selector BuildInfo [String]
extensions' = selector $ const $ expr $ \bi -> applyE2 map' display' $ applyE concat' $ expr $ map (<>$ bi) [defaultExtensions', oldExtensions', otherExtensions']
where display' :: ExpG (Extension -> String)
display' = useValue "Distribution.Text" $ Ident "display"
defaultExtensions', oldExtensions',otherExtensions' :: ExpG (BuildInfo -> [Extension])
defaultExtensions' = useValue "Distribution.PackageDescription" $ Ident "defaultExtensions"
oldExtensions' = useValue "Distribution.PackageDescription" $ Ident "oldExtensions"
otherExtensions' = useValue "Distribution.PackageDescription" $ Ident "otherExtensions"
ghcOptions' :: Selector BuildInfo [String]
ghcOptions' = selector $ const $ concat' <>. applyE map' snd' <>. applyE filter' (applyE equal' ghc <>. fst') <>. options'
where options' :: ExpG (BuildInfo -> [(CompilerFlavor, [String])])
options' = useValue "Distribution.PackageDescription" $ Ident "options"
ghc :: ExpG CompilerFlavor
ghc = useValue "Distribution.Compiler" $ Ident "GHC"
cppOptions' :: Selector BuildInfo [String]
cppOptions' = selector $ const options'
where options' :: ExpG (BuildInfo -> [String])
options' = useValue "Distribution.PackageDescription" $ Ident "cppOptions"
otherModules' :: Selector BuildInfo [String]
otherModules' = selector $ const $ applyE map' display' <>. mods'
where display' :: ExpG (Distribution.Client.Dynamic.PackageDescription.ModuleName -> String)
display' = useValue "Distribution.Text" $ Ident "display"
mods' :: ExpG (BuildInfo -> [Distribution.Client.Dynamic.PackageDescription.ModuleName])
mods' = useValue "Distribution.PackageDescription" $ Ident "otherModules"
dependencies' :: Selector BuildInfo [(String, Maybe Version)]
dependencies' = selector $ const $ applyE map' serializeDep <>. targetBuildDepends'
where serializeDep :: ExpG (Dependency -> (String, Maybe Version))
serializeDep = expr $ \dep -> do
dependency <- useCon "Distribution.Package" $ Ident "Dependency"
packageName <- useCon "Distribution.Package" $ Ident "PackageName"
let isSpecificVersion = useValue "Distribution.Version" $ Ident "isSpecificVersion"
nameVar <- newName "name"
versionVar <- newName "version"
caseE dep
[ ( PApp dependency [PApp packageName [PVar nameVar], PVar versionVar],
tuple2 <>$ useVar nameVar <>$ applyE isSpecificVersion (useVar versionVar)
)
]
targetBuildDepends' :: ExpG (BuildInfo -> [Dependency])
targetBuildDepends' = useValue "Distribution.PackageDescription" $ Ident "targetBuildDepends"
buildInfoTarget :: Query BuildInfo (TargetInfo -> Bool -> Target)
buildInfoTarget = (\d src inc opts copts exts ba oths n-> Target n d src inc opts copts exts ba oths)
<$> query dependencies'
<*> query hsSourceDirs'
<*> query includeDirs'
<*> query ghcOptions'
<*> query cppOptions'
<*> query extensions'
<*> query buildable'
<*> query otherModules'
library' :: ExpG (PackageDescription -> [([String],BuildInfo)])
library' = applyE2 maybe' (returnE $ List []) serialize' <>. useValue "Distribution.PackageDescription" (Ident "library")
where serialize' = expr $ \lib -> applyE2 cons (tuple2 <>$ applyE modNames' lib <>$ applyE buildInfo' lib) (returnE $ List [])
modNames'=applyE map' display' <>. mods'
display' = useValue "Distribution.Text" $ Ident "display"
mods' = useValue "Distribution.PackageDescription" $ Ident "exposedModules"
buildInfo' = useValue "Distribution.PackageDescription" $ Ident "libBuildInfo"
executables' :: ExpG (PackageDescription -> [((String,FilePath), BuildInfo)])
executables'= applyE map' serialize' <>. useValue "Distribution.PackageDescription" (Ident "executables")
where serialize' = expr $ \exe -> tuple2 <>$ applyE exeInfo exe <>$ applyE buildInfo' exe
exeInfo= expr $ \exe -> tuple2 <>$ applyE exeName' exe <>$ applyE modulePath' exe
exeName' = useValue "Distribution.PackageDescription" $ Ident "exeName"
modulePath'= useValue "Distribution.PackageDescription" $ Ident "modulePath"
buildInfo' = useValue "Distribution.PackageDescription" $ Ident "buildInfo"
exitCodeStdioPath' :: String -> ExpG (a -> Maybe String)
exitCodeStdioPath' conName = expr $ \i -> do
con <- useCon "Distribution.PackageDescription" $ Ident conName
pathVar <- newName "filepath"
caseE i
[ (PApp con [PWildCard, PVar pathVar], applyE just' $ useVar pathVar)
, (PWildCard, nothing')
]
tests' :: ExpG (PackageDescription -> [((String, Bool,Maybe FilePath), BuildInfo)])
tests' = applyE map' serialize' <>. useValue "Distribution.PackageDescription" (Ident "testSuites")
where serialize' = expr $ \test -> tuple2
<>$ applyE3 tuple3 (testName' <>$ test) (testEnabled' <>$ test) (exitCodeStdioPath' "TestSuiteExeV10" <>. testInterface' <>$ test)
<>$ applyE buildInfo' test
testName' = useValue "Distribution.PackageDescription" $ Ident "testName"
testEnabled' = useValue "Distribution.PackageDescription" $ Ident "testEnabled"
buildInfo' = useValue "Distribution.PackageDescription" $ Ident "testBuildInfo"
testInterface' = useValue "Distribution.PackageDescription" $ Ident "testInterface"
benchmarks' :: ExpG (PackageDescription -> [((String, Bool,Maybe FilePath), BuildInfo)])
benchmarks' = applyE map' serialize' <>. useValue "Distribution.PackageDescription" (Ident "benchmarks")
where serialize' = expr $ \bench -> tuple2
<>$ applyE3 tuple3 (benchName' <>$ bench) (benchEnabled' <>$ bench) (exitCodeStdioPath' "BenchmarkExeV10" <>. benchInterface' <>$ bench)
<>$ applyE buildInfo' bench
benchName' = useValue "Distribution.PackageDescription" $ Ident "benchmarkName"
benchEnabled' = useValue "Distribution.PackageDescription" $ Ident "benchmarkEnabled"
buildInfo' = useValue "Distribution.PackageDescription" $ Ident "benchmarkBuildInfo"
benchInterface' = useValue "Distribution.PackageDescription" $ Ident "benchmarkInterface"
targetInfos :: Query PackageDescription [(TargetInfo, Bool)]
targetInfos = build <$> query libMods <*> query exeNames <*> query testInfo <*> query benchInfo
where libMods :: Selector PackageDescription [[String]]
libMods = selector $ const $ applyE map' fst' <>. library'
exeNames :: Selector PackageDescription [(String,FilePath)]
exeNames = selector $ const $ applyE map' fst' <>. executables'
testInfo :: Selector PackageDescription [(String, Bool,Maybe FilePath)]
testInfo = selector $ const $ applyE map' fst' <>. tests'
benchInfo :: Selector PackageDescription [(String, Bool,Maybe FilePath)]
benchInfo = selector $ const $ applyE map' fst' <>. benchmarks'
build lib exe test bench = concat
[ [ (Library x , True) | x <- lib ]
, [ (Executable x mp, True) | (x,mp) <- exe ]
, [ (TestSuite x mp, e ) | (x,e,mp) <- test ]
, [ (BenchSuite x mp, e ) | (x,e,mp) <- bench ]
]
buildInfos :: Selector PackageDescription [BuildInfo]
buildInfos = selector $ const $ expr $ \bi -> applyE concat' $ expr $ map (<>$ bi) [libraryBI, exesBI, testsBI, benchsBI]
where libraryBI :: ExpG (PackageDescription -> [BuildInfo])
libraryBI = applyE map' snd' <>. library'
exesBI :: ExpG (PackageDescription -> [BuildInfo])
exesBI = applyE map' snd' <>. executables'
testsBI :: ExpG (PackageDescription -> [BuildInfo])
testsBI = applyE map' snd' <>. tests'
benchsBI :: ExpG (PackageDescription -> [BuildInfo])
benchsBI = applyE map' snd' <>. benchmarks'
targets :: Query PackageDescription [Target]
targets = zipWith uncurry <$> on buildInfos (fmapQ buildInfoTarget) <*> targetInfos