6653289 · typeable/elm-ui

git.iko.soy/typeable/elm-ui

remove old fuzzer

6653289Elm UI Automation7 years ago

tests-rendering/src/Testable/FuzzMain.elm.olddeleted−632

@@ -1,632 +0,0 @@

1−port module FuzzMain exposing (Model, Msg(..), PossibleAttributes, Stage(..), Testable, TestableElement(..), allIndividualTestables, allPossibilities, analyze, attr, availableAttributes, content, createContainer, createElement, generateTest, generateTests, heightFill, heightPx, heights, init, layout, main, possibleToList, runTest, styles, subscriptions, testableLayout, tests, update, view, viewResult, widthFill, widthPx, widths)

2−

3−{-| -}

4−

5−import AnimationFrame

6−import Color

7−import Dict exposing (Dict)

8−import Element

9−import Element.Background as Background

10−import Element.Border as Border

11−import Element.Font as Font

12−import Expect

13−import Fuzz

14−import Html exposing (Html)

15−import List.Extra

16−import Random

17−import Test

18−import Test.Runner

19−import Test.Runner.Failure

20−import Testable

21−import Tests exposing (Testable)

22−import Time exposing (Time)

23−

24−

25−init : ( Model Msg, Cmd Msg )

26−init =

27− ( { current = Nothing

28− , upcoming =

29− -- Tests.tests

30− []

31−

32− -- generateTests (Random.initialSeed 227852860) 1

33− , finished = []

34− , stage = BeginRendering

35− }

36− , Cmd.none

37− )

38−

39−

40−main : Program Never (Model Msg) Msg

41−main =

42− Html.program

43− { init = init

44− , view = view

45− , update = update

46− , subscriptions = subscriptions

47− }

48−

49−

50−type alias Model msg =

51− { current : Maybe (Testable msg)

52− , upcoming : List (Testable msg)

53− , finished : List (Testable msg)

54− , stage : Stage

55− }

56−

57−

58−type Msg

59− = NoOp

60− | Tick Time

61− | RefreshBoundingBox

62− (List

63− { id : String

64− , bbox : Testable.BoundingBox

65− , style : Testable.Style

66− }

67− )

68−

69−

70−type Stage

71− = Rendered

72− | BeginRendering

73− | GatherData

74− | Finished

75−

76−

77−runTest : Dict String Testable.Found -> Testable msg -> Testable msg

78−runTest boxes test =

79− let

80− tests =

81− Testable.toTest test.label boxes test.element

82−

83− seed =

84− Random.initialSeed 227852860

85−

86− results =

87− Testable.runTests seed (Debug.log "created Tests" tests)

88− |> Debug.log "run tests"

89− in

90− { test | results = Just results }

91−

92−

93−generateTests : Random.Seed -> Int -> List (Testable msg)

94−generateTests seed num =

95− if num <= 0 then

96− []

97−

98− else

99− let

100− ( testable, newSeed ) =

101− generateTest seed

102− in

103− testable :: generateTests newSeed (num - 1)

104−

105−

106−generateTest : Random.Seed -> ( Testable msg, Random.Seed )

107−generateTest seed =

108− testableLayout

109− |> Test.Runner.fuzz

110− |> flip Random.step seed

111− |> (\( ( val, shrinker ), newSeed ) -> ( val, seed ))

112−

113−

114−update : Msg -> Model Msg -> ( Model Msg, Cmd Msg )

115−update msg model =

116− case msg of

117− NoOp ->

118− ( model, Cmd.none )

119−

120− RefreshBoundingBox boxes ->

121− case model.current of

122− Nothing ->

123− ( { model | stage = Finished }

124− , Cmd.none

125− )

126−

127− Just current ->

128− let

129− toTuple box =

130− ( box.id, { style = box.style, bbox = box.bbox } )

131−

132− foundData =

133− boxes

134− |> List.map toTuple

135− |> Dict.fromList

136−

137− currentResults =

138− runTest foundData current

139− in

140− case model.upcoming of

141− [] ->

142− ( { model

143− | stage = Finished

144− , current = Nothing

145− , finished = currentResults :: model.finished

146− }

147− , Cmd.none

148− )

149−

150− newCurrent :: remaining ->

151− ( { model

152− | finished = currentResults :: model.finished

153− , stage = BeginRendering

154− }

155− , Cmd.none

156− )

157−

158− Tick time ->

159− case model.stage of

160− BeginRendering ->

161− case model.upcoming of

162− [] ->

163− ( { model | stage = Rendered }

164− , Cmd.none

165− )

166−

167− current :: remaining ->

168− ( { model

169− | stage = Rendered

170− , upcoming = remaining

171− , current = Just current

172− }

173− , Cmd.none

174− )

175−

176− Rendered ->

177− case model.current of

178− Nothing ->

179− ( { model | stage = Finished }

180− , Cmd.none

181− )

182−

183− Just test ->

184− ( { model | stage = GatherData }

185− , analyze (Testable.getIds test.element)

186− )

187−

188− _ ->

189− ( { model | stage = Rendered }

190− , Cmd.none

191− )

192−

193−

194−subscriptions : { a | stage : Stage } -> Sub Msg

195−subscriptions model =

196− Sub.batch

197− [ styles RefreshBoundingBox

198− , case model.stage of

199− BeginRendering ->

200− AnimationFrame.times Tick

201−

202− Rendered ->

203− AnimationFrame.times Tick

204−

205− _ ->

206− Sub.none

207− ]

208−

209−

210−port analyze : List String -> Cmd msg

211−

212−

213−port styles : (List { id : String, bbox : Testable.BoundingBox, style : Testable.Style } -> msg) -> Sub msg

214−

215−

216−view : Model Msg -> Html Msg

217−view model =

218− case model.current of

219− Nothing ->

220− if model.stage == Finished then

221− Element.layout [] <|

222− Element.column

223− [ Element.spacing 20

224− , Element.padding 20

225− , Element.width (Element.px 800)

226−

227− -- , Background.color Color.grey

228− ]

229− (List.map viewResult model.finished)

230−

231− else

232− Html.text "running?"

233−

234− Just current ->

235− Testable.render current.element

236−

237−

238−viewResult : Testable Msg -> Element.Element Msg

239−viewResult testable =

240− let

241− viewSingle result =

242− case result of

243− ( label, Nothing ) ->

244− Element.el

245− [ Background.color Color.green

246− , Font.color Color.white

247− , Element.paddingXY 20 10

248− , Element.alignLeft

249− , Border.rounded 3

250− ]

251− <|

252− Element.text (label ++ " - " ++ "Success!")

253−

254− ( label, Just { given, description, reason } ) ->

255− Element.row

256− [ Background.color Color.red

257− , Font.color Color.white

258− , Element.paddingXY 20 10

259− , Element.alignLeft

260− , Element.spacing 25

261− , Border.rounded 3

262− ]

263− [ Element.el [ Element.width Element.fill ] <| Element.text label

264−

265− -- , Element.el [ Element.width Element.fill ] <| Element.text description

266− , Element.el [ Element.width Element.fill ] <| Element.text (toString reason)

267− ]

268− in

269− Element.column

270− [ Border.width 1

271− , Border.color Color.lightGrey

272− , Element.padding 20

273− , Element.height Element.shrink

274− , Element.alignLeft

275− ]

276− [ Element.el [ Font.bold ] (Element.text testable.label)

277− , Element.column [ Element.alignLeft, Element.spacing 20 ]

278− (case testable.results of

279− Nothing ->

280− [ Element.text "no results" ]

281−

282− Just results ->

283− List.map viewSingle results

284− )

285− ]

286−

287−

288−{--}

289−type alias Testable msg =

290− { element : Testable.Element msg

291− , label : String

292− , results :

293− Maybe

294− (List

295− ( String

296− , Maybe

297− { given : Maybe String

298− , description : String

299− , reason : Test.Runner.Failure.Reason

300− }

301− )

302− )

303− }

304−

305−

306−attr tag label attr test =

307− Testable.Batch

308− [ Testable.Attr attr

309− , Testable.AttrTest

310− (\found ->

311− Test.test (tag ++ ": " ++ label) <|

312− \_ -> test found

313− )

314− ]

315−

316−

317−widthFill tag =

318− attr tag

319− "width fill"

320− (Element.width Element.fill)

321− (\context ->

322− let

323− spacePerPortion =

324− context.parent.bbox.width / toFloat (List.length context.siblings + 1)

325− in

326− Expect.equal spacePerPortion context.self.bbox.width

327− )

328−

329−

330−heightFill tag =

331− attr tag

332− "height fill"

333− (Element.height Element.fill)

334− (\context ->

335− let

336− spacePerPortion =

337− context.parent.bbox.height / toFloat (List.length context.siblings + 1)

338− in

339− Expect.equal spacePerPortion context.self.bbox.height

340− )

341−

342−

343−heightPx px tag =

344− attr tag

345− ("height at " ++ toString px ++ "px")

346− (Element.height (Element.px (round px)))

347− (\found ->

348− Expect.equal found.self.bbox.height px

349− )

350−

351−

352−widthPx px tag =

353− attr tag

354− ("width at " ++ toString px ++ "px")

355− (Element.width (Element.px (round px)))

356− (\found ->

357− Expect.equal found.self.bbox.width px

358− )

359−

360−

361−type alias PossibleAttributes msg =

362− { width : String -> Testable.Attr msg

363− , height : String -> Testable.Attr msg

364− }

365−

366−

367−possibleToList str { width, height } =

368− width str :: height str :: []

369−

370−

371−availableAttributes : { width : Float, height : Float } -> Fuzz.Fuzzer (PossibleAttributes msg)

372−availableAttributes bounds =

373− Fuzz.map2 PossibleAttributes

374− (Fuzz.oneOf

375− (List.map Fuzz.constant (widths bounds.width))

376− )

377− (Fuzz.oneOf

378− (List.map Fuzz.constant (heights bounds.height))

379− )

380−

381−

382−widths : Float -> List (String -> Testable.Attr msg)

383−widths width =

384− [ \tag ->

385− attr tag

386− (" with width at " ++ toString width ++ "px")

387− (Element.width (Element.px (round width)))

388− (\found ->

389− Expect.equal found.self.bbox.width width

390− )

391− , \tag ->

392− attr tag

393− " with width fill"

394− (Element.width Element.fill)

395− (\context ->

396− let

397− -- {-|

398− -- Calculation is

399− -- totalparentwidth - (paddingLeft ++ paddingRight)

400− -- minus widths of all the other children

401− -- -}

402− otherWidth =

403− -- Debug.log "width" <|

404− List.sum <|

405− -- Debug.log "widths" <|

406− List.map (\child -> child.bbox.width) context.siblings

407−

408− spacePerPortion =

409− context.parent.bbox.width - otherWidth

410− in

411− Expect.equal spacePerPortion context.self.bbox.width

412− )

413− ]

414−

415−

416−heights : Float -> List (String -> Testable.Attr msg)

417−heights height =

418− [ \tag ->

419− attr tag

420− (" with height at " ++ toString height ++ "px")

421− (Element.height (Element.px (round height)))

422− (\found ->

423− Expect.equal found.self.bbox.height height

424− )

425− , \tag ->

426− attr tag

427− " with height fill"

428− (Element.height Element.fill)

429− (\context ->

430− let

431− -- {-|

432− -- Calculation is

433− -- totalparentwidth - (paddingLeft ++ paddingRight)

434− -- minus widths of all the other children

435− -- -}

436− otherHeight =

437− List.sum <|

438− List.map (\child -> child.bbox.height) context.siblings

439−

440− spacePerPortion =

441− context.parent.bbox.height - otherHeight

442− in

443− Expect.equal spacePerPortion context.self.bbox.height

444− )

445− ]

446−

447−

448−content : Testable.Element msg

449−content =

450− Testable.El

451− [ Testable.Attr <| Element.width (Element.px 20)

452− , Testable.Attr <| Element.height (Element.px 20)

453− ]

454− Testable.Empty

455−

456−

457−tests : List (Testable msg)

458−tests =

459− [ { label = "Width/Height 200"

460− , results = Nothing

461− , element =

462− Testable.El

463− [ widthPx 200 "single element"

464− , heightPx 200 "single element"

465− ]

466− Testable.Empty

467− }

468− , { label = "Width Fill/Height Fill - 1"

469− , results = Nothing

470− , element =

471− Testable.El

472− [ widthFill "single element"

473− , heightFill "single element"

474− ]

475− <|

476− content

477− }

478− , { label = "Width Fill/Height Fill - 2"

479− , results = Nothing

480− , element =

481− Testable.El

482− [ widthFill "top element"

483− , heightFill "top element"

484− ]

485− <|

486− Testable.El

487− [ widthFill "embedded element"

488− , heightFill "embedded element"

489− ]

490− <|

491− content

492− }

493− , { label = "Row Width Fill/Height Fill"

494− , results = Nothing

495− , element =

496− Testable.Row

497− [ widthFill "on row"

498− , heightFill "on row"

499− ]

500− [ Testable.El

501− [ widthFill "row - 1"

502− , heightFill "row - 1"

503− ]

504− content

505− , Testable.El

506− [ widthFill "row - 2"

507− , heightFill "row - 2"

508− ]

509− content

510− , Testable.El

511− [ widthFill "row - 3"

512− , heightFill "row - 3"

513− ]

514− content

515− ]

516− }

517− ]

518−

519−

520−

521−{- Generating A Complete Test Suite

522−

523−-}

524−

525−

526−type TestableElement

527− = El

528− | Row

529− | Column

530−

531−

532−allIndividualTestables : List (Fuzz.Fuzzer TestableElement)

533−allIndividualTestables =

534− [ Fuzz.constant El

535− , Fuzz.constant Row

536− , Fuzz.constant Column

537− ]

538−

539−

540−testableLayout : Fuzz.Fuzzer (Testable msg)

541−testableLayout =

542− let

543− asTestable layout =

544− { element = layout

545− , label = "A Sweet Test"

546− , results = Nothing

547− }

548− in

549− Fuzz.map asTestable layout

550−

551−

552−layout : Fuzz.Fuzzer (Testable.Element msg)

553−layout =

554− Fuzz.map4 createContainer

555− (Fuzz.tuple3

556− ( availableAttributes { width = 20, height = 20 }

557− , availableAttributes { width = 20, height = 20 }

558− , availableAttributes { width = 20, height = 20 }

559− )

560− )

561− (availableAttributes { width = 200, height = 200 })

562− (Fuzz.oneOf allIndividualTestables)

563− (Fuzz.oneOf allIndividualTestables)

564−

565−

566−createElement : String -> TestableElement -> PossibleAttributes msg -> Testable.Element msg

567−createElement tag layout possibleAttrs =

568− let

569− attrs =

570− possibleToList tag possibleAttrs

571− in

572− case layout of

573− El ->

574− Testable.El attrs content

575−

576− Row ->

577− Testable.Row attrs

578− [ content

579− , content

580− , content

581− ]

582−

583− Column ->

584− Testable.Column attrs

585− [ content

586− , content

587− , content

588− ]

589−

590−

591−createContainer : ( PossibleAttributes msg, PossibleAttributes msg, PossibleAttributes msg ) -> PossibleAttributes msg -> TestableElement -> TestableElement -> Testable.Element msg

592−createContainer ( a1, a2, a3 ) possibleAttrs parent child =

593− let

594− attrs =

595− possibleToList "0" possibleAttrs

596− in

597− case parent of

598− El ->

599− Testable.El attrs (createElement "0-0" child a1)

600−

601− Row ->

602− Testable.Row attrs

603− [ createElement "0-0" child a1

604− , createElement "0-1" child a2

605− , createElement "0-2" child a3

606− ]

607−

608− Column ->

609− Testable.Column attrs

610− [ createElement "0-0" child a1

611− , createElement "0-1" child a2

612− , createElement "0-2" child a3

613− ]

614−

615−

616−{-| Given a list of a list of possibilities,

617−

618−choose once from each list.

619−

620− [ [width (px 100), width fill]

621− , [height (px 100), height fill]

622− ]

623− ->

624−

625− [ [width (px 100), height (px 100)]

626− , [width (px 100), height fill]

627− ]

628−

629−-}

630−allPossibilities : List (List a) -> List (List a)

631−allPossibilities =

632− List.Extra.cartesianProduct