Skip to content

Commit 08ce55b

Browse files
Addressing compilation warnings + code styling
1 parent 303bb99 commit 08ce55b

Some content is hidden

Large Commits have some content hidden by default. Use the searchbox below for content that may be hidden.

58 files changed

+5784
-5614
lines changed

app/draw-pre-order-figure.hs

Lines changed: 50 additions & 21 deletions
Original file line numberDiff line numberDiff line change
@@ -1,12 +1,15 @@
1-
{-# LANGUAGE FlexibleContexts #-}
2-
{-# LANGUAGE NoMonomorphismRestriction #-}
3-
{-# LANGUAGE TypeFamilies #-}
1+
{-# Language DerivingStrategies #-}
2+
{-# Language FlexibleContexts #-}
3+
{-# Language NoMonomorphismRestriction #-}
4+
{-# Language TypeFamilies #-}
5+
{-# Language TypeOperators #-}
46

5-
import Data.Data
6-
import Data.Key
7-
import Diagrams.Backend.SVG.CmdLine
8-
import Diagrams.Prelude hiding (trace)
9-
import Prelude hiding (zip)
7+
import Data.Data
8+
import Data.Key
9+
import Diagrams.Backend.SVG.CmdLine
10+
import Diagrams.Prelude hiding (trace)
11+
import Diagrams.TwoD.Text (Text)
12+
import Prelude hiding (zip)
1013

1114

1215
main :: IO ()
@@ -35,7 +38,8 @@ arrowLine = with & shaftStyle %~ lw 3
3538

3639
arrowBent :: (Typeable n, RealFloat n) => ArrowOpts n
3740
arrowBent =
38-
let shaft = trailFromVertices $ p2 <$> [ (0, 0), (0, 1.5), (9, 1.5), (9, 3) ]
41+
let shaft :: (Floating n, Ord n) => Trail V2 n
42+
shaft = trailFromVertices $ p2 <$> [ (0, 0), (0, 1.5), (9, 1.5), (9, 3) ]
3943
in with & arrowShaft .~ shaft
4044
& headLength .~ 12
4145
& shaftStyle %~ lw 3
@@ -48,7 +52,7 @@ data AlignCell
4852
| Gapped
4953
| Spacing
5054
| Question
51-
deriving (Eq, Show)
55+
deriving stock (Eq, Show)
5256

5357

5458
toSymbol :: AlignCell -> Char
@@ -63,7 +67,9 @@ toSymbol Question = '?'
6367
frames :: [Diagram B]
6468
frames = f <#$> ijks
6569
where
66-
f k = (# named ("frame " <> show k)) . pad 1.4 . (<>box) . centerXY . makeAlignments
70+
f :: Int -> (Word, Word, Word) -> QDiagram B V2 Double Any
71+
f k = (# named ("frame " <> show k)) . pad 1.4 . (<> box) . centerXY . makeAlignments
72+
6773
box = phantom (rect 28 11 :: Diagram B) :: Diagram B
6874

6975

@@ -75,17 +81,27 @@ makeAlignments (i,j,k) = stackVertical
7581
, makeIndexPad ||| derivedAt i cAlign
7682
]
7783
where
78-
f = withEnvelope box
84+
f :: Monoid m => QDiagram b V2 Double m -> QDiagram b V2 Double m
85+
f = withEnvelope box
86+
7987
box = phantom (rect 1 2 :: Diagram B) :: Diagram B
8088
makeIndexPad = box ||| box ||| box ||| box
8189
makeIndexLabel :: String -> Word -> Diagram B
8290
makeIndexLabel idx val = f smb ||| f eqs ||| f num ||| box
8391
where
8492
-- We make a different cell for each symbol to ensure "monospacing."
85-
smb = txt idx
93+
eqs
94+
:: (Typeable n, RealFloat n, Renderable (Text n) b)
95+
=> QDiagram b V2 n Any
8696
eqs = txt "="
87-
num = txt $ show val
97+
98+
txt
99+
:: (Typeable n, RealFloat n, Renderable (Text n) b)
100+
=> String -> QDiagram b V2 n Any
88101
txt = scale 1.5 . bold . text
102+
smb = txt idx
103+
104+
num = txt $ show val
89105

90106

91107
stackVertical
@@ -116,11 +132,11 @@ alignmentAt i xs = foldlWithKey makeCell mempty cells
116132
where
117133
(h,t) = splitAt (fromEnum i) xs
118134
cells
119-
| all (==Spacing) t = h <> [Spacing]
120-
| otherwise = h <> filter (/=Spacing) t
135+
| all (== Spacing) t = h <> [Spacing]
136+
| otherwise = h <> filter (/= Spacing) t
121137

122138
cursorStop :: Word
123-
cursorStop = toEnum . length . dropWhile (==Spacing) $ reverse cells
139+
cursorStop = toEnum . length . dropWhile (== Spacing) $ reverse cells
124140

125141
makeCell :: Diagram B -> Int -> AlignCell -> Diagram B
126142
makeCell a k e
@@ -141,7 +157,7 @@ alignmentAt i xs = foldlWithKey makeCell mempty cells
141157

142158

143159
cellText :: String -> Diagram B
144-
cellText = alignT . scale (5/3) . (<> phantom box) . bold . text
160+
cellText = alignT . scale (5 / 3) . (<> phantom box) . bold . text
145161
where
146162
box = square 0.25 :: Diagram B
147163

@@ -177,8 +193,19 @@ grnLine = lineColor (sRGB 0 128 0)
177193
stp :: Diagram B
178194
stp = upper <> lower
179195
where
180-
upper = mkLine [origin, sqrt 2 ^& sqrt 2]
181-
lower = mkLine [0 ^& sqrt 2, sqrt 2 ^& 0]
196+
upper
197+
:: (Typeable n, RealFloat n, Renderable (Path V2 n) b)
198+
=> QDiagram b V2 n Any
199+
upper = mkLine [origin, sqrt 2 ^& sqrt 2]
200+
201+
lower
202+
:: (Typeable n, RealFloat n, Renderable (Path V2 n) b)
203+
=> QDiagram b V2 n Any
204+
lower = mkLine [0 ^& sqrt 2, sqrt 2 ^& 0]
205+
206+
mkLine
207+
:: (Typeable n, RealFloat n, Renderable (Path V2 n) b)
208+
=> [Point V2 n] -> QDiagram b V2 n Any
182209
mkLine = centerXY . lineWidth 2 . strokeLine . lineFromVertices
183210

184211

@@ -219,7 +246,9 @@ lPoints = p2 <$>
219246

220247
labels :: [Diagram B]
221248
labels =
222-
let lab = centerXY . scale 1.8 . pad 1.5 . bold . text
249+
let lab :: (Typeable n, RealFloat n, Renderable (Text n) b)
250+
=> String -> QDiagram b V2 n Any
251+
lab = centerXY . scale 1.8 . pad 1.5 . bold . text
223252
in [ lab "Case 2"
224253
, lab "Case 3"
225254
, lab "Case 0"

app/generate-timings/InputParser.hs

Lines changed: 37 additions & 32 deletions
Original file line numberDiff line numberDiff line change
@@ -1,39 +1,44 @@
1-
{-# LANGUAGE FlexibleContexts #-}
2-
{-# LANGUAGE TypeFamilies #-}
1+
{-# Language FlexibleContexts #-}
2+
{-# Language Safe #-}
3+
{-# Language TypeFamilies #-}
34

45
module InputParser
5-
( TimingParameters(..)
6-
, parseTimingParameters
7-
) where
6+
( TimingParameters (..)
7+
, parseTimingParameters
8+
) where
89

9-
import Data.Char
10-
import Data.Foldable
11-
import Options.Applicative
12-
import Text.PrettyPrint.ANSI.Leijen (string)
13-
import TimingParameters
10+
import Data.Char
11+
import Data.Foldable
12+
import Data.String (IsString)
13+
import Options.Applicative
14+
import Text.PrettyPrint.ANSI.Leijen (string)
15+
import TimingParameters
1416

1517

1618
parseTimingParameters :: IO TimingParameters
1719
parseTimingParameters = customExecParser preferences $ info (helper <*> timingParameters) description
18-
where
19-
timingParameters =
20-
TimingParameters
21-
<$> fileSpec 'd' "data" "FASTA data file"
22-
<*> fileSpec 't' "tree" "Newick tree file"
23-
<*> fileSpec 'm' "tcm" "Transition Cost Matrix file with symbol alphabet"
24-
<*> fileSpec 'o' "output" "File path prefix of CSV prorder and postorder timings"
25-
<*> argSpec 'n' "leaves" "Leaf set lengths"
26-
<*> argSpec 'k' "lengths" "String lengths in range [0, 1]"
27-
<*> switch (fold [long "no-generate", help "Do NOT generate files, assume they exist"])
28-
29-
30-
fileSpec c s h = strOption $ fold [short c, long s, help h, metavar (toUpper <$> s <> "FILE")]
31-
argSpec c s h = option auto $ fold [short c, long s, help h]
32-
33-
description = fold
34-
[ fullDesc
35-
, headerDoc . Just $ string "\n Generate timing results for implied-align"
36-
, footerDoc $ Just mempty
37-
]
38-
39-
preferences = prefs $ fold [showHelpOnError, showHelpOnEmpty]
20+
where
21+
timingParameters =
22+
TimingParameters
23+
<$> fileSpec 'd' "data" "FASTA data file"
24+
<*> fileSpec 't' "tree" "Newick tree file"
25+
<*> fileSpec 'm' "tcm" "Transition Cost Matrix file with symbol alphabet"
26+
<*> fileSpec 'o' "output" "File path prefix of CSV prorder and postorder timings"
27+
<*> argSpec 'n' "leaves" "Leaf set lengths"
28+
<*> argSpec 'k' "lengths" "String lengths in range [0, 1]"
29+
<*> switch (fold [long "no-generate", help "Do NOT generate files, assume they exist"])
30+
31+
fileSpec :: IsString s => Char -> String -> String -> Parser s
32+
fileSpec c s h = strOption $ fold [short c, long s, help h, metavar (toUpper <$> s <> "FILE")]
33+
34+
argSpec :: Read a => Char -> String -> String -> Parser a
35+
argSpec c s h = option auto $ fold [short c, long s, help h]
36+
37+
description :: InfoMod a
38+
description = fold
39+
[ fullDesc
40+
, headerDoc . Just $ string "\n Generate timing results for implied-align"
41+
, footerDoc $ Just mempty
42+
]
43+
44+
preferences = prefs $ fold [showHelpOnError, showHelpOnEmpty]

0 commit comments

Comments
 (0)