Skip to content

Commit 01ab5e9

Browse files
wenkokkewenkokke
committed
simulation: appease & ignore hlint
1 parent 99cba3c commit 01ab5e9

14 files changed

+55
-42
lines changed

‎simulation/src/ChanTCP.hs

+1-1
Original file line numberDiff line numberDiff line change
@@ -45,7 +45,7 @@ import Control.Tracer as Tracer (
4545
import Data.PQueue.Prio.Min (MinPQueue)
4646
import qualified Data.PQueue.Prio.Min as PQ
4747

48-
import Chan
48+
import Chan (Chan (..))
4949
import ModelTCP (
5050
Bytes,
5151
TcpConnProps (..),

‎simulation/src/ExamplesRelayP2P.hs

+6-6
Original file line numberDiff line numberDiff line change
@@ -99,8 +99,8 @@ example2 =
9999
++ "west edges are connected."
100100
, layoutLabelTime
101101
, LayoutBeside
102-
[ fmap (contramap fst) $
103-
LayoutAbove
102+
[ contramap fst
103+
<$> LayoutAbove
104104
[ LayoutReqSize 900 600 $
105105
Layout $
106106
relayP2PSimVizRender config
@@ -109,12 +109,12 @@ example2 =
109109
Layout $
110110
chartDiffusionLatency config
111111
, LayoutReqSize 350 300 $
112-
Layout $
112+
Layout
113113
chartLinkUtilisation
114114
]
115115
]
116-
, fmap (contramap snd) $
117-
LayoutAbove
116+
, contramap snd
117+
<$> LayoutAbove
118118
[ LayoutReqSize 900 600 $
119119
Layout $
120120
relayP2PSimVizRender config
@@ -123,7 +123,7 @@ example2 =
123123
Layout $
124124
chartDiffusionLatency config
125125
, LayoutReqSize 350 300 $
126-
Layout $
126+
Layout
127127
chartLinkUtilisation
128128
]
129129
]

‎simulation/src/ModelTCP.hs

+2-2
Original file line numberDiff line numberDiff line change
@@ -247,7 +247,7 @@ forecastTcpMsgSend
247247
tcpstate' = accumAck tcpstate ackbytes tcpAcknowledgements'
248248

249249
arrivedAcks :: Time -> TcpState -> TcpState
250-
arrivedAcks !now !tcpstate@TcpState{tcpAcknowledgements} =
250+
arrivedAcks !now tcpstate@TcpState{tcpAcknowledgements} =
251251
case PQ.minViewWithKey tcpAcknowledgements of
252252
Just ((ackts, ackbytes), tcpAcknowledgements')
253253
| ackts <= now ->
@@ -322,7 +322,7 @@ mergeAdjacentForecasts (forecast0 :| forecasts0) =
322322
| otherwise =
323323
forecast : go forecast' forecasts
324324
go forecast [] =
325-
forecast : []
325+
[forecast]
326326

327327
data TcpEvent msg
328328
= TcpSendMsg

‎simulation/src/P2P.hs

+2-2
Original file line numberDiff line numberDiff line change
@@ -108,11 +108,11 @@ genArbitraryP2PTopography
108108
Map.fromList
109109
[ ((nid, nid'), latency)
110110
| (nid, rng) <- zip nodes (unfoldr (Just . Random.split) rngLinks)
111-
, let Just p = Map.lookup nid nodePositions
111+
, let p = nodePositions Map.! nid
112112
, nid' <-
113113
pickNodeLinksClose p
114114
++ pickNodeLinksRandom nid rng
115-
, let Just p' = Map.lookup nid' nodePositions
115+
, let p' = nodePositions Map.! nid'
116116
!latency = linkLatency p p'
117117
]
118118

‎simulation/src/PlotTCP.hs

+2-2
Original file line numberDiff line numberDiff line change
@@ -76,10 +76,10 @@ toDataSeries' :: [(Time, Time, Bytes)] -> [[(DiffTime, Bytes)]]
7676
toDataSeries' = go [] 0 0
7777
where
7878
go [] !_ !_ [] = []
79-
go ps !_ !_ [] = reverse ps : []
79+
go ps !_ !_ [] = [reverse ps]
8080
go ps !a !x0 ((Time x1, Time x2, dy) : ts)
8181
| x1 == x0 = go ((x2, a + dy) : (x1, a) : ps) (a + dy) x2 ts
82-
| x1 > x0 = reverse ps : go ((x2, a + dy) : (x1, a) : []) (a + dy) x2 ts
82+
| x1 > x0 = reverse ps : go [(x2, a + dy), (x1, a)] (a + dy) x2 ts
8383
| otherwise = error "toDataSeries: non-monotonic x values"
8484

8585
selectEventsBeforeTime ::

‎simulation/src/RelayProtocol.hs

+3-2
Original file line numberDiff line numberDiff line change
@@ -28,6 +28,7 @@ import Control.Concurrent.Class.MonadSTM (
2828
modifyTVar',
2929
newTVarIO,
3030
readTVar,
31+
readTVarIO,
3132
retry
3233
),
3334
)
@@ -151,7 +152,7 @@ modifyRelayBuffer ::
151152
RelayBuffer m blk blkid ->
152153
(BlockQueue blk blkid -> BlockQueue blk blkid) ->
153154
STM m ()
154-
modifyRelayBuffer (RelayBuffer buffer) f = modifyTVar' buffer f
155+
modifyRelayBuffer (RelayBuffer buffer) = modifyTVar' buffer
155156

156157
-- | The block relay protocol:
157158
--
@@ -218,7 +219,7 @@ relayServer BlockRelayConfig{blockTTL} (RelayBuffer buffer) chan =
218219
]
219220
go (fingerprintBlockQueue blkq)
220221
MsgReqBlockIdsNonBlocking -> do
221-
blkq <- atomically $ readTVar buffer
222+
blkq <- readTVarIO buffer
222223
writeChan chan $
223224
MsgRespBlockIds
224225
[ (blkid, blockTTL blk)

‎simulation/src/SimRelay.hs

+15-11
Original file line numberDiff line numberDiff line change
@@ -3,6 +3,10 @@
33
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
44
{-# LANGUAGE NamedFieldPuns #-}
55
{-# LANGUAGE ScopedTypeVariables #-}
6+
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
7+
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
8+
9+
{-# HLINT ignore "Use void" #-}
610

711
module SimRelay where
812

@@ -175,7 +179,7 @@ relayNode
175179
where
176180
go !rng = do
177181
let (u, rng') = uniformR (0, 1) rng
178-
gendelay = realToFrac (-log u * lambda :: Double) :: DiffTime
182+
gendelay = realToFrac ((-log u) * lambda :: Double) :: DiffTime
179183
threadDelaySI gendelay
180184
now <- getCurrentTime
181185
let (blkidn, rng'') = uniform rng'
@@ -245,8 +249,8 @@ traceRelayLink1 tcpprops generationPattern =
245249
, worldIsCylinder = False
246250
}
247251
( Map.fromList
248-
[ (NodeId 0, (Point 50 100))
249-
, (NodeId 1, (Point 450 100))
252+
[ (NodeId 0, Point 50 100)
253+
, (NodeId 1, Point 450 100)
250254
]
251255
)
252256
( Set.fromList
@@ -291,10 +295,10 @@ traceRelayLink4 tcpprops generationPattern =
291295
, worldIsCylinder = False
292296
}
293297
( Map.fromList
294-
[ (NodeId 0, (Point 50 250))
295-
, (NodeId 1, (Point 450 70))
296-
, (NodeId 2, (Point 550 430))
297-
, (NodeId 3, (Point 950 250))
298+
[ (NodeId 0, Point 50 250)
299+
, (NodeId 1, Point 450 70)
300+
, (NodeId 2, Point 550 430)
301+
, (NodeId 3, Point 950 250)
298302
]
299303
)
300304
( symmetric $
@@ -353,10 +357,10 @@ traceRelayLink4Asymmetric tcppropsShort tcppropsLong generationPattern =
353357
, worldIsCylinder = False
354358
}
355359
( Map.fromList
356-
[ (NodeId 0, (Point 50 70))
357-
, (NodeId 1, (Point 450 400))
358-
, (NodeId 2, (Point 500 70))
359-
, (NodeId 3, (Point 950 70))
360+
[ (NodeId 0, Point 50 70)
361+
, (NodeId 1, Point 450 400)
362+
, (NodeId 2, Point 500 70)
363+
, (NodeId 3, Point 950 70)
360364
]
361365
)
362366
( symmetric $

‎simulation/src/SimTCPLinks.hs

+6-1
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,10 @@
11
{-# LANGUAGE NamedFieldPuns #-}
22
{-# LANGUAGE ScopedTypeVariables #-}
3+
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
4+
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
5+
6+
{-# HLINT ignore "Use void" #-}
7+
{-# HLINT ignore "Use section" #-}
38

49
module SimTCPLinks where
510

@@ -187,7 +192,7 @@ labelDirToLabelLink nfrom nto (DirClientToServer e) = LabelLink nfrom nto e
187192
labelDirToLabelLink nfrom nto (DirServerToClient e) = LabelLink nto nfrom e
188193

189194
simTracer :: Typeable e => Tracer (IOSim s) e
190-
simTracer = Tracer.Tracer $ Tracer.emit $ IOSim.traceM
195+
simTracer = Tracer.Tracer $ Tracer.emit IOSim.traceM
191196

192197
selectTimedEvents :: forall a b. Typeable b => SimTrace a -> [(Time, b)]
193198
selectTimedEvents =

‎simulation/src/Viz.hs

+5-5
Original file line numberDiff line numberDiff line change
@@ -223,7 +223,7 @@ layoutTiles allocToplevel =
223223
iprops
224224
]
225225
(LayoutOver [], []) -> []
226-
(LayoutOver (l : ls), (lp : lps')) ->
226+
(LayoutOver (l : ls), lp : lps') ->
227227
concat $
228228
allocate (x, y) (w, h) scale clear l lp
229229
: [ allocate (x, y) (w, h) scale False l' lp'
@@ -248,7 +248,7 @@ takeUpTo n = go 0
248248
where
249249
go !_ [] = []
250250
go !a (x : xs)
251-
| a + x >= n = x : [] -- inclusive
251+
| a + x >= n = [x] -- inclusive
252252
| otherwise = x : go (a + x) xs
253253

254254
data LayoutProperties
@@ -475,9 +475,9 @@ vizualise
475475
name <- Gtk.eventKeyName
476476
case name of
477477
"Escape" -> liftIO $ Gtk.widgetDestroy window
478-
"F11" -> liftIO $ toggleMaximised
479-
"F5" -> liftIO $ toggleFullscreen
480-
"f" -> liftIO $ toggleFullscreen
478+
"F11" -> liftIO toggleMaximised
479+
"F5" -> liftIO toggleFullscreen
480+
"f" -> liftIO toggleFullscreen
481481
_ -> return ()
482482

483483
_ <- Gtk.on window Gtk.objectDestroy $ do

‎simulation/src/VizChart.hs

+4-3
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,7 @@
11
{-# LANGUAGE NamedFieldPuns #-}
22
{-# LANGUAGE OverloadedStrings #-}
33
{-# LANGUAGE ScopedTypeVariables #-}
4+
{-# OPTIONS_GHC -Wno-orphans #-}
45

56
module VizChart where
67

@@ -46,14 +47,14 @@ instance Chart.PlotValue Bytes where
4647
50
4748

4849
instance Chart.PlotValue DiffTime where
49-
toValue t = realToFrac t
50-
fromValue v = realToFrac v
5150
autoAxis =
5251
autoScaledAxis $
5352
Chart.LinearAxisParams
54-
(map (\t -> show t))
53+
(map show)
5554
10
5655
50
56+
toValue = realToFrac
57+
fromValue = realToFrac
5758

5859
autoScaledAxis :: RealFrac a => Chart.LinearAxisParams a -> Chart.AxisFn a
5960
autoScaledAxis lap ps = scaledAxis lap rs ps

‎simulation/src/VizSimRelay.hs

+1-1
Original file line numberDiff line numberDiff line change
@@ -174,7 +174,7 @@ relaySimVizModel =
174174
, vizMsgsDiffusionLatency =
175175
Map.adjust
176176
( \(blk, nid', created, arrivals) ->
177-
(blk, nid', created, (now : arrivals))
177+
(blk, nid', created, now : arrivals)
178178
)
179179
(testBlockId msg)
180180
(vizMsgsDiffusionLatency vs)

‎simulation/src/VizSimRelayP2P.hs

+2
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,8 @@
11
{-# LANGUAGE BangPatterns #-}
22
{-# LANGUAGE NamedFieldPuns #-}
33
{-# LANGUAGE ScopedTypeVariables #-}
4+
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
5+
{-# HLINT ignore "Use const" #-}
46

57
module VizSimRelayP2P where
68

‎simulation/src/VizSimTCP.hs

+2-2
Original file line numberDiff line numberDiff line change
@@ -47,7 +47,7 @@ tcpSimVizModel ::
4747
VizModel TcpSimVizModel
4848
tcpSimVizModel =
4949
simVizModel
50-
(\_t -> accumEventVizState)
50+
(\_ -> accumEventVizState)
5151
pruneVisState
5252
initVizState
5353
where
@@ -121,7 +121,7 @@ tcpSimVizModel =
121121
-- The vizualisation rendering
122122
--
123123

124-
data TcpSimVizConfig msg
124+
newtype TcpSimVizConfig msg
125125
= TcpSimVizConfig
126126
{ messageColor :: msg -> (Double, Double, Double)
127127
}

‎simulation/src/VizUtils.hs

+4-4
Original file line numberDiff line numberDiff line change
@@ -18,11 +18,11 @@ withPoint f (Point x y) = f x y
1818
renderPathRoundedRect :: Point -> Point -> Double -> Cairo.Render ()
1919
renderPathRoundedRect a@(Point x1 _) b@(Point x2 _) w = do
2020
if x2 > x1
21-
then withPoint Cairo.arc a' r (π / 2 + α) (-π / 2 + α)
22-
else withPoint Cairo.arc a' r (-π / 2 + α) (π / 2 + α)
21+
then withPoint Cairo.arc a' r (π / 2 + α) ((-π) / 2 + α)
22+
else withPoint Cairo.arc a' r ((-π) / 2 + α) (π / 2 + α)
2323
if x2 > x1
24-
then withPoint Cairo.arc b' r (-π / 2 + α) (π / 2 + α)
25-
else withPoint Cairo.arc b' r (π / 2 + α) (-π / 2 + α)
24+
then withPoint Cairo.arc b' r ((-π) / 2 + α) (π / 2 + α)
25+
else withPoint Cairo.arc b' r (π / 2 + α) ((-π) / 2 + α)
2626
Cairo.closePath
2727
where
2828
π = pi

0 commit comments

Comments
 (0)