From a3c4c78180d3374863dcd6807fefb0478df06725 Mon Sep 17 00:00:00 2001 From: Matei Adriel Date: Mon, 9 Dec 2019 14:20:39 +0200 Subject: [PATCH] fsharp(ygosim): feat: refactored to use lenses Signed-off-by: prescientmoon --- fsharp/ygosim/.paket/Paket.Restore.targets | 488 +++++++++++++++++++++ fsharp/ygosim/paket.dependencies | 2 +- fsharp/ygosim/paket.lock | 2 +- fsharp/ygosim/paket.references | 1 + fsharp/ygosim/src/Board.fs | 93 ++-- fsharp/ygosim/src/Card.fs | 31 ++ fsharp/ygosim/src/Program.fs | 9 +- fsharp/ygosim/ygosim.fsproj | 27 +- 8 files changed, 588 insertions(+), 65 deletions(-) create mode 100644 fsharp/ygosim/.paket/Paket.Restore.targets create mode 100644 fsharp/ygosim/paket.references diff --git a/fsharp/ygosim/.paket/Paket.Restore.targets b/fsharp/ygosim/.paket/Paket.Restore.targets new file mode 100644 index 0000000..8cb5986 --- /dev/null +++ b/fsharp/ygosim/.paket/Paket.Restore.targets @@ -0,0 +1,488 @@ + + + + + + + $(MSBuildAllProjects);$(MSBuildThisFileFullPath) + + $(MSBuildVersion) + 15.0.0 + false + true + + true + $(MSBuildThisFileDirectory) + $(MSBuildThisFileDirectory)..\ + $(PaketRootPath)paket-files\paket.restore.cached + $(PaketRootPath)paket.lock + classic + proj + assembly + native + /Library/Frameworks/Mono.framework/Commands/mono + mono + + + $(PaketRootPath)paket.bootstrapper.exe + $(PaketToolsPath)paket.bootstrapper.exe + $([System.IO.Path]::GetDirectoryName("$(PaketBootStrapperExePath)"))\ + + "$(PaketBootStrapperExePath)" + $(MonoPath) --runtime=v4.0.30319 "$(PaketBootStrapperExePath)" + + + True + + + False + + $(BaseIntermediateOutputPath.TrimEnd('\').TrimEnd('\/')) + + + + + + + + + $(PaketRootPath)paket + $(PaketToolsPath)paket + + + + + + $(PaketRootPath)paket.exe + $(PaketToolsPath)paket.exe + + + + + + <_DotnetToolsJson Condition="Exists('$(PaketRootPath)/.config/dotnet-tools.json')">$([System.IO.File]::ReadAllText("$(PaketRootPath)/.config/dotnet-tools.json")) + <_ConfigContainsPaket Condition=" '$(_DotnetToolsJson)' != ''">$(_DotnetToolsJson.Contains('"paket"')) + <_ConfigContainsPaket Condition=" '$(_ConfigContainsPaket)' == ''">false + + + + + + + + + + + <_PaketCommand>dotnet paket + + + + + + $(PaketToolsPath)paket + $(PaketBootStrapperExeDir)paket + + + paket + + + + + <_PaketExeExtension>$([System.IO.Path]::GetExtension("$(PaketExePath)")) + <_PaketCommand Condition=" '$(_PaketCommand)' == '' AND '$(_PaketExeExtension)' == '.dll' ">dotnet "$(PaketExePath)" + <_PaketCommand Condition=" '$(_PaketCommand)' == '' AND '$(OS)' != 'Windows_NT' AND '$(_PaketExeExtension)' == '.exe' ">$(MonoPath) --runtime=v4.0.30319 "$(PaketExePath)" + <_PaketCommand Condition=" '$(_PaketCommand)' == '' ">"$(PaketExePath)" + + + + + + + + + + + + + + + + + + + + + true + $(NoWarn);NU1603;NU1604;NU1605;NU1608 + false + true + + + + + + + + + $([System.IO.File]::ReadAllText('$(PaketRestoreCacheFile)')) + + + + + + + $([System.Text.RegularExpressions.Regex]::Split(`%(Identity)`, `": "`)[0].Replace(`"`, ``).Replace(` `, ``)) + $([System.Text.RegularExpressions.Regex]::Split(`%(Identity)`, `": "`)[1].Replace(`"`, ``).Replace(` `, ``)) + + + + + %(PaketRestoreCachedKeyValue.Value) + %(PaketRestoreCachedKeyValue.Value) + + + + + true + false + true + + + + + true + + + + + + + + + + + + + + + + + + + $(PaketIntermediateOutputPath)\$(MSBuildProjectFile).paket.references.cached + + $(MSBuildProjectFullPath).paket.references + + $(MSBuildProjectDirectory)\$(MSBuildProjectName).paket.references + + $(MSBuildProjectDirectory)\paket.references + + false + true + true + references-file-or-cache-not-found + + + + + $([System.IO.File]::ReadAllText('$(PaketReferencesCachedFilePath)')) + $([System.IO.File]::ReadAllText('$(PaketOriginalReferencesFilePath)')) + references-file + false + + + + + false + + + + + true + target-framework '$(TargetFramework)' or '$(TargetFrameworks)' files @(PaketResolvedFilePaths) + + + + + + + + + + + false + true + + + + + + + + + + + $([System.String]::Copy('%(PaketReferencesFileLines.Identity)').Split(',').Length) + $([System.String]::Copy('%(PaketReferencesFileLines.Identity)').Split(',')[0]) + $([System.String]::Copy('%(PaketReferencesFileLines.Identity)').Split(',')[1]) + $([System.String]::Copy('%(PaketReferencesFileLines.Identity)').Split(',')[4]) + $([System.String]::Copy('%(PaketReferencesFileLines.Identity)').Split(',')[5]) + + + %(PaketReferencesFileLinesInfo.PackageVersion) + All + runtime + runtime + true + true + + + + + $(PaketIntermediateOutputPath)/$(MSBuildProjectFile).paket.clitools + + + + + + + + + $([System.String]::Copy('%(PaketCliToolFileLines.Identity)').Split(',')[0]) + $([System.String]::Copy('%(PaketCliToolFileLines.Identity)').Split(',')[1]) + + + %(PaketCliToolFileLinesInfo.PackageVersion) + + + + + + + + + + false + + + + + + <_NuspecFilesNewLocation Include="$(PaketIntermediateOutputPath)\$(Configuration)\*.nuspec"/> + + + + + + $(MSBuildProjectDirectory)/$(MSBuildProjectFile) + true + false + true + false + true + false + true + false + true + $(PaketIntermediateOutputPath)\$(Configuration) + $(PaketIntermediateOutputPath) + + + + <_NuspecFiles Include="$(AdjustedNuspecOutputPath)\*.$(PackageVersion.Split(`+`)[0]).nuspec"/> + + + + + + + + + + + + + + + + + + + + + diff --git a/fsharp/ygosim/paket.dependencies b/fsharp/ygosim/paket.dependencies index b8fd200..0e96184 100644 --- a/fsharp/ygosim/paket.dependencies +++ b/fsharp/ygosim/paket.dependencies @@ -2,4 +2,4 @@ source https://api.nuget.org/v3/index.json storage: none framework: netcore3.0, netstandard2.0, netstandard2.1 -nuget FSharpPlus 1.0.0 \ No newline at end of file +nuget FSharpPlus 1.1.0-CI00252 \ No newline at end of file diff --git a/fsharp/ygosim/paket.lock b/fsharp/ygosim/paket.lock index 9aab55d..f631d08 100644 --- a/fsharp/ygosim/paket.lock +++ b/fsharp/ygosim/paket.lock @@ -3,5 +3,5 @@ RESTRICTION: || (== netcoreapp3.0) (== netstandard2.0) (== netstandard2.1) NUGET remote: https://api.nuget.org/v3/index.json FSharp.Core (4.7) - FSharpPlus (1.0) + FSharpPlus (1.1.0-CI00252) FSharp.Core (>= 4.3.4) diff --git a/fsharp/ygosim/paket.references b/fsharp/ygosim/paket.references new file mode 100644 index 0000000..4e184f6 --- /dev/null +++ b/fsharp/ygosim/paket.references @@ -0,0 +1 @@ +FSharpPlus \ No newline at end of file diff --git a/fsharp/ygosim/src/Board.fs b/fsharp/ygosim/src/Board.fs index 8f44e03..4240a6f 100644 --- a/fsharp/ygosim/src/Board.fs +++ b/fsharp/ygosim/src/Board.fs @@ -1,5 +1,7 @@ module Board +open FSharpPlus.Lens + module Side = open Card.Card @@ -10,6 +12,13 @@ module Side = graveyard: CardInstance<'s> list deck: CardInstance<'s> list } + module Side = + let inline field f side = f side.field <&> fun v -> { side with field = v } + let inline monsters f side = f side.monsters <&> fun v -> { side with monsters = v } + let inline spells f side = f side.spells <&> fun v -> { side with spells = v } + let inline graveyard f side = f side.graveyard <&> fun v -> { side with graveyard = v } + let inline deck f side = f side.deck <&> fun v -> { side with deck = v } + let emptySide = { field = None monsters = [] @@ -33,6 +42,13 @@ module Player = hand: CardInstance<'s> list state: PlayerState } + module Player = + let inline lifePoints f player = f player.lifePoints <&> fun v -> { player with lifePoints = v } + let inline side f player = f player.side <&> fun v -> { player with side = v } + let inline hand f player = f player.hand <&> fun v -> { player with hand = v } + let inline state f player = f player.state <&> fun v -> { player with state = v } + let inline deck f player = (side << Side.deck) f player + let initialPlayer lp = { lifePoints = lp side = emptySide @@ -50,14 +66,14 @@ module Turn = | Main2 | End - let nextPhase (previous: Phase) (turn: int) = - match previous with - | Draw -> (Standby, turn) - | Standby -> (Main1, turn) - | Main1 -> (Battle, turn) - | Battle -> (Main2, turn) - | Main2 -> (End, turn) - | End -> (Draw, turn + 1) + let nextPhase (turn, phase) = + match phase with + | Draw -> (turn, Standby) + | Standby -> (turn, Main1) + | Main1 -> (turn, Battle) + | Battle -> (turn, Main2) + | Main2 -> (turn, End) + | End -> (turn + 1, Draw) module Board = open Turn @@ -67,8 +83,18 @@ module Board = and Board = { players: Player * Player - turn: int - phase: Phase } + moment: int * Phase } + + module Board = + let inline players f board = f board.players <&> fun v -> { board with players = v } + let inline moment f board = f board.moment <&> fun v -> { board with moment = v } + + let inline turn f board = (moment << _1) f board + let inline phase f board = (moment << _2) f board + + let inline currentPlayer f board = + if (view turn board) % 2 = 0 then (players << _2) f board + else (players << _1) f board type Card = Card.Card @@ -82,13 +108,13 @@ module Board = let emptyBoard = { players = (Player.initialPlayer 8000, Player.initialPlayer 8000) - turn = 0 - phase = Draw } + moment = 0, Draw } module Game = open Board open Turn open Player + open Side type PlayerAction = | Pass @@ -97,46 +123,23 @@ module Game = | Activate | Set - // let canDoInitialDraw (board: Board) = - let draw (player: Player) = match player.side.deck with - | [] -> { player with state = Lost "deckout" } + | [] -> player |> Player.state .-> Lost "deckout" | card :: deck -> - { player with - hand = card :: player.hand - side = { player.side with deck = deck } } + let hand = card :: player.hand + + player + |> Player.hand .-> hand + |> Player.deck .-> deck // Player is the last arg to be able to use this with the withCurrentPlayer function - let toDeckBottom (card: CardInstance) (player: Player) = - { player with side = { player.side with deck = card :: player.side.deck } } - - let currentPlayer (board: Board) = - let (first, second) = board.players - - if board.turn % 2 = 0 then first - else second - - let withCurrentPlayer callback board = - let (first, second) = board.players - - let players = - if board.turn % 2 = 0 then (callback first, second) - else (first, callback second) - - { board with players = players } - + let toDeckBottom (card: CardInstance) (player: Player) = over Player.deck (fun d -> card :: d) player let processTurn (board: Board) = - match board.phase with - | Draw -> withCurrentPlayer draw board + match board ^. Board.phase with + | Draw -> over Board.currentPlayer draw board | _ -> board - let doTurn (board: Board) = - let newBoard = processTurn board - let (phase, turn) = nextPhase newBoard.phase newBoard.turn - - { newBoard with - turn = turn - phase = phase } + let doTurn (board: Board) = over Board.moment nextPhase <| processTurn board diff --git a/fsharp/ygosim/src/Card.fs b/fsharp/ygosim/src/Card.fs index e74cd19..960d898 100644 --- a/fsharp/ygosim/src/Card.fs +++ b/fsharp/ygosim/src/Card.fs @@ -1,5 +1,6 @@ module Card +open FSharpPlus.Lens module Effect = type Condition<'s> = 's -> bool @@ -8,6 +9,10 @@ module Effect = { condition: Condition<'s> resolution: 's -> 's } + module Action = + let inline condition f action = f action.condition <&> fun c -> { action with condition = c } + let inline resolution f action = f action.resolution <&> fun r -> { action with resolution = r } + type EffectType = | Trigger | Ignition @@ -17,6 +22,11 @@ module Effect = resolve: Action<'s> _type: EffectType } + module Effect = + let inline cost f effect = f effect.cost <&> fun c -> { effect with cost = c } + let inline resolve f effect = f effect.resolve <&> fun r -> { effect with resolve = r } + let inline _type f effect = f effect._type <&> fun t -> { effect with _type = t } + module Card = open Effect @@ -26,6 +36,11 @@ module Card = text: string effects: Effect<'s> list } + module BaseCard = + let inline name f card = f card.name <&> fun v -> { card with name = v } + let inline text f card = f card.text <&> fun v -> { card with text = v } + let inline effects f card = f card.effects <&> fun v -> { card with effects = v } + type SpellCardType = | NormalSpell | Field @@ -78,9 +93,15 @@ module Card = type SpellCardDetails = { spellType: SpellCardType } + module SpellCardDetails = + let inline spellType f card = f card.spellType <&> fun v -> { card with spellType = v } + type TrapCardDetails = { trapType: TrapCardType } + module TrapCardDetails = + let inline trapType f card = f card.trapType <&> fun v -> { card with trapType = v } + type MonsterCardDetails = { attack: int @@ -88,12 +109,22 @@ module Card = attribute: Attribute level: int } + module MonsterCardDetails = + let inline attack f card = f card.attack <&> fun v -> { card with attack = v } + let inline trapType f card = f card.defense <&> fun v -> { card with defense = v } + let inline attribute f card = f card.attribute <&> fun v -> { card with attribute = v } + let inline level f card = f card.level <&> fun v -> { card with level = v } + type Card<'s> = | Monster of BaseCard<'s> * MonsterCardDetails | Spell of BaseCard<'s> * SpellCardDetails | Trap of BaseCard<'s> * TrapCardDetails + module Card = + let inline baseCard f card = _1 f card + let inline cardDetails f card = _2 f card + // TODO: actually make this do what its supposed to type CardInstance<'s> = Card<'s> diff --git a/fsharp/ygosim/src/Program.fs b/fsharp/ygosim/src/Program.fs index 55c7546..83ed97f 100644 --- a/fsharp/ygosim/src/Program.fs +++ b/fsharp/ygosim/src/Program.fs @@ -1,14 +1,15 @@ module Main = - open Board + open FSharpPlus.Lens + open Board.Board + open Board.Game open Card - open Game [] let main _ = - let board = Board.emptyBoard + let board = emptyBoard let sampleCard = Card.Spell ({name= "sampleCard"; text="something"; effects = []}, {spellType = Card.ContinuosSpell}) - let secondBoard = withCurrentPlayer <| Game.toDeckBottom sampleCard <| board + let secondBoard = over Board.currentPlayer <| toDeckBottom sampleCard <| board printfn "%A" secondBoard diff --git a/fsharp/ygosim/ygosim.fsproj b/fsharp/ygosim/ygosim.fsproj index 607de4c..740adef 100644 --- a/fsharp/ygosim/ygosim.fsproj +++ b/fsharp/ygosim/ygosim.fsproj @@ -1,14 +1,13 @@ - - - - Exe - netcoreapp3.0 - - - - - - - - - + + + + Exe + netcoreapp3.0 + + + + + + + + \ No newline at end of file