module Distribution.Client.Dynamic.PackageDescription
( Target(..)
, TargetInfo(..)
, PackageDescription()
, targets
, targetName, isLibrary, isExecutable, isTest, isBench
) where
import Control.Applicative
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
deriving (Show, Eq, Read, Ord)
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)
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"
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) (testPath <>. 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"
testPath=expr $ \ti->do
v10 <- useCon "Distribution.PackageDescription" $ Ident "TestSuiteExeV10"
versionVar <- newName "version"
fpVar <- newName "filepath"
caseE ti
[(PApp v10 [PVar versionVar,PVar fpVar],applyE just' (useVar fpVar))
,(PWildCard,nothing')
]
benchmarks' :: ExpG (PackageDescription -> [((String, Bool), BuildInfo)])
benchmarks' = applyE map' serialize' <>. useValue "Distribution.PackageDescription" (Ident "benchmarks")
where serialize' = expr $ \bench -> tuple2
<>$ applyE2 tuple2 (benchName' <>$ bench) (benchEnabled' <>$ bench)
<>$ applyE buildInfo' bench
benchName' = useValue "Distribution.PackageDescription" $ Ident "benchmarkName"
benchEnabled' = useValue "Distribution.PackageDescription" $ Ident "benchmarkEnabled"
buildInfo' = useValue "Distribution.PackageDescription" $ Ident "benchmarkBuildInfo"
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)]
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 , e ) | (x,e) <- 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