1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
|
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE NoImplicitPrelude #-}
-- | Owner-independent parsed artifact identities.
module Felix.Parsed.Identity
( ParsedModuleKey
, parsedModuleKey
, ParsedModuleKeyError(..)
, parsedModuleKeyDigest
, ParsedModuleId
, parsedModuleId
, parsedModuleIdDigest
, putParsedModuleKeyCache
, getParsedModuleKeyCache
, putParsedModuleIdCache
, getParsedModuleIdCache
) where
import Base
import Felix.Cache.Codec
import Felix.Source.Content
import Felix.Syntax.Interface
import Control.DeepSeq (NFData)
import Data.ByteString (ByteString)
import Data.Set qualified as Set
newtype ParsedModuleKey =
ParsedModuleKey CacheDigest
deriving stock (Show, Eq, Ord, Generic)
deriving newtype (Hashable, NFData)
data ParsedModuleKeyError
= DuplicateParsedDirectSyntaxInput !SyntaxInterfaceId
deriving stock (Show, Eq)
parsedModuleKey
:: SourceContentId
-> BaseSyntaxInterfaceId
-> [SyntaxInterfaceId]
-> Either ParsedModuleKeyError ParsedModuleKey
parsedModuleKey sourceContent base direct = do
case firstDuplicate direct of
Just duplicate ->
Left (DuplicateParsedDirectSyntaxInput duplicate)
Nothing ->
pure ()
pure
(ParsedModuleKey
(hashCacheFields
"felix-parsed-module-key-v1"
[ encodeCache
(putSourceContentIdCache sourceContent)
, encodeCache
(putBaseSyntaxInterfaceIdCache base)
, encodeCache
(putCacheList
putSyntaxInterfaceIdCache
direct)
]))
parsedModuleKeyDigest :: ParsedModuleKey -> CacheDigest
parsedModuleKeyDigest (ParsedModuleKey digest) =
digest
newtype ParsedModuleId =
ParsedModuleId CacheDigest
deriving stock (Show, Eq, Ord, Generic)
deriving newtype (Hashable, NFData)
-- | The payload is the complete canonical owner-independent parsed value.
parsedModuleId :: ParsedModuleKey -> ByteString -> ParsedModuleId
parsedModuleId key payload =
ParsedModuleId
(hashCacheFields
"felix-parsed-module-v1"
[ encodeCache (putParsedModuleKeyCache key)
, payload
])
parsedModuleIdDigest :: ParsedModuleId -> CacheDigest
parsedModuleIdDigest (ParsedModuleId digest) =
digest
putParsedModuleKeyCache :: ParsedModuleKey -> CachePut
putParsedModuleKeyCache (ParsedModuleKey digest) =
putCacheDigest digest
getParsedModuleKeyCache :: CacheGet ParsedModuleKey
getParsedModuleKeyCache =
ParsedModuleKey <$> getCacheDigest
putParsedModuleIdCache :: ParsedModuleId -> CachePut
putParsedModuleIdCache (ParsedModuleId digest) =
putCacheDigest digest
getParsedModuleIdCache :: CacheGet ParsedModuleId
getParsedModuleIdCache =
ParsedModuleId <$> getCacheDigest
firstDuplicate :: Ord value => [value] -> Maybe value
firstDuplicate =
go Set.empty
where
go _ [] =
Nothing
go seen (value : rest)
| value `Set.member` seen =
Just value
| otherwise =
go (Set.insert value seen) rest
|
