{-# LANGUAGE UnicodeSyntax, TemplateHaskell #-}-- | record a match to a tape which is serialisablemoduleSoccerFun.TapewhereimportPrelude.UnicodeimportData.DeriveTHimportData.BinaryimportSoccerFun.MatchControlimportSoccerFun.PlayerimportSoccerFun.TypesimportSoccerFun.FieldimportSoccerFun.GeometryimportSoccerFun.BallimportSoccerFun.RefereeActionimportControl.MonadinstanceBinaryMatchwhereputm=doput$team1mput$team2mput$theBallmput$theFieldmput$playingHalfmput$playingTimemput$scoremput$unittimemget=doteam1←getteam2←gettheBall←gettheField←getplayingHalf←getplayingTime←getscore←getunittime←getreturn$Match{team1=team1,team2=team2,theBall=theBall,theField=theField,theReferee=undefined,playingHalf=playingHalf,playingTime=playingTime,score=score,seed=undefined,unittime=unittime}instanceBinaryPlayerwhereputp=doput$playerIDpput$namepput$heightpput$pospput$speedpput$nosepput$skillspput$effectpput$staminapput$healthpget=doplayerID←getname←getheight←getpos←getspeed←getnose←getskills←geteffect←getstamina←gethealth←getreturn$Player{playerID=playerID,name=name,height=height,pos=pos,speed=speed,nose=nose,skills=skills,effect=effect,stamina=stamina,health=health,brain=undefined}$(derivemakeBinary''Half)$(derivemakeBinary''Field)$(derivemakeBinary''Position3D)$(derivemakeBinary''Ball)$(derivemakeBinary''BallState)$(derivemakeBinary''PlayerID)$(derivemakeBinary''Position)$(derivemakeBinary''Speed)$(derivemakeBinary''Skill)$(derivemakeBinary''PlayerEffect)$(derivemakeBinary''Success)$(derivemakeBinary''Speed3D)$(derivemakeBinary''FeintDirection)$(derivemakeBinary''RefereeAction)$(derivemakeBinary''PlayerAction)$(derivemakeBinary''Edge)$(derivemakeBinary''ATeam)$(derivemakeBinary''Reprimand)dataTape=Tape[Step]magic="SoccerFun tape"version="0.3.7"instanceBinaryTapewhereput(Tapesteps)=doputmagicputversionputstepsget=doletcheckMagicm=when(not$m≡magic)(error"This file does not contain a SoccerFun tape!")checkMagic=<<getletcheckVersionv=when(not$v≡version)(error$"Incompatible tape version: "⧺showv)checkVersion=<<getliftMTapegetrecordMatch∷Match→TaperecordMatchm=Tape$recordMatch'(([],[]),m)whererecordMatch'∷(([RefereeAction],[PlayerWithAction]),Match)→[(([RefereeAction],[PlayerWithAction]),Match)]recordMatch'=takeWhilematchRunning∘iterate(stepMatch∘snd)matchRunning(actions,match)=playingTimematch>0