Skip to content
This repository
Browse code

Using new cabal pretty printer (copied as long as not provided from C…

…abal).
  • Loading branch information...
commit cb708d58de739014ba258d0a4a033579d9f16e62 1 parent 5802a4d
Jürgen Nicklisch-Franken jutaro authored
17 src/IDE/ImportTool.hs
@@ -55,7 +55,8 @@ import IDE.Pane.PackageEditor (hasConfigs)
55 55 import Distribution.Package
56 56 import Distribution.Version (VersionRange(..))
57 57 import Distribution.PackageDescription
58   - (packageDescription, buildDepends)
  58 + (CondTree(..), condExecutables, condLibrary, packageDescription,
  59 + buildDepends)
59 60 import Distribution.PackageDescription.Configuration
60 61 (flattenPackageDescription)
61 62 import IDE.BufferMode (editInsertCode)
@@ -137,13 +138,19 @@ addPackage error = do
137 138 Nothing -> return False
138 139 Just (HiddenModuleResult mod pack) -> do
139 140 let idePackage = logRefPackage error
140   - package <- liftIO $ readPackageDescription normal (ipdCabalFile $ idePackage)
  141 + gpd <- liftIO $ readPackageDescription normal (ipdCabalFile $ idePackage)
141 142 ideMessage Normal $ "addPackage " ++ (display $ pkgName pack)
142 143 liftIO $ writeGenericPackageDescription (ipdCabalFile $ idePackage)
143   - package { packageDescription = (packageDescription package){
144   - buildDepends = Dependency (pkgName pack) AnyVersion
145   - : buildDepends (packageDescription package)}}
  144 + gpd { condLibrary = addDepToLib (packageName pack) (condLibrary gpd),
  145 + condExecutables = map (addDepToExe (packageName pack))
  146 + (condExecutables gpd)}
146 147 return True
  148 + where
  149 + addDepToLib n Nothing = Nothing
  150 + addDepToLib n (Just cn@CondNode{condTreeConstraints = deps}) =
  151 + Just (cn{condTreeConstraints = (Dependency n AnyVersion) : deps})
  152 + addDepToExe n (str,cn@CondNode{condTreeConstraints = deps}) =
  153 + (str,cn{condTreeConstraints = (Dependency n AnyVersion) : deps})
147 154
148 155 getScopeForActiveBuffer :: IDEM (Maybe (GenScope, GenScope))
149 156 getScopeForActiveBuffer = do
122 src/IDE/Package.hs
@@ -61,6 +61,7 @@ module IDE.Package (
61 61 , choosePackageFile
62 62
63 63 , idePackageFromPath
  64 +
64 65 ) where
65 66
66 67 import Graphics.UI.Gtk
@@ -475,77 +476,90 @@ getModuleTemplate pd modName exports body = catch (do
475 476 (\ (e :: SomeException) -> sysMessage Normal ("Couldn't read template file: " ++ show e) >> return "")
476 477
477 478 addModuleToPackageDescr :: ModuleName -> Bool -> PackageAction
478   -addModuleToPackageDescr moduleName isExposed = trace ("addModule " ++ show moduleName) $ do
  479 +addModuleToPackageDescr moduleName isExposed = do
479 480 p <- ask
480 481 lift $ reifyIDE (\ideR -> catch (do
481 482 gpd <- readPackageDescription normal (ipdCabalFile p)
482   - let pd = trace ("gpd " ++ show gpd) $ packageDescription gpd
483   - let npd = if isExposed && isJust (library pd)
484   - then trace "1" $ gpd{
485   - packageDescription = pd{
486   - library = Just ((fromJust (library pd))
487   - {exposedModules =
488   - moduleName : exposedModules
489   - (fromJust $ library pd)})}}
490   - else trace "2" $
491   - let npd1 = case library pd of
492   - Nothing -> gpd
493   - Just lib -> gpd{
494   - packageDescription = pd{library =
495   - Just (lib{libBuildInfo =
496   - addModToBuildInfo (libBuildInfo lib) moduleName})}}
497   - pd1 = packageDescription npd1
498   - in npd1{packageDescription = pd1{executables = map
499   - (\exe -> exe{buildInfo = addModToBuildInfo (buildInfo exe) moduleName})
500   - (executables pd1)}}
501   - trace ("write " ++ ipdCabalFile p ++ " exposed: " ++ show
502   - (exposedModules (fromJust (library (packageDescription npd)))))
503   - $ writeGenericPackageDescription (ipdCabalFile p) npd)
  483 + let npd = if isExposed && isJust (condLibrary gpd)
  484 + then gpd{
  485 + condLibrary = Just (addModToLib moduleName
  486 + (fromJust (condLibrary gpd))),
  487 + condExecutables = map (addModToBuildInfoExe moduleName)
  488 + (condExecutables gpd)}
  489 + else gpd{
  490 + condLibrary = case condLibrary gpd of
  491 + Nothing -> Nothing
  492 + Just lib -> Just (addModToBuildInfoLib moduleName
  493 + (fromJust (condLibrary gpd))),
  494 + condExecutables = map (addModToBuildInfoExe moduleName)
  495 + (condExecutables gpd)}
  496 + writeGenericPackageDescription (ipdCabalFile p) npd)
504 497 (\(e :: SomeException) -> do
505 498 reflectIDE (ideMessage Normal ("Can't update package " ++ show e)) ideR
506 499 return ()))
507   - where
508   - addModToBuildInfo :: BuildInfo -> ModuleName -> BuildInfo
509   - addModToBuildInfo bi mn = bi {otherModules = mn : otherModules bi}
  500 +
  501 +addModToLib :: ModuleName -> CondTree ConfVar [Dependency] Library ->
  502 + CondTree ConfVar [Dependency] Library
  503 +addModToLib modName ct@CondNode{condTreeData = lib} =
  504 + ct{condTreeData = lib{exposedModules = modName : exposedModules lib}}
  505 +
  506 +addModToBuildInfoLib :: ModuleName -> CondTree ConfVar [Dependency] Library ->
  507 + CondTree ConfVar [Dependency] Library
  508 +addModToBuildInfoLib modName ct@CondNode{condTreeData = lib} =
  509 + ct{condTreeData = lib{libBuildInfo = (libBuildInfo lib){otherModules = modName
  510 + : otherModules (libBuildInfo lib)}}}
  511 +
  512 +addModToBuildInfoExe :: ModuleName -> (String, CondTree ConfVar [Dependency] Executable) ->
  513 + (String, CondTree ConfVar [Dependency] Executable)
  514 +addModToBuildInfoExe modName (str,ct@CondNode{condTreeData = exe}) =
  515 + (str, ct{condTreeData = exe{buildInfo = (buildInfo exe){otherModules = modName
  516 + : otherModules (buildInfo exe)}}})
510 517
511 518 --------------------------------------------------------------------------
512 519 delModuleFromPackageDescr :: ModuleName -> PackageAction
513   -delModuleFromPackageDescr moduleName = do
  520 +delModuleFromPackageDescr moduleName = trace ("addModule " ++ show moduleName) $ do
514 521 p <- ask
515 522 lift $ reifyIDE (\ideR -> catch (do
516 523 gpd <- readPackageDescription normal (ipdCabalFile p)
517   - let pd = packageDescription gpd
518   - isExposedAndJust = isExposedModule pd moduleName
519   - npd = if isExposedAndJust
520   - then gpd{
521   - packageDescription = pd{
522   - library = Just ((fromJust (library pd)){exposedModules =
523   - delete moduleName (exposedModules (fromJust $ library pd))})}}
524   - else let npd1 = case library pd of
525   - Nothing -> gpd
526   - Just lib -> gpd{
527   - packageDescription = pd{library = Just (lib{libBuildInfo =
528   - delModFromBuildInfo (libBuildInfo lib) moduleName})}}
529   - pd1 = packageDescription npd1
530   - in gpd{packageDescription = pd1{executables = map
531   - (\exe -> exe{buildInfo = delModFromBuildInfo (buildInfo exe) moduleName})
532   - (executables pd1)}}
  524 + let isExposedAndJust = isExposedModule moduleName (condLibrary gpd)
  525 + let npd = if isExposedAndJust
  526 + then gpd{
  527 + condLibrary = Just (delModFromLib moduleName
  528 + (fromJust (condLibrary gpd))),
  529 + condExecutables = map (delModFromBuildInfoExe moduleName)
  530 + (condExecutables gpd)}
  531 + else gpd{
  532 + condLibrary = case condLibrary gpd of
  533 + Nothing -> Nothing
  534 + Just lib -> Just (delModFromBuildInfoLib moduleName
  535 + (fromJust (condLibrary gpd))),
  536 + condExecutables = map (delModFromBuildInfoExe moduleName)
  537 + (condExecutables gpd)}
533 538 writeGenericPackageDescription (ipdCabalFile p) npd)
534 539 (\(e :: SomeException) -> do
535 540 reflectIDE (ideMessage Normal ("Can't update package " ++ show e)) ideR
536 541 return ()))
537   - where
538   - delModFromBuildInfo :: BuildInfo -> ModuleName -> BuildInfo
539   - delModFromBuildInfo bi mn = bi {otherModules = delete mn (otherModules bi)}
540   -
541 542
542   -isExposedModule :: PackageDescription -> ModuleName -> Bool
543   -isExposedModule pd mn = do
544   - if isJust (library pd)
545   - then elem mn (exposedModules (fromJust $ library pd))
546   - else False
547   -
548   ---------------------------------------------------------------------------
  543 +delModFromLib :: ModuleName -> CondTree ConfVar [Dependency] Library ->
  544 + CondTree ConfVar [Dependency] Library
  545 +delModFromLib modName ct@CondNode{condTreeData = lib} =
  546 + ct{condTreeData = lib{exposedModules = delete modName (exposedModules lib)}}
  547 +
  548 +delModFromBuildInfoLib :: ModuleName -> CondTree ConfVar [Dependency] Library ->
  549 + CondTree ConfVar [Dependency] Library
  550 +delModFromBuildInfoLib modName ct@CondNode{condTreeData = lib} =
  551 + ct{condTreeData = lib{libBuildInfo = (libBuildInfo lib){otherModules =
  552 + delete modName (otherModules (libBuildInfo lib))}}}
  553 +
  554 +delModFromBuildInfoExe :: ModuleName -> (String, CondTree ConfVar [Dependency] Executable) ->
  555 + (String, CondTree ConfVar [Dependency] Executable)
  556 +delModFromBuildInfoExe modName (str,ct@CondNode{condTreeData = exe}) =
  557 + (str, ct{condTreeData = exe{buildInfo = (buildInfo exe){otherModules =
  558 + delete modName (otherModules (buildInfo exe))}}})
  559 +
  560 +isExposedModule :: ModuleName -> Maybe (CondTree ConfVar [Dependency] Library) -> Bool
  561 +isExposedModule mn Nothing = False
  562 +isExposedModule mn (Just CondNode{condTreeData = lib}) = elem mn (exposedModules lib)
549 563
550 564
551 565 backgroundBuildToggled :: IDEAction
42 src/IDE/Pane/PackageEditor.hs
@@ -109,6 +109,38 @@ import Control.Monad.Trans.Class (lift)
109 109 import Control.Monad (when)
110 110 import Distribution.PackageDescription.PrettyPrintCopied(writeGenericPackageDescription)
111 111
  112 +--------------------------------------------------------------------------
  113 +-- Handling of Generic Package Descriptions
  114 +
  115 +toGenericPackageDescription :: PackageDescription -> GenericPackageDescription
  116 +toGenericPackageDescription pd =
  117 + GenericPackageDescription {
  118 + packageDescription = pd{
  119 + library = Nothing,
  120 + executables = [],
  121 + buildDepends = []},
  122 + genPackageFlags = [],
  123 + condLibrary = case library pd of
  124 + Nothing -> Nothing
  125 + Just lib -> Just (buildCondTreeLibrary lib),
  126 + condExecutables = map buildCondTreeExe (executables pd),
  127 + condTestSuites = map buildCondTreeTest (testSuites pd)}
  128 + where
  129 + buildCondTreeLibrary lib =
  130 + CondNode {
  131 + condTreeData = lib,
  132 + condTreeConstraints = buildDepends pd,
  133 + condTreeComponents = []}
  134 + buildCondTreeExe exe =
  135 + (exeName exe, CondNode {
  136 + condTreeData = exe,
  137 + condTreeConstraints = buildDepends pd,
  138 + condTreeComponents = []})
  139 + buildCondTreeTest test =
  140 + (testName test, CondNode {
  141 + condTreeData = test,
  142 + condTreeConstraints = buildDepends pd,
  143 + condTreeComponents = []})
112 144
113 145 -- ---------------------------------------------------------------------
114 146 -- The exported stuff goes here
@@ -407,7 +439,7 @@ builder' packageDir packageD packageDescr afterSaveAction initialPackagePath mod
407 439 Just newPackage' -> let newPackage = fromEditor newPackage' in do
408 440 let packagePath = packageDir </> (display . pkgName . package . pd) newPackage'
409 441 ++ ".cabal"
410   - writeGenericPackageDescription packagePath (toGeneric newPackage)
  442 + writeGenericPackageDescription packagePath (toGenericPackageDescription newPackage)
411 443 reflectIDE (do
412 444 afterSaveAction packagePath
413 445 closePane packagePane
@@ -428,14 +460,6 @@ builder' packageDir packageD packageDescr afterSaveAction initialPackagePath mod
428 460 return e)
429 461 return (Just packagePane,[])
430 462
431   -
432   -toGeneric :: PackageDescription -> GenericPackageDescription
433   -toGeneric pd = GenericPackageDescription {
434   - packageDescription = pd,
435   - genPackageFlags = [],
436   - condLibrary = Nothing,
437   - condExecutables = [],
438   - condTestSuites = []}
439 463 -- ---------------------------------------------------------------------
440 464 -- The description with some tricks
441 465 --

0 comments on commit cb708d5

Please sign in to comment.
Something went wrong with that request. Please try again.