Merge pull request #158 from phadej/docspec-target-cn

pkgname:libname target syntax
phadej · Jul 20, 2024 · 68e436d · 68e436d
2 parents 67a8895 + 9db2099
commit 68e436d
Show file tree

Hide file tree

Showing 9 changed files with 82 additions and 32 deletions.
diff --git a/cabal-docspec/Changelog.md b/cabal-docspec/Changelog.md
@@ -1,3 +1,7 @@
+# 0.0.0.2024mmdd
+
+- Accecpt @pkgname:libname@ target syntax
+
 # 0.0.0.20240703
 
 - Fix "Project Unit Id" bug

diff --git a/cabal-docspec/cabal-docspec.cabal b/cabal-docspec/cabal-docspec.cabal
@@ -1,6 +1,6 @@
 cabal-version:      2.2
 name:               cabal-docspec
-version:            0.0.0.20240703
+version:            0.0.0.20240720
 synopsis:           Run examples in your docs
 category:           Development
 description:

diff --git a/cabal-docspec/src/CabalDocspec/Main.hs b/cabal-docspec/src/CabalDocspec/Main.hs
@@ -22,6 +22,7 @@ import qualified Distribution.ModuleName                      as C
 import qualified Distribution.Package                         as C
 import qualified Distribution.System                          as C
 import qualified Distribution.Types.BuildInfo                 as C
+import qualified Distribution.Types.ComponentName             as C
 import qualified Distribution.Types.CondTree                  as C
 import qualified Distribution.Types.ConfVar                   as C
 import qualified Distribution.Types.Flag                      as C
@@ -94,15 +95,15 @@ main = do
                 pkgs <-
                     if null (optTargets opts)
                     then return pkgs0
-                    else fmap concat $ for (optTargets opts) $ \target -> do
+                    else fmap concat $ for (optTargets opts) $ \(Target pn _) -> do
                         let match =
                                 [ pkg
                                 | pkg <- pkgs0
-                                , prettyShow (C.packageName (pkgGpd pkg)) == target
+                                , C.packageName (pkgGpd pkg) == pn
                                 ]
 
                         case match of
-                            []  -> die tracer $ "No package " ++ target ++ " in the plan"
+                            []  -> die tracer $ "No package " ++ prettyShow pn ++ " in the plan"
                             _   -> return match
 
                 -- collect environment of datadirs
@@ -115,19 +116,32 @@ main = do
                         , not (null (C.dataFiles pd))
                         ]
 
+                let checkComponent :: C.PackageName -> C.ComponentName -> Bool
+                    checkComponent pn cn
+                        | null (optTargets opts) = True
+                        | otherwise = any p $ optTargets opts
+                      where
+                        p (Target pn' Nothing)   = pn == pn'
+                        p (Target pn' (Just ln)) = pn == pn' && cn == C.CLibName ln
+
                 -- process components
                 res <- for pkgs $ \pkg -> do
                     for (pkgUnits pkg) $ \unit ->
                         ifor (Plan.uComps unit) $ \cn ci -> do
-                            testComponent tracer0 tracer (optGhci opts)
-                                ghcInfo buildDir cabalCfg plan env pkg unit cn ci
+                            if checkComponent (C.packageName (pkgGpd pkg)) (toCabal cn)
+                            then testComponent tracer0 tracer (optGhci opts)
+                                    ghcInfo buildDir cabalCfg plan env pkg unit cn ci
+                            else return mempty
 
                 -- summarize Summary's
                 return $ foldMap (foldMap (foldMap id)) res
 
             NoCabalPlan -> do
                 dbG <- readPackageDb tracer (ghcGlobalDb ghcInfo)
-                pkgs <- readDirectCabalFiles tracer (optTargets opts)
+                pkgs <- readDirectCabalFiles tracer
+                    [ prettyShow pn
+                    | Target pn _ <- optTargets opts
+                    ]
 
                 -- process components
                 res <- for pkgs $ \pkg -> do

diff --git a/cabal-docspec/src/CabalDocspec/Opts.hs b/cabal-docspec/src/CabalDocspec/Opts.hs
@@ -2,24 +2,42 @@ module CabalDocspec.Opts where
 
 import Peura
 
-import qualified Data.Set                        as Set
-import qualified Distribution.Compat.CharParsing as P
-import qualified Distribution.ModuleName         as C
-import qualified Distribution.Parsec             as C
-import qualified Distribution.Types.BuildInfo    as C
-import qualified Options.Applicative             as O
+import qualified Data.Set                               as Set
+import qualified Distribution.Compat.CharParsing        as P
+import qualified Distribution.ModuleName                as C
+import qualified Distribution.Parsec                    as C
+import qualified Distribution.Types.LibraryName         as C
+import qualified Distribution.Types.PackageName         as C
+import qualified Distribution.Types.UnqualComponentName as C
+
+import qualified Distribution.Types.BuildInfo as C
+import qualified Options.Applicative          as O
 
 import CabalDocspec.Library
 import CabalDocspec.Trace
 import CabalDocspec.Warning
 
+data Target = Target PackageName (Maybe LibraryName)
+  deriving Show
+
+instance C.Parsec Target where
+    parsec = do
+        pn <- C.parsec
+        ln <- optional (P.char ':' *> (mkLibName pn <$> C.parsec))
+        return (Target pn ln)
+      where
+        mkLibName :: C.PackageName -> C.UnqualComponentName -> LibraryName
+        mkLibName pn cn
+            | C.unUnqualComponentNameST cn == C.unPackageNameST pn = C.LMainLibName
+            | otherwise                                            = C.LSubLibName cn
+
 data Opts = Opts
     { optCabalPlan :: CabalPlan
     , optGhci      :: DynOpts -> DynOpts
     , optCompiler  :: FilePath
     , optBuildDir  :: FsPath
     , optTracer    :: TracerOptions W -> TracerOptions W
-    , optTargets   :: [String]
+    , optTargets   :: [Target]
     }
 
 -- | Options which can change per component.
@@ -144,7 +162,7 @@ optsP = pure Opts
     <*  optional (O.flag' () (O.long "ghc" <> O.help "Compiler is GHC (always on)"))
     <*> O.option fspath (O.long "builddir" <> O.value (fromFilePath "dist-newstyle") <> O.metavar "BUILDDIR")
     <*> tracerOptionsParser
-    <*> many (O.strArgument $ O.metavar "TARGET")
+    <*> many (O.argument (O.eitherReader C.eitherParsec) $ O.metavar "TARGET")
 
 fspath :: O.ReadM FsPath
 fspath = O.eitherReader $ return . fromFilePath

diff --git a/cabal-docspec/src/CabalDocspec/Phase2.hs b/cabal-docspec/src/CabalDocspec/Phase2.hs
@@ -9,7 +9,7 @@ import Peura
 import Control.Monad              (foldM)
 import Data.List                  (isInfixOf)
 import System.Environment         (getEnvironment)
-import Text.PrettyPrint.Annotated (Doc, ($$))
+import Text.PrettyPrint.Annotated (($$))
 
 import qualified Cabal.Config               as Cabal
 import qualified Data.Map                   as Map

diff --git a/cabal-haddock-server/cabal-haddock-server.cabal b/cabal-haddock-server/cabal-haddock-server.cabal
@@ -77,7 +77,7 @@ library cabal-haddock-server-internal
     , base16-bytestring      ^>=1.0.0.0
     , cabal-install-parsers  ^>=0.6
     , cryptohash-sha256      ^>=0.11.101.0
-    , file-embed-lzma
+    , file-embed-lzma        ^>=0.1
     , haskell-lexer
     , http-types             ^>=0.12.3
     , lucid                  ^>=2.11.1

diff --git a/cabal-haddock-server/src/CabalHaddockServer/Static.hs b/cabal-haddock-server/src/CabalHaddockServer/Static.hs
@@ -9,4 +9,4 @@ import qualified Data.Map.Strict as Map
 import qualified FileEmbedLzma
 
 staticFiles :: Map FilePath ByteString
-staticFiles = Map.fromList $(FileEmbedLzma.embedDir "static")
+staticFiles = Map.fromList $$(FileEmbedLzma.embedDir "static")
diff --git a/cabal.project b/cabal.project
@@ -1,5 +1,5 @@
 with-compiler: ghc-9.8.2
-index-state: 2024-07-01T20:10:11Z
+index-state: 2024-07-03T13:49:27Z
 tests: True
 
 packages: cabal-bundler

diff --git a/peura/src/Peura/Cabal.hs b/peura/src/Peura/Cabal.hs
@@ -26,18 +26,21 @@ import Peura.Tracer
 
 import Text.PrettyPrint ((<+>))
 
-import qualified Cabal.Index                as I
-import qualified Cabal.Plan                 as P
-import qualified Data.Aeson                 as A
-import qualified Data.Map.Strict            as Map
-import qualified Data.Set                   as Set
-import qualified Data.Text                  as T
-import qualified Distribution.Fields.Pretty as C
-import qualified Distribution.Package       as C
-import qualified Distribution.Pretty        as C
-import qualified Distribution.Types.Flag    as C
-import qualified Distribution.Version       as C
-import qualified Text.PrettyPrint           as PP
+import qualified Cabal.Index                            as I
+import qualified Cabal.Plan                             as P
+import qualified Data.Aeson                             as A
+import qualified Data.Map.Strict                        as Map
+import qualified Data.Set                               as Set
+import qualified Data.Text                              as T
+import qualified Distribution.Fields.Pretty             as C
+import qualified Distribution.Package                   as C
+import qualified Distribution.Pretty                    as C
+import qualified Distribution.Types.ComponentName       as C
+import qualified Distribution.Types.Flag                as C
+import qualified Distribution.Types.LibraryName         as C
+import qualified Distribution.Types.UnqualComponentName as C
+import qualified Distribution.Version                   as C
+import qualified Text.PrettyPrint                       as PP
 
 -------------------------------------------------------------------------------
 -- Convert
@@ -68,7 +71,18 @@ instance CabalPlanConvert P.FlagName C.FlagName where
     toCabal (P.FlagName u) = C.mkFlagName (T.unpack u)
     fromCabal u            = P.FlagName (T.pack (C.unFlagName u))
 
--------------------------------------------------------------------------------
+instance CabalPlanConvert P.CompName C.ComponentName where
+    toCabal P.CompNameLib         = C.CLibName C.LMainLibName
+    toCabal (P.CompNameSubLib ln) = C.CLibName $ C.LSubLibName $ C.mkUnqualComponentName $ T.unpack ln
+    toCabal (P.CompNameFLib cn)   = C.CFLibName $ C.mkUnqualComponentName $ T.unpack cn
+    toCabal (P.CompNameExe cn)    = C.CExeName $ C.mkUnqualComponentName $ T.unpack cn
+    toCabal (P.CompNameTest cn)   = C.CTestName $ C.mkUnqualComponentName $ T.unpack cn
+    toCabal (P.CompNameBench cn)  = C.CBenchName $ C.mkUnqualComponentName $ T.unpack cn
+    toCabal P.CompNameSetup       = C.CLibName C.LMainLibName -- wrong
+
+    fromCabal = fromCabal
+
+-----------------------------------------------------------------------
 -- Index
 -------------------------------------------------------------------------------