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