Skip to content

Reduce usages of Prelude/Data.Text.head #2519

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Closed
wants to merge 2 commits into from
Closed

Reduce usages of Prelude/Data.Text.head #2519

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
017843c
Reduce usages of Prelude.head
jhrcek Dec 21, 2021
9ea5898
Fix function name
jhrcek Dec 21, 2021
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
3 changes: 2 additions & 1 deletion ghcide/bench/lib/Experiments.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -49,6 +49,7 @@ import Language.LSP.Types hiding
import Language.LSP.Types.Capabilities
import Numeric.Natural
import Options.Applicative
import Safe (headNote)
import System.Directory
import System.Environment.Blank (getEnv)
import System.FilePath ((<.>), (</>))
Expand Down Expand Up @@ -474,7 +475,7 @@ runBench runSess b = handleAny (\e -> print e >> return badRun)
output $ "Setting up document contents took " <> showDuration d
-- wait again, as the progress is restarted once while loading the cradle
-- make an edit, to ensure this doesn't block
let DocumentPositions{..} = head docs
let DocumentPositions{..} = headNote "Experiments.runBench" docs
Comment on lines -477 to +478
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I don't think that the safe package is best practice anymore. It was created before we had HasCallStack but nowadays head will produce a better error message

Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Yes, and I think if we're going to do this we should replace it with a meaningful error, not just the position where it occurred (although that's somewhat useful).

We also could be more lenient about partial functions in things like tests and benchmarks.

Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

We don't want to have any errors escaping out in this way in ghcide.

But this particular call site is in the benchmark suite which is allowed to error out, and a position is more helpful than any description in that case.

changeDoc doc [charEdit stringLiteralP]
waitForProgressDone
return docs
Expand Down
1 change: 1 addition & 0 deletions ghcide/ghcide.cabal
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -461,6 +461,7 @@ executable ghcide-bench
lsp-types,
optparse-applicative,
process,
safe,
safe-exceptions,
hls-graph,
shake,
Expand Down
17 changes: 10 additions & 7 deletions ghcide/session-loader/Development/IDE/Session.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -35,6 +35,8 @@ import qualified Data.HashMap.Strict as HM
import Data.Hashable
import Data.IORef
import Data.List
import Data.List.NonEmpty (NonEmpty ((:|)))
import qualified Data.List.NonEmpty as NE
import qualified Data.Map.Strict as Map
import Data.Maybe
import qualified Data.Text as T
Expand Down Expand Up @@ -303,9 +305,9 @@ loadSessionWithOptions SessionLoadingOptions{..} dir = do
-- compilation but these are the true source of
-- information.
new_deps = RawComponentInfo (homeUnitId_ df) df targets cfp opts dep_info
: maybe [] snd oldDeps
:| maybe [] snd oldDeps
-- Get all the unit-ids for things in this component
inplace = map rawComponentUnitId new_deps
inplace = fmap rawComponentUnitId new_deps

new_deps' <- forM new_deps $ \RawComponentInfo{..} -> do
-- Remove all inplace dependencies from package flags for
Expand Down Expand Up @@ -347,7 +349,9 @@ loadSessionWithOptions SessionLoadingOptions{..} dir = do
-- . The information for the new component which caused this cache miss
-- . The modified information (without -inplace flags) for
-- existing packages
pure (Map.insert hieYaml (newHscEnv, new_deps) m, (newHscEnv, head new_deps', tail new_deps'))
pure ( Map.insert hieYaml (newHscEnv, NE.toList new_deps) m
, (newHscEnv, NE.head new_deps', NE.tail new_deps')
)


let session :: (Maybe FilePath, NormalizedFilePath, ComponentOptions, FilePath)
Expand Down Expand Up @@ -495,13 +499,12 @@ loadSessionWithOptions SessionLoadingOptions{..} dir = do
sessionOpts (join cachedHieYamlLocation <|> hieYaml, file) `Safe.catch` \e ->
return (([renderPackageSetupException file e], Nothing), maybe [] pure hieYaml)

returnWithVersion $ \file -> do
opts <- liftIO $ join $ mask_ $ modifyVar runningCradle $ \as -> do
returnWithVersion $ \file ->
liftIO $ join $ mask_ $ modifyVar runningCradle $ \as -> do
-- If the cradle is not finished, then wait for it to finish.
void $ wait as
as <- async $ getOptions file
return (as, wait as)
pure opts

-- | Run the specific cradle on a specific FilePath via hie-bios.
-- This then builds dependencies or whatever based on the cradle, gets the
Expand Down Expand Up @@ -758,7 +761,7 @@ getDependencyInfo fs = Map.fromList <$> mapM do_one fs
-- ID. Therefore we create a fake one and give them all the same unit id.
removeInplacePackages
:: UnitId -- ^ fake uid to use for our internal component
-> [UnitId]
-> NonEmpty UnitId
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Perhaps simpler to just convert to a normal list before calling this - I don't think this function needs to require its argument to be non-empty!

-> DynFlags
-> (DynFlags, [UnitId])
removeInplacePackages fake_uid us df = (setHomeUnitId_ fake_uid $
Expand Down
9 changes: 5 additions & 4 deletions ghcide/src/Development/IDE/Core/Shake.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -168,6 +168,7 @@ import qualified Ide.PluginUtils as HLS
import Ide.Types (PluginId)
import qualified "list-t" ListT
import qualified StmContainers.Map as STM
import Safe (headNote)

-- | We need to serialize writes to the database, so we send any function that
-- needs to write to the database over the channel, where it will be picked up by
Expand Down Expand Up @@ -853,18 +854,18 @@ defineNoDiagnostics op = defineEarlyCutoff $ RuleNoDiagnostics $ \k v -> (Nothin
-- | Request a Rule result if available
use :: IdeRule k v
=> k -> NormalizedFilePath -> Action (Maybe v)
use key file = head <$> uses key [file]
use key file = headNote "Development.IDE.Core.Shake.use" <$> uses key [file]
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Remove

Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

As I commented on the issue, I think you could solve all of these at a stroke by making the underlying uses functions work on NonEmpty, which I think would be fine.

Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Yes, I support the generalization to any Traversable to use NonEmpty here


-- | Request a Rule result, it not available return the last computed result, if any, which may be stale
useWithStale :: IdeRule k v
=> k -> NormalizedFilePath -> Action (Maybe (v, PositionMapping))
useWithStale key file = head <$> usesWithStale key [file]
useWithStale key file = headNote "Development.IDE.Core.Shake.useWithStale" <$> usesWithStale key [file]
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Remove


-- | Request a Rule result, it not available return the last computed result which may be stale.
-- Errors out if none available.
useWithStale_ :: IdeRule k v
=> k -> NormalizedFilePath -> Action (v, PositionMapping)
useWithStale_ key file = head <$> usesWithStale_ key [file]
useWithStale_ key file = headNote "Development.IDE.Core.Shake.useWithStale_" <$> usesWithStale_ key [file]
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Remove


-- | Plural version of 'useWithStale_'
usesWithStale_ :: IdeRule k v => k -> [NormalizedFilePath] -> Action [(v, PositionMapping)]
Expand Down Expand Up @@ -932,7 +933,7 @@ useNoFile :: IdeRule k v => k -> Action (Maybe v)
useNoFile key = use key emptyFilePath

use_ :: IdeRule k v => k -> NormalizedFilePath -> Action v
use_ key file = head <$> uses_ key [file]
use_ key file = headNote "Development.IDE.Core.Shake.use_" <$> uses_ key [file]
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Remove


useNoFile_ :: IdeRule k v => k -> Action v
useNoFile_ key = use_ key emptyFilePath
Expand Down
5 changes: 3 additions & 2 deletions ghcide/src/Development/IDE/GHC/Compat/Units.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -89,6 +89,7 @@ import Data.Map (Map)
#endif
import Data.Either
import Data.Version
import qualified Data.List.NonEmpty as NE

#if MIN_VERSION_ghc(9,0,0)
type PreloadUnitClosure = UniqSet UnitId
Expand Down Expand Up @@ -324,7 +325,7 @@ moduleUnit =
Module.moduleUnitId
#endif

filterInplaceUnits :: [UnitId] -> [PackageFlag] -> ([UnitId], [PackageFlag])
filterInplaceUnits :: NE.NonEmpty UnitId -> [PackageFlag] -> ([UnitId], [PackageFlag])
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I would use types unqualified, hope it is the pattern for other data types

Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Ditto, not sure this one should change.

filterInplaceUnits us packageFlags =
partitionEithers (map isInplace packageFlags)
where
Expand All @@ -335,7 +336,7 @@ filterInplaceUnits us packageFlags =
then Left $ toUnitId u
else Right p
#else
if u `elem` us
if u `elem` NE.toList us
then Left u
else Right p
#endif
Expand Down
5 changes: 2 additions & 3 deletions ghcide/src/Development/IDE/Main.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -77,8 +77,7 @@ import Development.IDE.Types.Options (IdeGhcSession,
defaultIdeOptions,
optModifyDynFlags,
optTesting)
import Development.IDE.Types.Shake (Key(Key),
fromKeyType)
import Development.IDE.Types.Shake (fromKeyType)
import GHC.Conc (getNumProcessors)
import GHC.IO.Encoding (setLocaleEncoding)
import GHC.IO.Handle (hDuplicate)
Expand Down Expand Up @@ -283,7 +282,7 @@ defaultMain Arguments{..} = flip withHeapStats fun =<< argsLogger
-- `unsafeGlobalDynFlags` even before the project is configured
_mlibdir <-
setInitialDynFlags logger dir argsSessionLoadingOptions
`catchAny` (\e -> (logDebug logger $ T.pack $ "setInitialDynFlags: " ++ displayException e) >> pure Nothing)
`catchAny` (\e -> logDebug logger (T.pack $ "setInitialDynFlags: " ++ displayException e) >> pure Nothing)


sessionLoader <- loadSessionWithOptions argsSessionLoadingOptions dir
Expand Down
Loading