Skip to content

Correct issues with pre-commit hook #2597

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.

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

Merged
merged 10 commits into from
Jan 24, 2022
2 changes: 1 addition & 1 deletion docs/contributing/contributing.md
Original file line number Diff line number Diff line change
Expand Up @@ -187,7 +187,7 @@ If you don't want to use [nix](https://nixos.org/guides/install-nix.html), you c
"hooks": [
{
"entry": "stylish-haskell --inplace",
"exclude": "(^Setup.hs$|test/testdata/.*$|test/data/.*$|test/manual/lhs/.*$|^hie-compat/.*$|^plugins/hls-tactics-plugin/.*$|^ghcide/src/Development/IDE/GHC/Compat.hs$|^plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs$|^ghcide/test/exe/Main.hs$|ghcide/src/Development/IDE/Core/Rules.hs|^hls-test-utils/src/Test/Hls/Util.hs$)"
"exclude": "(^Setup.hs$|test/testdata/.*$|test/data/.*$|test/manual/lhs/.*$|^hie-compat/.*$|^plugins/hls-tactics-plugin/.*$|^ghcide/src/Development/IDE/GHC/Compat.hs$|^ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs$|^ghcide/src/Development/IDE/GHC/Compat/Core.hs$|^ghcide/src/Development/IDE/Spans/Pragmas.hs$|^ghcide/src/Development/IDE/LSP/Outline.hs$|^plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs$|^ghcide/test/exe/Main.hs$|ghcide/src/Development/IDE/Core/Rules.hs|^hls-test-utils/src/Test/Hls/Util.hs$)",
"files": "\\.l?hs$",
"id": "stylish-haskell",
"language": "system",
Expand Down
4 changes: 4 additions & 0 deletions flake.nix
Original file line number Diff line number Diff line change
Expand Up @@ -169,6 +169,10 @@
# Temporarily ignored files
# Stylish-haskell (and other formatters) does not work well with some CPP usages in these files
"^ghcide/src/Development/IDE/GHC/Compat.hs$"
"^ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs$"
"^ghcide/src/Development/IDE/GHC/Compat/Core.hs$"
"^ghcide/src/Development/IDE/Spans/Pragmas.hs$"
"^ghcide/src/Development/IDE/LSP/Outline.hs$"
"^plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs$"
"^ghcide/test/exe/Main.hs$"
"ghcide/src/Development/IDE/Core/Rules.hs"
Expand Down
325 changes: 162 additions & 163 deletions ghcide/src/Development/IDE/Core/UseStale.hs
Original file line number Diff line number Diff line change
@@ -1,163 +1,162 @@
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE RankNTypes #-}

module Development.IDE.Core.UseStale
( Age(..)
, Tracked
, unTrack
, PositionMap
, TrackedStale (..)
, untrackedStaleValue
, unsafeMkStale
, unsafeMkCurrent
, unsafeCopyAge
, MapAge (..)
, dualPositionMap
, useWithStale
, useWithStale_
) where

import Control.Arrow
import Control.Category (Category)
import qualified Control.Category as C
import Control.DeepSeq (NFData)
import Data.Aeson
import Data.Coerce (coerce)
import Data.Functor ((<&>))
import Data.Functor.Identity (Identity (Identity))
import Data.Kind (Type)
import Data.String (fromString)
import Development.IDE.GHC.Compat (RealSrcSpan,
srcSpanFile)
import Development.IDE.GHC.Compat.Util (unpackFS)
import Development.IDE (Action, IdeRule,
NormalizedFilePath,
Range,
rangeToRealSrcSpan,
realSrcSpanToRange)
import qualified Development.IDE.Core.PositionMapping as P
import qualified Development.IDE.Core.Shake as IDE


------------------------------------------------------------------------------
-- | A data kind for 'Tracked'.
data Age = Current | Stale Type


------------------------------------------------------------------------------
-- | Some value, tagged with its age. All 'Current' ages are considered to be
-- the same thing, but 'Stale' values are protected by an untouchable variable
-- to ensure they can't be unified.
newtype Tracked (age :: Age) a = UnsafeTracked
{ unTrack :: a
}
deriving stock (Functor, Foldable, Traversable)
deriving newtype (Eq, Ord, Show, Read, ToJSON, FromJSON, NFData)
deriving (Applicative, Monad) via Identity


------------------------------------------------------------------------------
-- | Like 'P.PositionMapping', but with annotated ages for how 'Tracked' values
-- change. Use the 'Category' instance to compose 'PositionMapping's in order
-- to transform between values of different stale ages.
newtype PositionMap (from :: Age) (to :: Age) = PositionMap
{ _getPositionMapping :: P.PositionMapping
}

instance Category PositionMap where
id = coerce P.zeroMapping
(.) = coerce P.composeDelta


------------------------------------------------------------------------------
-- | Get a 'PositionMap' that runs in the opposite direction.
dualPositionMap :: PositionMap from to -> PositionMap to from
dualPositionMap (PositionMap (P.PositionMapping (P.PositionDelta from to))) =
PositionMap $ P.PositionMapping $ P.PositionDelta to from


------------------------------------------------------------------------------
-- | A pair containing a @'Tracked' 'Stale'@ value, as well as
-- a 'PositionMapping' that will fast-forward values to the current age.
data TrackedStale a where
TrackedStale
:: Tracked (Stale s) a
-> PositionMap (Stale s) Current
-> TrackedStale a

instance Functor TrackedStale where
fmap f (TrackedStale t pm) = TrackedStale (fmap f t) pm


untrackedStaleValue :: TrackedStale a -> a
untrackedStaleValue (TrackedStale ta _) = coerce ta


------------------------------------------------------------------------------
-- | A class for which 'Tracked' values can be run across a 'PositionMapping'
-- to change their ages.
class MapAge a where
{-# MINIMAL mapAgeFrom | mapAgeTo #-}
mapAgeFrom :: PositionMap from to -> Tracked to a -> Maybe (Tracked from a)
mapAgeFrom = mapAgeTo . dualPositionMap

mapAgeTo :: PositionMap from to -> Tracked from a -> Maybe (Tracked to a)
mapAgeTo = mapAgeFrom . dualPositionMap


instance MapAge Range where
mapAgeFrom = coerce P.fromCurrentRange
mapAgeTo = coerce P.toCurrentRange


instance MapAge RealSrcSpan where
mapAgeFrom =
invMapAge (\fs -> rangeToRealSrcSpan (fromString $ unpackFS fs))
(srcSpanFile &&& realSrcSpanToRange)
. mapAgeFrom


------------------------------------------------------------------------------
-- | Helper function for deriving 'MapAge' for values in terms of other
-- instances.
invMapAge
:: (c -> a -> b)
-> (b -> (c, a))
-> (Tracked from a -> Maybe (Tracked to a))
-> Tracked from b
-> Maybe (Tracked to b)
invMapAge to from f t =
let (c, t') = unTrack $ fmap from t
in fmap (fmap $ to c) $ f $ UnsafeTracked t'


unsafeMkCurrent :: age -> Tracked 'Current age
unsafeMkCurrent = coerce


unsafeMkStale :: age -> Tracked (Stale s) age
unsafeMkStale = coerce


unsafeCopyAge :: Tracked age a -> b -> Tracked age b
unsafeCopyAge _ = coerce


-- | 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 (TrackedStale v))
useWithStale key file = do
x <- IDE.useWithStale key file
pure $ x <&> \(v, pm) ->
TrackedStale (coerce v) (coerce pm)

-- | 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 (TrackedStale v)
useWithStale_ key file = do
(v, pm) <- IDE.useWithStale_ key file
pure $ TrackedStale (coerce v) (coerce pm)

{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE RankNTypes #-}

module Development.IDE.Core.UseStale
( Age(..)
, Tracked
, unTrack
, PositionMap
, TrackedStale (..)
, untrackedStaleValue
, unsafeMkStale
, unsafeMkCurrent
, unsafeCopyAge
, MapAge (..)
, dualPositionMap
, useWithStale
, useWithStale_
) where

import Control.Arrow
import Control.Category (Category)
import qualified Control.Category as C
import Control.DeepSeq (NFData)
import Data.Aeson
import Data.Coerce (coerce)
import Data.Functor ((<&>))
import Data.Functor.Identity (Identity (Identity))
import Data.Kind (Type)
import Data.String (fromString)
import Development.IDE (Action, IdeRule,
NormalizedFilePath,
Range,
rangeToRealSrcSpan,
realSrcSpanToRange)
import qualified Development.IDE.Core.PositionMapping as P
import qualified Development.IDE.Core.Shake as IDE
import Development.IDE.GHC.Compat (RealSrcSpan, srcSpanFile)
import Development.IDE.GHC.Compat.Util (unpackFS)


------------------------------------------------------------------------------
-- | A data kind for 'Tracked'.
data Age = Current | Stale Type


------------------------------------------------------------------------------
-- | Some value, tagged with its age. All 'Current' ages are considered to be
-- the same thing, but 'Stale' values are protected by an untouchable variable
-- to ensure they can't be unified.
newtype Tracked (age :: Age) a = UnsafeTracked
{ unTrack :: a
}
deriving stock (Functor, Foldable, Traversable)
deriving newtype (Eq, Ord, Show, Read, ToJSON, FromJSON, NFData)
deriving (Applicative, Monad) via Identity


------------------------------------------------------------------------------
-- | Like 'P.PositionMapping', but with annotated ages for how 'Tracked' values
-- change. Use the 'Category' instance to compose 'PositionMapping's in order
-- to transform between values of different stale ages.
newtype PositionMap (from :: Age) (to :: Age) = PositionMap
{ _getPositionMapping :: P.PositionMapping
}

instance Category PositionMap where
id = coerce P.zeroMapping
(.) = coerce P.composeDelta


------------------------------------------------------------------------------
-- | Get a 'PositionMap' that runs in the opposite direction.
dualPositionMap :: PositionMap from to -> PositionMap to from
dualPositionMap (PositionMap (P.PositionMapping (P.PositionDelta from to))) =
PositionMap $ P.PositionMapping $ P.PositionDelta to from


------------------------------------------------------------------------------
-- | A pair containing a @'Tracked' 'Stale'@ value, as well as
-- a 'PositionMapping' that will fast-forward values to the current age.
data TrackedStale a where
TrackedStale
:: Tracked (Stale s) a
-> PositionMap (Stale s) Current
-> TrackedStale a

instance Functor TrackedStale where
fmap f (TrackedStale t pm) = TrackedStale (fmap f t) pm


untrackedStaleValue :: TrackedStale a -> a
untrackedStaleValue (TrackedStale ta _) = coerce ta


------------------------------------------------------------------------------
-- | A class for which 'Tracked' values can be run across a 'PositionMapping'
-- to change their ages.
class MapAge a where
{-# MINIMAL mapAgeFrom | mapAgeTo #-}
mapAgeFrom :: PositionMap from to -> Tracked to a -> Maybe (Tracked from a)
mapAgeFrom = mapAgeTo . dualPositionMap

mapAgeTo :: PositionMap from to -> Tracked from a -> Maybe (Tracked to a)
mapAgeTo = mapAgeFrom . dualPositionMap


instance MapAge Range where
mapAgeFrom = coerce P.fromCurrentRange
mapAgeTo = coerce P.toCurrentRange


instance MapAge RealSrcSpan where
mapAgeFrom =
invMapAge (\fs -> rangeToRealSrcSpan (fromString $ unpackFS fs))
(srcSpanFile &&& realSrcSpanToRange)
. mapAgeFrom


------------------------------------------------------------------------------
-- | Helper function for deriving 'MapAge' for values in terms of other
-- instances.
invMapAge
:: (c -> a -> b)
-> (b -> (c, a))
-> (Tracked from a -> Maybe (Tracked to a))
-> Tracked from b
-> Maybe (Tracked to b)
invMapAge to from f t =
let (c, t') = unTrack $ fmap from t
in fmap (fmap $ to c) $ f $ UnsafeTracked t'


unsafeMkCurrent :: age -> Tracked 'Current age
unsafeMkCurrent = coerce


unsafeMkStale :: age -> Tracked (Stale s) age
unsafeMkStale = coerce


unsafeCopyAge :: Tracked age a -> b -> Tracked age b
unsafeCopyAge _ = coerce


-- | 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 (TrackedStale v))
useWithStale key file = do
x <- IDE.useWithStale key file
pure $ x <&> \(v, pm) ->
TrackedStale (coerce v) (coerce pm)

-- | 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 (TrackedStale v)
useWithStale_ key file = do
(v, pm) <- IDE.useWithStale_ key file
pure $ TrackedStale (coerce v) (coerce pm)

Loading