Skip to content

Commit 78bfaec

Browse files
committed
Cabal-syntax: trade TypeFamilies for FunctionalDependencies
The overarching goal is to make Cabal-syntax compilable by MicroHs, which does not support TypeFamilies, but does support FunctionalDependencies.
1 parent f26cbdc commit 78bfaec

File tree

30 files changed

+117
-151
lines changed

30 files changed

+117
-151
lines changed

Cabal-hooks/Cabal-hooks.cabal

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -62,7 +62,6 @@ library
6262
ScopedTypeVariables
6363
StandaloneDeriving
6464
Trustworthy
65-
TypeFamilies
6665
TypeOperators
6766
TypeSynonymInstances
6867
UndecidableInstances

Cabal-syntax/Cabal-syntax.cabal

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -226,7 +226,6 @@ library
226226
ScopedTypeVariables
227227
StandaloneDeriving
228228
Trustworthy
229-
TypeFamilies
230229
TypeOperators
231230
TypeSynonymInstances
232231
UndecidableInstances

Cabal-syntax/src/Distribution/Compat/Graph.hs

Lines changed: 47 additions & 50 deletions
Original file line numberDiff line numberDiff line change
@@ -1,8 +1,8 @@
11
{-# LANGUAGE BangPatterns #-}
22
{-# LANGUAGE FlexibleContexts #-}
3+
{-# LANGUAGE FlexibleInstances #-}
4+
{-# LANGUAGE FunctionalDependencies #-}
35
{-# LANGUAGE ScopedTypeVariables #-}
4-
{-# LANGUAGE TypeFamilies #-}
5-
{-# LANGUAGE TypeOperators #-}
66
{-# LANGUAGE UndecidableInstances #-}
77

88
-- |
@@ -107,40 +107,40 @@ import qualified Distribution.Compat.Prelude as Prelude
107107

108108
-- | A graph of nodes @a@. The nodes are expected to have instance
109109
-- of class 'IsNode'.
110-
data Graph a = Graph
111-
{ graphMap :: !(Map (Key a) a)
110+
data Graph keyA a = Graph
111+
{ graphMap :: !(Map keyA a)
112112
, -- Lazily cached graph representation
113113
graphForward :: G.Graph
114114
, graphAdjoint :: G.Graph
115115
, graphVertexToNode :: G.Vertex -> a
116-
, graphKeyToVertex :: Key a -> Maybe G.Vertex
117-
, graphBroken :: [(a, [Key a])]
116+
, graphKeyToVertex :: keyA -> Maybe G.Vertex
117+
, graphBroken :: [(a, [keyA])]
118118
}
119119

120120
-- NB: Not a Functor! (or Traversable), because you need
121-
-- to restrict Key a ~ Key b. We provide our own mapping
121+
-- to restrict keyA ~ Key b. We provide our own mapping
122122
-- functions.
123123

124124
-- General strategy is most operations are deferred to the
125125
-- Map representation.
126126

127-
instance Show a => Show (Graph a) where
127+
instance Show a => Show (Graph keyA a) where
128128
show = show . toList
129129

130-
instance (IsNode a, Read a, Show (Key a)) => Read (Graph a) where
130+
instance (IsNode keyA a, Read a, Show keyA) => Read (Graph keyA a) where
131131
readsPrec d s = map (first fromDistinctList) (readsPrec d s)
132132

133-
instance (IsNode a, Binary a, Show (Key a)) => Binary (Graph a) where
133+
instance (IsNode keyA a, Binary a, Show keyA) => Binary (Graph keyA a) where
134134
put x = put (toList x)
135135
get = fmap fromDistinctList get
136136

137-
instance Structured a => Structured (Graph a) where
137+
instance (Structured a, Typeable keyA) => Structured (Graph keyA a) where
138138
structure p = Nominal (typeRep p) 0 "Graph" [structure (Proxy :: Proxy a)]
139139

140-
instance (Eq (Key a), Eq a) => Eq (Graph a) where
140+
instance (Eq keyA, Eq a) => Eq (Graph keyA a) where
141141
g1 == g2 = graphMap g1 == graphMap g2
142142

143-
instance Foldable.Foldable Graph where
143+
instance Foldable.Foldable (Graph keyA) where
144144
elem x = Foldable.elem x . graphMap
145145
fold = Foldable.fold . graphMap
146146
foldl f z = Foldable.foldl f z . graphMap
@@ -156,7 +156,7 @@ instance Foldable.Foldable Graph where
156156
sum = Foldable.sum . graphMap
157157
toList = Foldable.toList . graphMap
158158

159-
instance (NFData a, NFData (Key a)) => NFData (Graph a) where
159+
instance (NFData a, NFData keyA) => NFData (Graph keyA a) where
160160
rnf
161161
Graph
162162
{ graphMap = m
@@ -173,13 +173,11 @@ instance (NFData a, NFData (Key a)) => NFData (Graph a) where
173173
-- graph nodes. A node of type @a@ is associated with some unique key of
174174
-- type @'Key' a@; given a node we can determine its key ('nodeKey')
175175
-- and the keys of its neighbors ('nodeNeighbors').
176-
class Ord (Key a) => IsNode a where
177-
type Key a
178-
nodeKey :: a -> Key a
179-
nodeNeighbors :: a -> [Key a]
176+
class Ord keyA => IsNode keyA a | a -> keyA where
177+
nodeKey :: a -> keyA
178+
nodeNeighbors :: a -> [keyA]
180179

181-
instance (IsNode a, IsNode b, Key a ~ Key b) => IsNode (Either a b) where
182-
type Key (Either a b) = Key a
180+
instance (IsNode key a, IsNode key b) => IsNode key (Either a b) where
183181
nodeKey (Left x) = nodeKey x
184182
nodeKey (Right x) = nodeKey x
185183
nodeNeighbors (Left x) = nodeNeighbors x
@@ -196,50 +194,49 @@ nodeValue (N a _ _) = a
196194
instance Functor (Node k) where
197195
fmap f (N a k ks) = N (f a) k ks
198196

199-
instance Ord k => IsNode (Node k a) where
200-
type Key (Node k a) = k
197+
instance Ord k => IsNode k (Node k a) where
201198
nodeKey (N _ k _) = k
202199
nodeNeighbors (N _ _ ks) = ks
203200

204201
-- TODO: Maybe introduce a typeclass for items which just
205-
-- keys (so, Key associated type, and nodeKey method). But
202+
-- keys (so, keyAssociated type, and nodeKey method). But
206203
-- I didn't need it here, so I didn't introduce it.
207204

208205
-- Query
209206

210207
-- | /O(1)/. Is the graph empty?
211-
null :: Graph a -> Bool
208+
null :: Graph keyA a -> Bool
212209
null = Map.null . toMap
213210

214211
-- | /O(1)/. The number of nodes in the graph.
215-
size :: Graph a -> Int
212+
size :: Graph keyA a -> Int
216213
size = Map.size . toMap
217214

218215
-- | /O(log V)/. Check if the key is in the graph.
219-
member :: IsNode a => Key a -> Graph a -> Bool
216+
member :: IsNode keyA a => keyA -> Graph keyA a -> Bool
220217
member k g = Map.member k (toMap g)
221218

222219
-- | /O(log V)/. Lookup the node at a key in the graph.
223-
lookup :: IsNode a => Key a -> Graph a -> Maybe a
220+
lookup :: IsNode keyA a => keyA -> Graph keyA a -> Maybe a
224221
lookup k g = Map.lookup k (toMap g)
225222

226223
-- Construction
227224

228225
-- | /O(1)/. The empty graph.
229-
empty :: IsNode a => Graph a
226+
empty :: IsNode keyA a => Graph keyA a
230227
empty = fromMap Map.empty
231228

232229
-- | /O(log V)/. Insert a node into a graph.
233-
insert :: IsNode a => a -> Graph a -> Graph a
230+
insert :: IsNode keyA a => a -> Graph keyA a -> Graph keyA a
234231
insert !n g = fromMap (Map.insert (nodeKey n) n (toMap g))
235232

236233
-- | /O(log V)/. Delete the node at a key from the graph.
237-
deleteKey :: IsNode a => Key a -> Graph a -> Graph a
234+
deleteKey :: IsNode keyA a => keyA -> Graph keyA a -> Graph keyA a
238235
deleteKey k g = fromMap (Map.delete k (toMap g))
239236

240237
-- | /O(log V)/. Lookup and delete. This function returns the deleted
241238
-- value if it existed.
242-
deleteLookup :: IsNode a => Key a -> Graph a -> (Maybe a, Graph a)
239+
deleteLookup :: IsNode keyA a => keyA -> Graph keyA a -> (Maybe a, Graph keyA a)
243240
deleteLookup k g =
244241
let (r, m') = Map.updateLookupWithKey (\_ _ -> Nothing) k (toMap g)
245242
in (r, fromMap m')
@@ -249,19 +246,19 @@ deleteLookup k g =
249246
-- | /O(V + V')/. Right-biased union, preferring entries
250247
-- from the second map when conflicts occur.
251248
-- @'nodeKey' x = 'nodeKey' (f x)@.
252-
unionRight :: IsNode a => Graph a -> Graph a -> Graph a
249+
unionRight :: IsNode keyA a => Graph keyA a -> Graph keyA a -> Graph keyA a
253250
unionRight g g' = fromMap (Map.union (toMap g') (toMap g))
254251

255252
-- | /O(V + V')/. Left-biased union, preferring entries from
256253
-- the first map when conflicts occur.
257-
unionLeft :: IsNode a => Graph a -> Graph a -> Graph a
254+
unionLeft :: IsNode keyA a => Graph keyA a -> Graph keyA a -> Graph keyA a
258255
unionLeft = flip unionRight
259256

260257
-- Graph-like operations
261258

262259
-- | /Ω(V + E)/. Compute the strongly connected components of a graph.
263260
-- Requires amortized construction of graph.
264-
stronglyConnComp :: Graph a -> [SCC a]
261+
stronglyConnComp :: Graph keyA a -> [SCC a]
265262
stronglyConnComp g = map decode forest
266263
where
267264
forest = G.scc (graphForward g)
@@ -278,25 +275,25 @@ stronglyConnComp g = map decode forest
278275

279276
-- | /Ω(V + E)/. Compute the cycles of a graph.
280277
-- Requires amortized construction of graph.
281-
cycles :: Graph a -> [[a]]
278+
cycles :: Graph keyA a -> [[a]]
282279
cycles g = [vs | CyclicSCC vs <- stronglyConnComp g]
283280

284281
-- | /O(1)/. Return a list of nodes paired with their broken
285282
-- neighbors (i.e., neighbor keys which are not in the graph).
286283
-- Requires amortized construction of graph.
287-
broken :: Graph a -> [(a, [Key a])]
284+
broken :: Graph keyA a -> [(a, [keyA])]
288285
broken g = graphBroken g
289286

290287
-- | Lookup the immediate neighbors from a key in the graph.
291288
-- Requires amortized construction of graph.
292-
neighbors :: Graph a -> Key a -> Maybe [a]
289+
neighbors :: Graph keyA a -> keyA -> Maybe [a]
293290
neighbors g k = do
294291
v <- graphKeyToVertex g k
295292
return (map (graphVertexToNode g) (graphForward g ! v))
296293

297294
-- | Lookup the immediate reverse neighbors from a key in the graph.
298295
-- Requires amortized construction of graph.
299-
revNeighbors :: Graph a -> Key a -> Maybe [a]
296+
revNeighbors :: Graph keyA a -> keyA -> Maybe [a]
300297
revNeighbors g k = do
301298
v <- graphKeyToVertex g k
302299
return (map (graphVertexToNode g) (graphAdjoint g ! v))
@@ -305,7 +302,7 @@ revNeighbors g k = do
305302
-- Returns @Nothing@ if one (or more) keys are not present in
306303
-- the graph.
307304
-- Requires amortized construction of graph.
308-
closure :: Graph a -> [Key a] -> Maybe [a]
305+
closure :: Graph keyA a -> [keyA] -> Maybe [a]
309306
closure g ks = do
310307
vs <- traverse (graphKeyToVertex g) ks
311308
return (decodeVertexForest g (G.dfs (graphForward g) vs))
@@ -314,25 +311,25 @@ closure g ks = do
314311
-- of keys. Returns @Nothing@ if one (or more) keys are not present in
315312
-- the graph.
316313
-- Requires amortized construction of graph.
317-
revClosure :: Graph a -> [Key a] -> Maybe [a]
314+
revClosure :: Graph keyA a -> [keyA] -> Maybe [a]
318315
revClosure g ks = do
319316
vs <- traverse (graphKeyToVertex g) ks
320317
return (decodeVertexForest g (G.dfs (graphAdjoint g) vs))
321318

322319
flattenForest :: Tree.Forest a -> [a]
323320
flattenForest = concatMap Tree.flatten
324321

325-
decodeVertexForest :: Graph a -> Tree.Forest G.Vertex -> [a]
322+
decodeVertexForest :: Graph keyA a -> Tree.Forest G.Vertex -> [a]
326323
decodeVertexForest g = map (graphVertexToNode g) . flattenForest
327324

328325
-- | Topologically sort the nodes of a graph.
329326
-- Requires amortized construction of graph.
330-
topSort :: Graph a -> [a]
327+
topSort :: Graph keyA a -> [a]
331328
topSort g = map (graphVertexToNode g) $ G.topSort (graphForward g)
332329

333330
-- | Reverse topologically sort the nodes of a graph.
334331
-- Requires amortized construction of graph.
335-
revTopSort :: Graph a -> [a]
332+
revTopSort :: Graph keyA a -> [a]
336333
revTopSort g = map (graphVertexToNode g) $ G.topSort (graphAdjoint g)
337334

338335
-- Conversions
@@ -343,7 +340,7 @@ revTopSort g = map (graphVertexToNode g) $ G.topSort (graphAdjoint g)
343340
-- if you can't fulfill this invariant use @'fromList' ('Data.Map.elems' m)@
344341
-- instead. The values of the map are assumed to already
345342
-- be in WHNF.
346-
fromMap :: IsNode a => Map (Key a) a -> Graph a
343+
fromMap :: IsNode keyA a => Map keyA a -> Graph keyA a
347344
fromMap m =
348345
Graph
349346
{ graphMap = m
@@ -377,7 +374,7 @@ fromMap m =
377374
bounds = (0, Map.size m - 1)
378375

379376
-- | /O(V log V)/. Convert a list of nodes (with distinct keys) into a graph.
380-
fromDistinctList :: (IsNode a, Show (Key a)) => [a] -> Graph a
377+
fromDistinctList :: (IsNode keyA a, Show keyA) => [a] -> Graph keyA a
381378
fromDistinctList =
382379
fromMap
383380
. Map.fromListWith (\_ -> duplicateError)
@@ -391,26 +388,26 @@ fromDistinctList =
391388
-- Map-like operations
392389

393390
-- | /O(V)/. Convert a graph into a list of nodes.
394-
toList :: Graph a -> [a]
391+
toList :: Graph keyA a -> [a]
395392
toList g = Map.elems (toMap g)
396393

397394
-- | /O(V)/. Convert a graph into a list of keys.
398-
keys :: Graph a -> [Key a]
395+
keys :: Graph keyA a -> [keyA]
399396
keys g = Map.keys (toMap g)
400397

401398
-- | /O(V)/. Convert a graph into a set of keys.
402-
keysSet :: Graph a -> Set.Set (Key a)
399+
keysSet :: Graph keyA a -> Set.Set keyA
403400
keysSet g = Map.keysSet (toMap g)
404401

405402
-- | /O(1)/. Convert a graph into a map from keys to nodes.
406403
-- The resulting map @m@ is guaranteed to have the property that
407404
-- @'Prelude.all' (\(k,n) -> k == 'nodeKey' n) ('Data.Map.toList' m)@.
408-
toMap :: Graph a -> Map (Key a) a
405+
toMap :: Graph keyA a -> Map keyA a
409406
toMap = graphMap
410407

411408
-- Graph-like operations
412409

413410
-- | /O(1)/. Convert a graph into a 'Data.Graph.Graph'.
414411
-- Requires amortized construction of graph.
415-
toGraph :: Graph a -> (G.Graph, G.Vertex -> a, Key a -> Maybe G.Vertex)
412+
toGraph :: Graph keyA a -> (G.Graph, G.Vertex -> a, keyA -> Maybe G.Vertex)
416413
toGraph g = (graphForward g, graphVertexToNode g, graphKeyToVertex g)

Cabal-syntax/src/Distribution/Types/InstalledPackageInfo.hs

Lines changed: 2 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,6 @@
11
{-# LANGUAGE DeriveGeneric #-}
2+
{-# LANGUAGE MultiParamTypeClasses #-}
23
{-# LANGUAGE OverloadedStrings #-}
3-
{-# LANGUAGE TypeFamilies #-}
44

55
module Distribution.Types.InstalledPackageInfo
66
( InstalledPackageInfo (..)
@@ -113,8 +113,7 @@ instance Package.HasUnitId InstalledPackageInfo where
113113
instance Package.PackageInstalled InstalledPackageInfo where
114114
installedDepends = depends
115115

116-
instance IsNode InstalledPackageInfo where
117-
type Key InstalledPackageInfo = UnitId
116+
instance IsNode UnitId InstalledPackageInfo where
118117
nodeKey = installedUnitId
119118
nodeNeighbors = depends
120119

Cabal-syntax/src/Distribution/Utils/Path.hs

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -3,9 +3,10 @@
33
{-# LANGUAGE DeriveGeneric #-}
44
{-# LANGUAGE FlexibleInstances #-}
55
{-# LANGUAGE FunctionalDependencies #-}
6+
{-# LANGUAGE GADTs #-}
7+
{-# LANGUAGE KindSignatures #-}
68
{-# LANGUAGE RankNTypes #-}
79
{-# LANGUAGE RoleAnnotations #-}
8-
{-# LANGUAGE TypeFamilies #-}
910
{-# LANGUAGE TypeOperators #-}
1011
{-# LANGUAGE UndecidableInstances #-}
1112

Cabal-syntax/src/Distribution/Utils/Structured.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -2,10 +2,10 @@
22
{-# LANGUAGE DefaultSignatures #-}
33
{-# LANGUAGE DeriveGeneric #-}
44
{-# LANGUAGE FlexibleContexts #-}
5+
{-# LANGUAGE GADTs #-}
56
{-# LANGUAGE PolyKinds #-}
67
{-# LANGUAGE ScopedTypeVariables #-}
78
{-# LANGUAGE TypeApplications #-}
8-
{-# LANGUAGE TypeFamilies #-}
99
{-# LANGUAGE TypeOperators #-}
1010

1111
-- |

0 commit comments

Comments
 (0)