{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE TypeFamilies #-}
module Development.IDE.Types.Shake
( Q (..),
A (..),
Value (..),
ValueWithDiagnostics (..),
Values,
Key,
BadDependency (..),
ShakeValue(..),
currentValue,
isBadDependency,
toShakeValue,encodeShakeValue,decodeShakeValue,toKey,toNoFileKey,fromKey,fromKeyType,WithHieDb,WithHieDbShield(..))
where
import Control.DeepSeq
import Control.Exception
import qualified Data.ByteString.Char8 as BS
import Data.Dynamic
import Data.Hashable
import Data.Typeable (cast)
import Data.Vector (Vector)
import Development.IDE.Core.PositionMapping
import Development.IDE.Core.RuleTypes (FileVersion)
import Development.IDE.Graph (Key, RuleResult, newKey,
pattern Key)
import qualified Development.IDE.Graph as Shake
import Development.IDE.Types.Diagnostics
import Development.IDE.Types.Location
import GHC.Generics
import HieDb.Types (HieDb)
import qualified StmContainers.Map as STM
import Type.Reflection (SomeTypeRep (SomeTypeRep),
pattern App, pattern Con,
typeOf, typeRep,
typeRepTyCon)
import Unsafe.Coerce (unsafeCoerce)
type WithHieDb = forall a. (HieDb -> IO a) -> IO a
newtype WithHieDbShield = WithHieDbShield WithHieDb
data Value v
= Succeeded (Maybe FileVersion) v
| Stale (Maybe PositionDelta) (Maybe FileVersion) v
| Failed Bool
deriving ((forall a b. (a -> b) -> Value a -> Value b)
-> (forall a b. a -> Value b -> Value a) -> Functor Value
forall a b. a -> Value b -> Value a
forall a b. (a -> b) -> Value a -> Value b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Value a -> Value b
fmap :: forall a b. (a -> b) -> Value a -> Value b
$c<$ :: forall a b. a -> Value b -> Value a
<$ :: forall a b. a -> Value b -> Value a
Functor, (forall x. Value v -> Rep (Value v) x)
-> (forall x. Rep (Value v) x -> Value v) -> Generic (Value v)
forall x. Rep (Value v) x -> Value v
forall x. Value v -> Rep (Value v) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall v x. Rep (Value v) x -> Value v
forall v x. Value v -> Rep (Value v) x
$cfrom :: forall v x. Value v -> Rep (Value v) x
from :: forall x. Value v -> Rep (Value v) x
$cto :: forall v x. Rep (Value v) x -> Value v
to :: forall x. Rep (Value v) x -> Value v
Generic, Int -> Value v -> ShowS
[Value v] -> ShowS
Value v -> [Char]
(Int -> Value v -> ShowS)
-> (Value v -> [Char]) -> ([Value v] -> ShowS) -> Show (Value v)
forall v. Show v => Int -> Value v -> ShowS
forall v. Show v => [Value v] -> ShowS
forall v. Show v => Value v -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall v. Show v => Int -> Value v -> ShowS
showsPrec :: Int -> Value v -> ShowS
$cshow :: forall v. Show v => Value v -> [Char]
show :: Value v -> [Char]
$cshowList :: forall v. Show v => [Value v] -> ShowS
showList :: [Value v] -> ShowS
Show)
instance NFData v => NFData (Value v)
currentValue :: Value v -> Maybe v
currentValue :: forall v. Value v -> Maybe v
currentValue (Succeeded Maybe FileVersion
_ v
v) = v -> Maybe v
forall a. a -> Maybe a
Just v
v
currentValue (Stale Maybe PositionDelta
_ Maybe FileVersion
_ v
_) = Maybe v
forall a. Maybe a
Nothing
currentValue Failed{} = Maybe v
forall a. Maybe a
Nothing
data ValueWithDiagnostics
= ValueWithDiagnostics !(Value Dynamic) !(Vector FileDiagnostic)
type Values = STM.Map Key ValueWithDiagnostics
newtype BadDependency = BadDependency String deriving Int -> BadDependency -> ShowS
[BadDependency] -> ShowS
BadDependency -> [Char]
(Int -> BadDependency -> ShowS)
-> (BadDependency -> [Char])
-> ([BadDependency] -> ShowS)
-> Show BadDependency
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BadDependency -> ShowS
showsPrec :: Int -> BadDependency -> ShowS
$cshow :: BadDependency -> [Char]
show :: BadDependency -> [Char]
$cshowList :: [BadDependency] -> ShowS
showList :: [BadDependency] -> ShowS
Show
instance Exception BadDependency
isBadDependency :: SomeException -> Bool
isBadDependency :: SomeException -> Bool
isBadDependency SomeException
x
| Just (BadDependency
_ :: BadDependency) <- SomeException -> Maybe BadDependency
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
x = Bool
True
| Bool
otherwise = Bool
False
toKey :: Shake.ShakeValue k => k -> NormalizedFilePath -> Key
toKey :: forall k. ShakeValue k => k -> NormalizedFilePath -> Key
toKey = (Q k -> Key
forall a. (Typeable a, Hashable a, Show a) => a -> Key
newKey.) ((NormalizedFilePath -> Q k) -> NormalizedFilePath -> Key)
-> (k -> NormalizedFilePath -> Q k)
-> k
-> NormalizedFilePath
-> Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((k, NormalizedFilePath) -> Q k) -> k -> NormalizedFilePath -> Q k
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (k, NormalizedFilePath) -> Q k
forall k. (k, NormalizedFilePath) -> Q k
Q
fromKey :: Typeable k => Key -> Maybe (k, NormalizedFilePath)
fromKey :: forall k. Typeable k => Key -> Maybe (k, NormalizedFilePath)
fromKey (Key a
k)
| Just (Q (k
k', NormalizedFilePath
f)) <- a -> Maybe (Q k)
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a
k = (k, NormalizedFilePath) -> Maybe (k, NormalizedFilePath)
forall a. a -> Maybe a
Just (k
k', NormalizedFilePath
f)
| Bool
otherwise = Maybe (k, NormalizedFilePath)
forall a. Maybe a
Nothing
fromKeyType :: Key -> Maybe (SomeTypeRep, NormalizedFilePath)
fromKeyType :: Key -> Maybe (SomeTypeRep, NormalizedFilePath)
fromKeyType (Key a
k) = case a -> TypeRep a
forall a. Typeable a => a -> TypeRep a
typeOf a
k of
App (Con TyCon
tc) TypeRep b
a | TyCon
tc TyCon -> TyCon -> Bool
forall a. Eq a => a -> a -> Bool
== TypeRep Q -> TyCon
forall {k} (a :: k). TypeRep a -> TyCon
typeRepTyCon (forall {k} (a :: k). Typeable a => TypeRep a
forall (a :: * -> *). Typeable a => TypeRep a
typeRep @Q)
-> case a -> Q ()
forall a b. a -> b
unsafeCoerce a
k of
Q (()
_ :: (), NormalizedFilePath
f) -> (SomeTypeRep, NormalizedFilePath)
-> Maybe (SomeTypeRep, NormalizedFilePath)
forall a. a -> Maybe a
Just (TypeRep b -> SomeTypeRep
forall k (a :: k). TypeRep a -> SomeTypeRep
SomeTypeRep TypeRep b
a, NormalizedFilePath
f)
TypeRep a
_ -> Maybe (SomeTypeRep, NormalizedFilePath)
forall a. Maybe a
Nothing
toNoFileKey :: (Show k, Typeable k, Eq k, Hashable k) => k -> Key
toNoFileKey :: forall k. (Show k, Typeable k, Eq k, Hashable k) => k -> Key
toNoFileKey k
k = Q k -> Key
forall a. (Typeable a, Hashable a, Show a) => a -> Key
newKey (Q k -> Key) -> Q k -> Key
forall a b. (a -> b) -> a -> b
$ (k, NormalizedFilePath) -> Q k
forall k. (k, NormalizedFilePath) -> Q k
Q (k
k, NormalizedFilePath
emptyFilePath)
newtype Q k = Q (k, NormalizedFilePath)
deriving newtype (Q k -> Q k -> Bool
(Q k -> Q k -> Bool) -> (Q k -> Q k -> Bool) -> Eq (Q k)
forall k. Eq k => Q k -> Q k -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall k. Eq k => Q k -> Q k -> Bool
== :: Q k -> Q k -> Bool
$c/= :: forall k. Eq k => Q k -> Q k -> Bool
/= :: Q k -> Q k -> Bool
Eq, Eq (Q k)
Eq (Q k) => (Int -> Q k -> Int) -> (Q k -> Int) -> Hashable (Q k)
Int -> Q k -> Int
Q k -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
forall k. Hashable k => Eq (Q k)
forall k. Hashable k => Int -> Q k -> Int
forall k. Hashable k => Q k -> Int
$chashWithSalt :: forall k. Hashable k => Int -> Q k -> Int
hashWithSalt :: Int -> Q k -> Int
$chash :: forall k. Hashable k => Q k -> Int
hash :: Q k -> Int
Hashable, Q k -> ()
(Q k -> ()) -> NFData (Q k)
forall k. NFData k => Q k -> ()
forall a. (a -> ()) -> NFData a
$crnf :: forall k. NFData k => Q k -> ()
rnf :: Q k -> ()
NFData)
instance Show k => Show (Q k) where
show :: Q k -> [Char]
show (Q (k
k, NormalizedFilePath
file)) = k -> [Char]
forall a. Show a => a -> [Char]
show k
k [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"; " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ NormalizedFilePath -> [Char]
fromNormalizedFilePath NormalizedFilePath
file
newtype A v = A (Value v)
deriving Int -> A v -> ShowS
[A v] -> ShowS
A v -> [Char]
(Int -> A v -> ShowS)
-> (A v -> [Char]) -> ([A v] -> ShowS) -> Show (A v)
forall v. Show v => Int -> A v -> ShowS
forall v. Show v => [A v] -> ShowS
forall v. Show v => A v -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall v. Show v => Int -> A v -> ShowS
showsPrec :: Int -> A v -> ShowS
$cshow :: forall v. Show v => A v -> [Char]
show :: A v -> [Char]
$cshowList :: forall v. Show v => [A v] -> ShowS
showList :: [A v] -> ShowS
Show
instance NFData (A v) where rnf :: A v -> ()
rnf (A Value v
v) = Value v
v Value v -> () -> ()
forall a b. a -> b -> b
`seq` ()
type instance RuleResult (Q k) = A (RuleResult k)
toShakeValue :: (BS.ByteString -> ShakeValue) -> Maybe BS.ByteString -> ShakeValue
toShakeValue :: (ByteString -> ShakeValue) -> Maybe ByteString -> ShakeValue
toShakeValue = ShakeValue
-> (ByteString -> ShakeValue) -> Maybe ByteString -> ShakeValue
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ShakeValue
ShakeNoCutoff
data ShakeValue
=
ShakeNoCutoff
|
ShakeResult !BS.ByteString
| ShakeStale !BS.ByteString
deriving ((forall x. ShakeValue -> Rep ShakeValue x)
-> (forall x. Rep ShakeValue x -> ShakeValue) -> Generic ShakeValue
forall x. Rep ShakeValue x -> ShakeValue
forall x. ShakeValue -> Rep ShakeValue x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ShakeValue -> Rep ShakeValue x
from :: forall x. ShakeValue -> Rep ShakeValue x
$cto :: forall x. Rep ShakeValue x -> ShakeValue
to :: forall x. Rep ShakeValue x -> ShakeValue
Generic, Int -> ShakeValue -> ShowS
[ShakeValue] -> ShowS
ShakeValue -> [Char]
(Int -> ShakeValue -> ShowS)
-> (ShakeValue -> [Char])
-> ([ShakeValue] -> ShowS)
-> Show ShakeValue
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ShakeValue -> ShowS
showsPrec :: Int -> ShakeValue -> ShowS
$cshow :: ShakeValue -> [Char]
show :: ShakeValue -> [Char]
$cshowList :: [ShakeValue] -> ShowS
showList :: [ShakeValue] -> ShowS
Show)
instance NFData ShakeValue
encodeShakeValue :: ShakeValue -> BS.ByteString
encodeShakeValue :: ShakeValue -> ByteString
encodeShakeValue = \case
ShakeValue
ShakeNoCutoff -> ByteString
BS.empty
ShakeResult ByteString
r -> Char -> ByteString -> ByteString
BS.cons Char
'r' ByteString
r
ShakeStale ByteString
r -> Char -> ByteString -> ByteString
BS.cons Char
's' ByteString
r
decodeShakeValue :: BS.ByteString -> ShakeValue
decodeShakeValue :: ByteString -> ShakeValue
decodeShakeValue ByteString
bs = case ByteString -> Maybe (Char, ByteString)
BS.uncons ByteString
bs of
Maybe (Char, ByteString)
Nothing -> ShakeValue
ShakeNoCutoff
Just (Char
x, ByteString
xs)
| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'r' -> ByteString -> ShakeValue
ShakeResult ByteString
xs
| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
's' -> ByteString -> ShakeValue
ShakeStale ByteString
xs
| Bool
otherwise -> [Char] -> ShakeValue
forall a. HasCallStack => [Char] -> a
error ([Char] -> ShakeValue) -> [Char] -> ShakeValue
forall a b. (a -> b) -> a -> b
$ [Char]
"Failed to parse shake value " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> ByteString -> [Char]
forall a. Show a => a -> [Char]
show ByteString
bs