245556c · elk · git.iko.soy

13import qualified AST.Type as T

14import qualified AST.Variable as V

15

16+

16instance Arbitrary V.Raw where

17instance Arbitrary V.Raw where

18+ arbitrary =

17− arbitrary = V.Raw <$> capVar

19+ V.Raw <$> capVar

20+

18− shrink (V.Raw v) = V.Raw <$> shrink v

21+ shrink (V.Raw v) =

22+ V.Raw <$> shrink v

23+

19

24

20instance Arbitrary L.Literal where

25instance Arbitrary L.Literal where

21 arbitrary =

26 arbitrary =

22 oneof

27 oneof

23− [ L.IntNum <$> arbitrary

28+ [ L.IntNum <$> arbitrary

24− , L.FloatNum <$> (arbitrary `suchThat` noE)

29+ , L.FloatNum <$> (arbitrary `suchThat` noE)

25− , L.Chr <$> arbitrary

30+ , L.Chr <$> arbitrary

26− -- This is too permissive

31+ -- This is too permissive

27− , L.Str <$> arbitrary

32+ , L.Str <$> arbitrary

28− -- Booleans aren't actually source syntax

33+ -- Booleans aren't actually source syntax

29− -- , Boolean <$> arbitrary

34+ -- , Boolean <$> arbitrary

30− ]

35+ ]

31−

36+

32− shrink lit =

37+ shrink literal =

33− case lit of

38+ case literal of

39+ L.IntNum int ->

34− L.IntNum n -> L.IntNum <$> shrink n

40+ L.IntNum <$> shrink int

41+

42+ L.FloatNum float ->

35− L.FloatNum f -> L.FloatNum <$> (filter noE . shrink $ f)

43+ L.FloatNum <$> filter noE (shrink float)

44+

45+ L.Chr char ->

36− L.Chr c -> L.Chr <$> shrink c

46+ L.Chr <$> shrink char

47+

48+ L.Str string ->

37− L.Str s -> L.Str <$> shrink s

49+ L.Str <$> shrink string

50+

51+ L.Boolean bool ->

38− L.Boolean b -> L.Boolean <$> shrink b

52+ L.Boolean <$> shrink bool

53+

39

54

40noE :: Double -> Bool

55noE :: Double -> Bool

56+noE =

41−noE = notElem 'e' . show

57+ notElem 'e' . show

58+

42

59

43genVector :: Int -> (Int -> Gen a) -> Gen [a]

60genVector :: Int -> (Int -> Gen a) -> Gen [a]

44−genVector n generator = do

61+genVector n generator =

45− len <- choose (0,n)

62+ do len <- choose (0,n)

46− let m = n `div` (len + 1)

63+ let m = n `div` (len + 1)

47− vectorOf len $ generator m

64+ vectorOf len $ generator m

48

65

49instance Arbitrary v => Arbitrary (P.Pattern v) where

66instance Arbitrary v => Arbitrary (P.Pattern v) where

50− arbitrary = sized pat

67+ arbitrary =

68+ sized pattern

51 where

69 where

52− pat :: (Arbitrary v) => Int -> Gen (P.Pattern v)

70+ pattern :: (Arbitrary v) => Int -> Gen (P.Pattern v)

53− pat n =

71+ pattern n =

54 oneof

72 oneof

55 [ pure P.Anything

73 [ pure P.Anything

56 , P.Var <$> lowVar

74 , P.Var <$> lowVar

57 , P.Record <$> (listOf1 lowVar)

75 , P.Record <$> (listOf1 lowVar)

58 , P.Literal <$> arbitrary

76 , P.Literal <$> arbitrary

59− , P.Alias <$> lowVar <*> pat (n-1)

77+ , P.Alias <$> lowVar <*> pattern (n-1)

60− , P.Data <$> arbitrary <*> genVector n pat

78+ , P.Data <$> arbitrary <*> genVector n pattern

61 ]

79 ]

62

80

63− shrink pat =

81+ shrink pattern =

64− case pat of

82+ case pattern of

65− P.Anything -> []

83+ P.Anything ->

66− P.Var v -> P.Var <$> shrinkWHead v

84+ []

85+

86+ P.Var var ->

87+ P.Var <$> consAndShrink var

88+

89+ P.Literal literal ->

67− P.Literal l -> P.Literal <$> shrink l

90+ P.Literal <$> shrink literal

68− P.Alias s p -> p : (P.Alias <$> shrinkWHead s <*> shrink p)

91+

92+ P.Alias alias pattern ->

93+ pattern : (P.Alias <$> consAndShrink alias <*> shrink pattern)

94+

95+ P.Data name patterns ->

69− P.Data s ps -> ps ++ (P.Data <$> shrink s <*> shrink ps)

96+ patterns ++ (P.Data <$> shrink name <*> shrink patterns)

97+

70− P.Record fs ->

98+ P.Record fields ->

71− P.Record <$> filter (all notNull) (filter notNull (shrink fs))

99+ P.Record <$> filter (all notNull) (filter notNull (shrink fields))

72− where

100+ where

73− notNull = not . null

101+ notNull = not . null

74−

102+

103+

75−shrinkWHead :: Arbitrary a => [a] -> [[a]]

104+consAndShrink :: Arbitrary a => [a] -> [[a]]

105+consAndShrink values =

106+ case values of

76−shrinkWHead [] = error "Should be nonempty"

107+ [] -> error "Should be nonempty"

77−shrinkWHead (x:xs) = (x:) <$> shrink xs

108+ x:xs -> (x:) <$> shrink xs

109+

78

110

79instance Arbitrary v => Arbitrary (T.Type v) where

111instance Arbitrary v => Arbitrary (T.Type v) where

80− arbitrary = sized tipe

112+ arbitrary =

113+ sized tipe

81 where

114 where

82 tipe :: Arbitrary v => Int -> Gen (T.Type v)

115 tipe :: Arbitrary v => Int -> Gen (T.Type v)

83 tipe n =

116 tipe n =

88 depthTipes = (:) <$> depthTipe <*> genVector n tipe

121 depthTipes = (:) <$> depthTipe <*> genVector n tipe

89 in

122 in

90 oneof

123 oneof

91− [ T.Lambda <$> depthTipe <*> depthTipe

124+ [ T.Lambda <$> depthTipe <*> depthTipe

92− , T.Var <$> lowVar

125+ , T.Var <$> lowVar

93− , T.Type <$> arbitrary

126+ , T.Type <$> arbitrary

94− , T.App <$> (T.Type <$> arbitrary) <*> depthTipes

127+ , T.App <$> (T.Type <$> arbitrary) <*> depthTipes

95− , T.Record <$> fields <*> pure Nothing

128+ , T.Record <$> fields <*> pure Nothing

96− , T.Record <$> fields1 <*> (Just . T.Var <$> lowVar)

129+ , T.Record <$> fields1 <*> (Just . T.Var <$> lowVar)

97− ]

130+ ]

98

131

99 shrink tipe =

132 shrink tipe =

100 case tipe of

133 case tipe of

134+ T.Lambda arg result ->

101− T.Lambda s t -> s : t : (T.Lambda <$> shrink s <*> shrink t)

135+ arg : result : (T.Lambda <$> shrink arg <*> shrink result)

136+

102− T.Var _ -> []

137+ T.Var _ ->

138+ []

139+

140+ T.Aliased v t ->

103− T.Aliased v t -> t : (T.Aliased v <$> shrink t)

141+ t : (T.Aliased v <$> shrink t)

142+

143+ T.Type name ->

104− T.Type v -> T.Type <$> shrink v

144+ T.Type <$> shrink name

145+

146+ T.App func args ->

105− T.App t ts -> t : ts ++ (T.App <$> shrink t <*> shrink ts)

147+ func : args ++ (T.App <$> shrink func <*> shrink args)

148+

149+ T.Record fields extension ->

106− T.Record fs t -> map snd fs ++ record

150+ map snd fields ++ record

107− where

151+ where

108− record =

152+ record =

109− case t of

153+ case extension of

154+ Nothing ->

110− Nothing -> T.Record <$> shrinkList shrinkField fs <*> pure Nothing

155+ T.Record <$> shrinkList shrinkField fields <*> pure Nothing

156+

111− Just _ ->

157+ Just _ ->

112− do fields <- filter (not . null) $ shrinkList shrinkField fs

158+ do fields' <- filter (not . null) $ shrinkList shrinkField fields

113− return $ T.Record fields t

159+ return $ T.Record fields' extension

114−

160+

115− shrinkField (n,t) = (,) <$> shrinkWHead n <*> shrink t

161+ shrinkField (name, tipe) =

162+ (,) <$> consAndShrink name <*> shrink tipe

163+

116

164

117lowVar :: Gen String

165lowVar :: Gen String

166+lowVar =

118−lowVar = notReserved $ (:) <$> lower <*> listOf varLetter

167+ notReserved $

119− where

120− lower = elements ['a'..'z']

168+ (:) <$> elements ['a'..'z'] <*> listOf varLetter

169+

121

170

122capVar :: Gen String

171capVar :: Gen String

172+capVar =

123−capVar = notReserved $ (:) <$> upper <*> listOf varLetter

173+ notReserved $

124− where

125− upper = elements ['A'..'Z']

174+ (:) <$> elements ['A'..'Z'] <*> listOf varLetter

175+

126

176

127varLetter :: Gen Char

177varLetter :: Gen Char

178+varLetter =

128−varLetter = elements $ ['a'..'z'] ++ ['A'..'Z'] ++ ['0'..'9'] ++ ['\'', '_']

179+ elements $ ['a'..'z'] ++ ['A'..'Z'] ++ ['0'..'9'] ++ ['\'', '_']

180+

129

181

130notReserved :: Gen String -> Gen String

182notReserved :: Gen String -> Gen String

183+notReserved string =

131−notReserved = flip exceptFor Parse.Helpers.reserveds

184+ string `exceptFor` Parse.Helpers.reserveds

185+

132

186

133exceptFor :: (Ord a) => Gen a -> [a] -> Gen a

187exceptFor :: (Ord a) => Gen a -> [a] -> Gen a

134−exceptFor g xs = g `suchThat` notAnX

188+exceptFor generator list =

189+ generator `suchThat` notInList

135 where

190 where

136− notAnX = flip Set.notMember xset

137− xset = Set.fromList xs

191+ set = Set.fromList list

192+ notInList x = Set.notMember x set