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
|
{-# LANGUAGE RecordWildCards #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Ormolu.Fixity.PrinterSpec (spec) where
import Data.List (intercalate)
import Data.List.NonEmpty qualified as NE
import Data.Map.Strict qualified as Map
import Data.Text qualified as T
import Distribution.ModuleName (ModuleName)
import Distribution.ModuleName qualified as ModuleName
import Distribution.Types.PackageName (PackageName, mkPackageName)
import Ormolu.Fixity
import Ormolu.Fixity.Parser
import Ormolu.Fixity.Printer
import Test.Hspec
import Test.Hspec.Megaparsec
import Test.QuickCheck
instance Arbitrary FixityOverrides where
arbitrary =
FixityOverrides . Map.fromList
<$> listOf ((,) <$> genOperator <*> genFixityInfo)
where
genOperator =
OpName . T.pack <$> oneof [genNormalOperator, genIdentifier]
genNormalOperator =
listOf1 (scaleDown arbitrary `suchThat` isOperatorConstituent)
genIdentifier = do
x <- arbitrary `suchThat` isIdentifierFirstChar
xs <- listOf1 (scaleDown arbitrary `suchThat` isIdentifierConstituent)
return (x : xs)
genFixityInfo = do
fiDirection <-
elements
[ InfixL,
InfixR,
InfixN
]
fiPrecedence <- chooseInt (0, 9)
return FixityInfo {..}
instance Arbitrary ModuleReexports where
arbitrary = ModuleReexports . Map.fromListWith combine <$> listOf genReexport
where
combine x y = NE.sort (x <> y)
genReexport = do
exportingModule <- arbitrary
exports <- NE.sort . NE.fromList . getNonEmpty <$> scaleDown arbitrary
return (exportingModule, exports)
instance Arbitrary PackageName where
arbitrary =
mkPackageName
<$> listOf1 (scaleDown arbitrary `suchThat` isPackageNameConstituent)
instance Arbitrary ModuleName where
arbitrary =
ModuleName.fromString . intercalate "." <$> scaleDown (listOf1 genSegment)
where
genSegment = do
x <- arbitrary `suchThat` isModuleSegmentFirstChar
xs <- listOf (arbitrary `suchThat` isModuleSegmentConstituent)
return (x : xs)
scaleDown :: Gen a -> Gen a
scaleDown = scale (`div` 4)
spec :: Spec
spec = do
describe "parseFixityOverrides & printFixityOverrides" $
it "arbitrary fixity maps are printed and parsed back correctly" $
property $ \fixityOverrides moduleReexports ->
parseDotOrmolu "" (printDotOrmolu fixityOverrides moduleReexports)
`shouldParse` (fixityOverrides, moduleReexports)
|
