hhp 1.0.4 → 1.0.5

raw patch · 18 files changed

+171/−68 lines, 18 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• ChangeLog.md +11/−2
• elisp/hhp-comp.el +5/−4
• hhp.cabal +1/−1
• lib/Hhp/Boot.hs +1/−1
• lib/Hhp/Browse.hs +2/−2
• lib/Hhp/CabalApi.hs +60/−9
• lib/Hhp/Check.hs +4/−2
• lib/Hhp/Debug.hs +1/−1
• lib/Hhp/Find.hs +2/−2
• lib/Hhp/GHCApi.hs +28/−11
• lib/Hhp/Ghc.hs +2/−0
• lib/Hhp/GhcPkg.hs +1/−1
• lib/Hhp/Info.hs +2/−2
• lib/Hhp/List.hs +1/−1
• lib/Hhp/Types.hs +3/−3
• src/hhpi.hs +29/−9
• test/CabalApiSpec.hs +7/−7
• test/CheckSpec.hs +11/−10

@@ -1,10 +1,19 @@ # ChangeLog for HHP(Happy Haskell Programming) -## 2024-03-31 v1.0.4+## 2026-09-07 v1.0.4 +- Bug fix for reading symbols from Emacs Lisp.+- Properly specifying hs-source-dir: Previously, all hs-source-dirs+  were specified whenever there were multiple ones. If modules+  happened to share the same name and the paths were specified in the+  wrong order, syntax checks would fail. So, updating the+  configuration to specify only the minimum necessary hs-source-dirs.++## 2026-03-11 v1.0.4+ - Updating Emacs Lisp. -## 2024-03-31 v1.0.3+## 2025-03-31 v1.0.3  - Supporting GHC 9.12 

@@ -111,10 +111,11 @@     nil))  (defun hhp-load-module (mod)-  (prog2-      (message "Loading symbols for %s..." mod)-      (hhp-sync-process (format "browse %s\n" mod))-    (message "Loading symbols for %s...done" mod)))+  (progn+    (message "Loading symbols for %s..." mod)+    (let ((syms (hhp-sync-process (format "browse %s\n" mod))))+      (message "Loading symbols for %s...done" mod)+      (if (listp syms) syms nil))))  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;

@@ -1,6 +1,6 @@ cabal-version:      >=1.10 name:               hhp-version:            1.0.4+version:            1.0.5 license:            BSD3 license-file:       LICENSE maintainer:         Kazu Yamamoto <kazu@iij.ad.jp>

@@ -13,7 +13,7 @@ -- | Printing necessary information for front-end booting. bootInfo :: Options -> Cradle -> IO String bootInfo opt cradle = withGHC' $ do-    initializeFlagsWithCradle opt cradle+    _ <- initializeFlagsWithCradle opt cradle Nothing     boot opt  -- | Printing necessary information for front-end booting.

@@ -45,7 +45,7 @@     -- ^ A module name. (e.g. \"Data.List\")     -> IO String browseModule opt cradle pkgmdl = withGHC' $ do-    initializeFlagsWithCradle opt cradle+    _ <- initializeFlagsWithCradle opt cradle Nothing     browse opt pkgmdl  -- | Getting functions, classes, etc from a module.@@ -100,7 +100,7 @@   where     removeOps         | operators opt = id-        | otherwise = filter (isAlpha . unsafeHead . getOccString)+        | otherwise = filter (isAlpha . unsafeHead "processExports" . getOccString)  showExport :: Options -> ModuleInfo -> Name -> Ghc String showExport opt minfo e = do

@@ -6,9 +6,11 @@     getCompilerOptions,     parseCabalFile,     cabalAllBuildInfo,+    cabalAllBuildInfo',     cabalDependPackages,     cabalSourceDirs,     cabalAllTargets,+    getHsSourceDir, ) where  import Distribution.Compiler (AbiTag (NoAbiTag), unknownCompilerInfo)@@ -17,7 +19,7 @@ import qualified Distribution.Package as C import Distribution.PackageDescription (     BuildInfo,-    Executable,+    Executable (..),     PackageDescription,     TestSuite,     TestSuiteInterface (..),@@ -50,11 +52,12 @@  import Control.Exception (throwIO) import Control.Monad (filterM)-import Data.Maybe (fromMaybe, mapMaybe, maybeToList)+import Data.List (isPrefixOf)+import Data.Maybe (fromMaybe, listToMaybe, mapMaybe, maybeToList) import Data.Set (fromList, toList) import System.Directory (doesFileExist) import System.Environment (lookupEnv)-import System.FilePath (dropExtension, takeFileName, (</>))+import System.FilePath (dropExtension, takeDirectory, takeFileName, (</>))  import Hhp.GhcPkg import Hhp.Types@@ -66,17 +69,20 @@     :: [GHCOption]     -> Cradle     -> PackageDescription+    -> Maybe FilePath     -> IO CompilerOptions-getCompilerOptions ghcopts cradle pkgDesc = do-    gopts <- getGHCOptions ghcopts cradle rdir $ unsafeHead buildInfos+getCompilerOptions ghcopts cradle pkgDesc hsFile = do+    gopts <-+        getGHCOptions ghcopts cradle rdir $ unsafeHead "getCompilerOptions" buildInfos     dbPkgs <- ghcPkgListEx (cradlePkgDbStack cradle)-    return $ CompilerOptions gopts idirs (depPkgs dbPkgs)+    let compOpt = CompilerOptions gopts idirs (depPkgs dbPkgs)+    return compOpt   where     wdir = cradleCurrentDir cradle     rdir = cradleRootDir cradle     cfile = fromMaybe "error getCompilerOptions" $ cradleCabalFile cradle     thisPkg = dropExtension $ takeFileName cfile-    buildInfos = cabalAllBuildInfo pkgDesc+    buildInfos = cabalAllBuildInfo cradle pkgDesc hsFile     idirs = includeDirectories rdir wdir $ cabalSourceDirs buildInfos     depPkgs ps =         attachPackageIds ps $@@ -172,14 +178,59 @@ ----------------------------------------------------------------  -- | Extracting all 'BuildInfo' for libraries, executables, and tests.-cabalAllBuildInfo :: PackageDescription -> [BuildInfo]-cabalAllBuildInfo pd = libBI ++ subBI ++ execBI ++ testBI ++ benchBI+cabalAllBuildInfo+    :: Cradle -> PackageDescription -> Maybe FilePath -> [BuildInfo]+cabalAllBuildInfo cradle pd mHsFile = libBI ++ subBI ++ addBI   where     libBI = map P.libBuildInfo $ maybeToList $ P.library pd     subBI = map P.libBuildInfo $ P.subLibraries pd+    addBI = fst $ cabalExtraBuildInfo (Just cradle) pd mHsFile++-- for testing+cabalAllBuildInfo'+    :: PackageDescription -> [BuildInfo]+cabalAllBuildInfo' pd = libBI ++ subBI ++ addBI+  where+    libBI = map P.libBuildInfo $ maybeToList $ P.library pd+    subBI = map P.libBuildInfo $ P.subLibraries pd+    addBI = fst $ cabalExtraBuildInfo Nothing pd Nothing++getHsSourceDir+    :: Cradle -> PackageDescription -> Maybe FilePath -> Maybe FilePath+getHsSourceDir cradle pd mHsFile =+    snd $ cabalExtraBuildInfo (Just cradle) pd mHsFile++cabalExtraBuildInfo+    :: Maybe Cradle+    -> PackageDescription+    -> Maybe FilePath+    -> ([BuildInfo], Maybe FilePath)+cabalExtraBuildInfo mcradle pd mHsFile = (addBI, hsDir addBI)+  where     execBI = map P.buildInfo $ P.executables pd     testBI = map P.testBuildInfo $ P.testSuites pd     benchBI = map P.benchmarkBuildInfo $ P.benchmarks pd+    addBI0 = execBI ++ testBI ++ benchBI+    addBI = case mHsFile of+        Nothing -> addBI0 -- fixme: Is [] more suitable?+        Just hsFile -> case mcradle of+            Nothing -> addBI0 -- fixme: Is [] more suitable?+            Just cradle -> do+                let hsFile' = takeRelativePath cradle hsFile+                 in filter (include hsFile') addBI0+    include hsFile b = any (`match` hsFile) $ map toPath $ P.hsSourceDirs b+    match "." _ = True+    match dir fn = dir `isPrefixOf` fn+    hsDir [] = Nothing+    hsDir (b : _) = toPath <$> listToMaybe (P.hsSourceDirs b)++takeRelativePath :: Cradle -> FilePath -> FilePath+takeRelativePath cradle fn = rp+  where+    root = cradleRootDir cradle+    rp+        | root `isPrefixOf` fn = takeDirectory $ drop (length root + 1) fn+        | otherwise = takeDirectory fn  ---------------------------------------------------------------- 

@@ -12,6 +12,8 @@ import Hhp.Logger import Hhp.Types +import Data.Maybe+ ----------------------------------------------------------------  -- | Checking syntax of a target file using GHC.@@ -24,7 +26,7 @@     -> IO String checkSyntax _ _ [] = return "" checkSyntax opt cradle files = withGHC sessionName $ do-    initializeFlagsWithCradle opt cradle+    _ <- initializeFlagsWithCradle opt cradle $ listToMaybe files     either id id <$> check opt files   where     sessionName = case files of@@ -55,7 +57,7 @@     -> IO String expandTemplate _ _ [] = return "" expandTemplate opt cradle files = withGHC sessionName $ do-    initializeFlagsWithCradle opt cradle+    _ <- initializeFlagsWithCradle opt cradle $ listToMaybe files     either id id <$> expand opt files   where     sessionName = case files of

@@ -43,7 +43,7 @@     simpleCompilerOption = CompilerOptions origGopts [] []     fromCabalFile = do         pkgDesc <- parseCabalFile file-        getCompilerOptions origGopts cradle pkgDesc+        getCompilerOptions origGopts cradle pkgDesc Nothing       where         file = fromJust mCabalFile 

@@ -37,7 +37,7 @@ -- | Finding modules to which the symbol belong. findSymbol :: Options -> Cradle -> Symbol -> IO String findSymbol opt cradle sym = withGHC' $ do-    initializeFlagsWithCradle opt cradle+    _ <- initializeFlagsWithCradle opt cradle Nothing     lookupSym opt sym <$> getSymMdlDb  -- | Creating 'SymMdlDb'.@@ -48,7 +48,7 @@         !m = force $ M.fromList sms     return (SymMdlDb m)   where-    tieup x = (unsafeHead (map fst x), map snd x)+    tieup x = (unsafeHead "getSymMdlDb" (map fst x), map snd x)  -- | Looking up 'SymMdlDb' with 'Symbol' to find modules. lookupSym :: Options -> Symbol -> SymMdlDb -> String

@@ -16,6 +16,8 @@     setDeferTypeErrors,     setPartialSignatures,     setWarnTypedHoles,+    Reset,+    GetHSDir, ) where  import GHC (DynFlags (..), Ghc, LoadHowMuch (..))@@ -88,14 +90,18 @@  data Build = CabalPkg | SingleFile deriving (Eq) +type Reset = Maybe FilePath -> Ghc ()+type GetHSDir = Maybe FilePath -> Maybe FilePath+ -- | Initialize the 'DynFlags' relating to the compilation of a single -- file or GHC session according to the 'Cradle' and 'Options' -- provided. initializeFlagsWithCradle     :: Options     -> Cradle-    -> Ghc ()-initializeFlagsWithCradle opt cradle+    -> Maybe FilePath+    -> Ghc (Reset, GetHSDir)+initializeFlagsWithCradle opt cradle mHsFile     | cabal = withCabal <|> withSandbox     | otherwise = withSandbox   where@@ -104,16 +110,27 @@     ghcopts = ghcOpts opt     withCabal = do         pkgDesc <- liftIO $ parseCabalFile $ fromJust mCradleFile-        compOpts <- liftIO $ getCompilerOptions ghcopts cradle pkgDesc-        initSession CabalPkg opt compOpts-    withSandbox = initSession SingleFile opt compOpts+        let reset = makeReset pkgDesc+            gethsd = getHsSourceDir cradle pkgDesc+        reset mHsFile+        return (reset, gethsd)       where-        pkgOpts = ghcDbStackOpts $ cradlePkgDbStack cradle-        compOpts-            | null pkgOpts = CompilerOptions ghcopts importDirs []-            | otherwise = CompilerOptions (ghcopts ++ pkgOpts) [wdir, rdir] []-        wdir = cradleCurrentDir cradle-        rdir = cradleRootDir cradle+        makeReset pkgDesc mfn = do+            compOpts <- liftIO $ getCompilerOptions ghcopts cradle pkgDesc mfn+            initSession CabalPkg opt compOpts+    withSandbox = do+        reset mHsFile+        return (reset, gethsd)+      where+        gethsd _ = Nothing+        reset _ = initSession SingleFile opt compOpts+          where+            pkgOpts = ghcDbStackOpts $ cradlePkgDbStack cradle+            compOpts+                | null pkgOpts = CompilerOptions ghcopts importDirs []+                | otherwise = CompilerOptions (ghcopts ++ pkgOpts) [wdir, rdir] []+            wdir = cradleCurrentDir cradle+            rdir = cradleRootDir cradle  ---------------------------------------------------------------- 

@@ -7,6 +7,8 @@      -- * Initializing DynFlags     initializeFlagsWithCradle,+    Reset,+    GetHSDir,      -- * Ghc utilities     boot,

@@ -63,7 +63,7 @@     key = "package-db:"     keyLen = length key -    parse = unsafeHead . filter (key `isPrefixOf`) . lines+    parse = unsafeHead "getSandboxDbDir" . filter (key `isPrefixOf`) . lines     extractValue = dropWhileEnd isSpace . dropWhile isSpace . drop keyLen  getPackageDbStack

@@ -60,7 +60,7 @@     -- ^ A Haskell expression.     -> IO String infoExpr opt cradle file expr = withGHC' $ do-    initializeFlagsWithCradle opt cradle+    _ <- initializeFlagsWithCradle opt cradle Nothing     info opt file expr  -- | Obtaining information of a target expression. (GHCi's info:)@@ -92,7 +92,7 @@     -- ^ Column number.     -> IO String typeExpr opt cradle file lineNo colNo = withGHC' $ do-    initializeFlagsWithCradle opt cradle+    _ <- initializeFlagsWithCradle opt cradle Nothing     types opt file lineNo colNo  -- | Obtaining type of a target expression. (GHCi's type:)

@@ -18,7 +18,7 @@ -- | Listing installed modules. listModules :: Options -> Cradle -> IO String listModules opt cradle = withGHC' $ do-    initializeFlagsWithCradle opt cradle+    _ <- initializeFlagsWithCradle opt cradle Nothing     modules opt  -- | Listing installed modules.

@@ -220,6 +220,6 @@     x <|> y = x `catch` (\(_ :: IOException) -> y)     empty = undefined -unsafeHead :: [a] -> a-unsafeHead [] = error "unsafeHead"-unsafeHead (x : _) = x+unsafeHead :: String -> [a] -> a+unsafeHead msg [] = error $ "unsafeHead: " ++ msg+unsafeHead _ (x : _) = x

@@ -23,6 +23,7 @@ import Control.Exception (Exception, SomeException (..)) import qualified Control.Exception as E import Control.Monad (void, when)+import Data.IORef import Data.Set (Set) import qualified Data.Set as S import Data.Version (showVersion)@@ -111,7 +112,8 @@         mvar <- liftIO newEmptyMVar         mlibdir <- getSystemLibDir         void $ forkIO $ setupDB cradle mlibdir opt mvar-        run cradle mlibdir opt $ loop opt S.empty mvar+        ref <- newIORef $ Just "."+        run cradle mlibdir opt $ loop cradle opt S.empty mvar ref       where         -- this is just in case.         -- If an error is caught here, it is a bug of Hhp library.@@ -125,29 +127,47 @@  ---------------------------------------------------------------- -run :: Cradle -> Maybe FilePath -> Options -> Ghc a -> IO a+run+    :: Cradle+    -> Maybe FilePath+    -> Options+    -> ((Reset, GetHSDir) -> Ghc a)+    -> IO a run cradle mlibdir opt body = runGhc mlibdir $ do-    initializeFlagsWithCradle opt cradle-    body+    x <- initializeFlagsWithCradle opt cradle Nothing+    body x  ----------------------------------------------------------------  setupDB :: Cradle -> Maybe FilePath -> Options -> MVar SymMdlDb -> IO () setupDB cradle mlibdir opt mvar = E.handle handler $ do-    db <- run cradle mlibdir opt getSymMdlDb+    db <- run cradle mlibdir opt $ \_ -> getSymMdlDb     putMVar mvar db   where     handler (SomeException _) = return () -- fixme: put emptyDb?  ---------------------------------------------------------------- -loop :: Options -> Set FilePath -> MVar SymMdlDb -> Ghc ()-loop opt set mvar = do+loop+    :: Cradle+    -> Options+    -> Set FilePath+    -> MVar SymMdlDb+    -> IORef (Maybe FilePath)+    -> (Reset, GetHSDir)+    -> Ghc ()+loop cradle opt set mvar ref ops@(reset, getHsDir) = do     cmdArg <- liftIO getLine     let (cmd, arg') = break (== ' ') cmdArg         arg = dropWhile (== ' ') arg'     (ret, ok, set') <- case cmd of-        "check" -> checkStx opt set arg+        "check" -> do+            rp0 <- liftIO $ readIORef ref+            let rp1 = getHsDir $ Just arg+            when (rp0 /= rp1) $ do+                liftIO $ writeIORef ref rp1+                reset $ Just arg+            checkStx opt set arg         "find" -> findSym opt set arg mvar         "lint" -> lintStx opt set arg         "info" -> showInfo opt set arg@@ -164,7 +184,7 @@         else do             liftIO $ putStrLn $ "NG " ++ replace ret     liftIO $ hFlush stdout-    when ok $ loop opt set' mvar+    when ok $ loop cradle opt set' mvar ref ops  ---------------------------------------------------------------- 

@@ -37,26 +37,26 @@     describe "cabalDependPackages" $ do         it "extracts dependent packages" $ do             pkgs <--                cabalDependPackages . cabalAllBuildInfo+                cabalDependPackages . cabalAllBuildInfo'                     <$> parseCabalFile "test/data/cabalapi.cabal"             pkgs `shouldBe` ["Cabal", "base", "template-haskell"]      describe "cabalSourceDirs" $ do         it "extracts all hs-source-dirs" $ do             dirs <--                cabalSourceDirs . cabalAllBuildInfo+                cabalSourceDirs . cabalAllBuildInfo'                     <$> parseCabalFile "test/data/check-test-subdir/check-test-subdir.cabal"             dirs `shouldBe` ["src", "test"]         it "extracts all hs-source-dirs including \".\"" $ do             dirs <--                cabalSourceDirs . cabalAllBuildInfo+                cabalSourceDirs . cabalAllBuildInfo'                     <$> parseCabalFile "test/data/cabalapi.cabal"             dirs `shouldBe` [".", "test"]      describe "cabal-subLibraries" $ do         it "dependent packages with sublib" $ do             pkgs <--                cabalDependPackages . cabalAllBuildInfo+                cabalDependPackages . cabalAllBuildInfo'                     <$> parseCabalFile "test/data/check-sublib/check-sublib.cabal"             pkgs `shouldBe` ["array", "base", "bytestring"] @@ -64,19 +64,19 @@         it "dependent packages without flags" $ do             unsetEnv "HHP_CABAL_FLAGS"             pkgs <--                cabalDependPackages . cabalAllBuildInfo+                cabalDependPackages . cabalAllBuildInfo'                     <$> parseCabalFile "test/data/check-flags/check-flags.cabal"             pkgs `shouldBe` ["base", "directory"]         it "dependent packages with foo flag" $ do             setEnv "HHP_CABAL_FLAGS" "foo"             pkgs <--                cabalDependPackages . cabalAllBuildInfo+                cabalDependPackages . cabalAllBuildInfo'                     <$> parseCabalFile "test/data/check-flags/check-flags.cabal"             pkgs `shouldBe` ["base", "directory", "filepath"]         it "dependent packages with foo and -bar flag" $ do             setEnv "HHP_CABAL_FLAGS" "foo -bar"             pkgs <--                cabalDependPackages . cabalAllBuildInfo+                cabalDependPackages . cabalAllBuildInfo'                     <$> parseCabalFile "test/data/check-flags/check-flags.cabal"             pkgs `shouldBe` ["base", "filepath"] 

@@ -20,16 +20,17 @@                     `shouldBe` "main.hs:5:1:Warning: Top-level binding with no type signature: main :: IO ()\n"          it-            "can check even if a test module imports another test module located at different directory" $ do-            withDirectory_ "test/data/check-test-subdir" $ do-                cradle <- findCradleWithoutSandbox-                res <- checkSyntax defaultOptions cradle ["test/Bar/Baz.hs"]-                res-                    `shouldSatisfy` ( ( "test"-                                            </> "Foo.hs:3:1:Warning: Top-level binding with no type signature: foo :: String\n"-                                      )-                                        `isSuffixOf`-                                    )+            "can check even if a test module imports another test module located at different directory"+            $ do+                withDirectory_ "test/data/check-test-subdir" $ do+                    cradle <- findCradleWithoutSandbox+                    res <- checkSyntax defaultOptions cradle ["test/Bar/Baz.hs"]+                    res+                        `shouldSatisfy` ( ( "test"+                                                </> "Foo.hs:3:1:Warning: Top-level binding with no type signature: foo :: String\n"+                                          )+                                            `isSuffixOf`+                                        )          it "can detect mutually imported modules" $ do             withDirectory_ "test/data" $ do