M readme.org => readme.org +81 -14
@@ 42,22 42,9 @@ Weapons have damage dice and stuff, armour has armour class.
**** Model Name
**** Model Goal
-**** import JSON
**** fromJson should return an Either CharParseError Character
*** Doing
-**** WAIT Model Foci
-
-This is an interesting one, similar to equipment. There's a set of already-known possible foci, but GMs may make their own so we need to be able to add foci too.
-
-I'm thinking that we can have a list of /possible foci/ in the json file, and a single set too.
-
-The UI could be interesting. I think when selecting, we should see a list of foci in a panel on the right hand side, separate from the main body of the list.
-
-**** TODO export json
-
-This is likely just a button which opens a window which lets you copy out raw json representing your character.
-
-We need the whole character passed into the component, but displaying it should be relatively easy.
+**** Display Possible Foci
*** Done
**** DONE save sheet on update
@@ 131,3 118,83 @@ I won't be automating the setting of skills based on these, so that should also
This is basically gonna be a big old list.
Is it best to make a thing called a Background, and then make them into a list? I think so - I'm not sure there's value in having Backgrounds as a sum type.
+**** import JSON
+**** TODO export json
+
+This is likely just a button which opens a window which lets you copy out raw json representing your character.
+
+We need the whole character passed into the component, but displaying it should be relatively easy.
+**** WAIT Model Foci
+
+This is an interesting one, similar to equipment. There's a set of already-known possible foci, but GMs may make their own so we need to be able to add foci too.
+
+I'm thinking that we can have a list of /possible foci/ in the json file, and a single set too.
+
+The UI could be interesting. I think when selecting, we should see a list of foci in a panel on the right hand side, separate from the main body of the list.
+***** bug: disappearing foci
+
+loading foci doesn't appear to be working:
+
+when adding a focus, it appears in the export list and in the data.json. When reloading the page, the new focus is still in the data.json but is not displayed in the export list.
+
+At no point is the focus added to the list of possible focuses.
+
+This suggests that the foci aren't loading properly, and that they're not being passed into the list of possible focuses properly.
+
+Ah - it probably doesn't help that I was half way through converting CharSheet.fromJson to returning an ~Either CharacterParseError Character~ when I stopped coding last time - should finish that up and see what's going on.
+
+#+begin_src shell :results output
+yarn spago build
+#+end_src
+
+#+RESULTS:
+
+It's a bit odd, getting the error
+
+#+begin_src
+
+ possibleFoci <- lmap FocusError $ sequence ( CF.fromJson <$> pfoci )
+
+ Could not match type
+
+ Either CharacterParseError
+
+ with type
+
+ Maybe
+
+#+end_src
+
+but the fromJson function is very specifically typed
+
+#+begin_src purescript
+fromJson :: A.Json -> Either CharacterParseError Character
+#+end_src
+
+which would suggest that things being Maybe would be an error, not visa versa?
+
+I might try and start it from scratch...
+
+yup, writing it from scratch got me there with only sensible error messages. Weird
+
+load error is something to do with the name...
+ok, we're still passing in an array.
+
+Okay, got it loading? but now fuck all else is working. It's not loading shit. Or throwing out errors when it doesn't load. We're getting a fresh boi every single time?
+
+debugging time.
+
+
+
+***** bug: not loading any character
+
+no parsing errors, so we're loading correctly.
+
+we stil r klg ~ui.query~, b mab it isn go wl?
+
+yup. wn pasg t Aff bk ou to t Aff runr so it ws g lost. wks nw
+
+
+***** bug: focus Zt n updt in rlti
+
+done
M spago.dhall => spago.dhall +12 -2
@@ 4,16 4,26 @@ You can edit this file as you like.
-}
{ name = "my-project"
, dependencies =
- [ "aff-promise"
- , "affjax"
+ [ "aff"
+ , "aff-promise"
, "argonaut"
+ , "arrays"
+ , "bifunctors"
, "console"
, "effect"
+ , "either"
+ , "foldable-traversable"
+ , "foreign-object"
, "halogen"
, "halogen-hooks"
+ , "halogen-subscriptions"
+ , "integers"
+ , "maybe"
+ , "prelude"
, "profunctor-lenses"
, "psci-support"
, "random"
+ , "tuples"
]
, packages = ./packages.dhall
, sources = [ "src/**/*.purs", "test/**/*.purs" ]
M src/CharSheet.purs => src/CharSheet.purs +48 -25
@@ 1,5 1,6 @@
module CharSheet
( Character(..)
+ , CharacterParseError(..)
, fresh
, fromJson
, toJsonString
@@ 8,10 9,12 @@ module CharSheet
, _background
, _class
, _xp
+ , _chosenFoci
, _possibleFoci
) where
import Prelude
+
import Beaker.HyperDrive as HD
import CharSheet.Attributes as CA
import CharSheet.Background (Background)
@@ 25,11 28,12 @@ import CharSheet.Focus.Default as FocusDefault
import CharSheet.XP as CX
import Data.Argonaut as A
import Data.Array as Array
-import Data.Either (Either(..))
+import Data.Bifunctor (lmap)
+import Data.Either (Either(..), note)
import Data.Int as I
import Data.Lens as L
import Data.Lens.Index (ix)
-import Data.Maybe (Maybe(..), maybe, maybe')
+import Data.Maybe (Maybe(..), maybe')
import Data.Traversable (sequence)
import Data.Tuple (Tuple(..))
import Effect.Aff (Aff, Error, error)
@@ 56,34 60,50 @@ fresh =
, possibleFoci: FocusDefault.foci
}
-fromJson :: A.Json -> Maybe Character
+data CharacterParseError
+ = FocusError CF.FocusParseError
+ | XPError
+ | ClassError
+ | AttributeError
+ | BackgroundError
+ | ChosenFocusError
+
+instance characterParseErrorShow :: Show CharacterParseError where
+ show (FocusError e) = "Unable to parse character, Focus Error: " <> show e
+ show XPError = "Unable to parse character XP"
+ show ClassError = "Unable to parse character Class"
+ show AttributeError = "Unable to parse character Attribute"
+ show BackgroundError = "Unable to parse character Background"
+ show ChosenFocusError = "Unable to parse character Chosen Focus"
+
+fromJson :: A.Json -> Either CharacterParseError Character
fromJson j = do
- x <- I.ceil <$> (L.preview (A._Object <<< ix "xp" <<< A._Number) j)
- cl <- CC.fromString $ L.view (A._Object <<< ix "class" <<< A._String) j
- str <- I.ceil <$> (L.preview (A._Object <<< ix "attributes" <<< A._Object <<< ix "str" <<< A._Number) j)
- dex <- I.ceil <$> (L.preview (A._Object <<< ix "attributes" <<< A._Object <<< ix "dex" <<< A._Number) j)
- con <- I.ceil <$> (L.preview (A._Object <<< ix "attributes" <<< A._Object <<< ix "con" <<< A._Number) j)
- int <- I.ceil <$> (L.preview (A._Object <<< ix "attributes" <<< A._Object <<< ix "int" <<< A._Number) j)
- wis <- I.ceil <$> (L.preview (A._Object <<< ix "attributes" <<< A._Object <<< ix "wis" <<< A._Number) j)
- cha <- I.ceil <$> (L.preview (A._Object <<< ix "attributes" <<< A._Object <<< ix "cha" <<< A._Number) j)
- bg <- (L.preview (A._Object <<< ix "background" <<< A._String) j)
+ x <- note XPError $ I.ceil <$> (L.preview (A._Object <<< ix "xp" <<< A._Number) j)
+ cl <- note ClassError $ CC.fromString $ L.view (A._Object <<< ix "class" <<< A._String) j
+ attributes <- lmap (const AttributeError) $ CA.fromJson j
+ bg <- (note BackgroundError $ L.preview (A._Object <<< ix "background" <<< A._String) j)
+ background <-
+ note
+ BackgroundError
+ ( Array.find
+ (\b -> (L.view CB._background b) == bg)
+ CB.backgrounds
+ )
let
- cfoci = (L.toArrayOf (A._Object <<< ix "chosenFoci" <<< A._JsonArray) j)
+ cfoci = (L.view (A._Object <<< ix "chosenFoci" <<< A._Array) j)
+ pfoci = (L.view (A._Object <<< ix "possibleFoci" <<< A._Array) j)
- pfoci = (L.toArrayOf (A._Object <<< ix "possibleFoci" <<< A._JsonArray) j)
+ possibleFoci <- lmap FocusError $ sequence (CF.fromJson <$> pfoci)
+ chosenFoci <- note ChosenFocusError (sequence $ CCF.fromJson <$> cfoci)
- background =
- Array.find
- (\b -> (L.view CB._background b) == bg)
- CB.backgrounds
pure
- $ { xp: CX.xp x
- , class: cl
- , attributes: CA.manual str dex con int wis cha
- , background
- , chosenFoci: maybe [] identity (sequence $ CCF.fromJson <$> cfoci)
- , possibleFoci: maybe [] identity (sequence $ CF.fromJson <$> pfoci)
- }
+ { xp: CX.xp x
+ , class: cl
+ , attributes
+ , background: Just background
+ , chosenFoci
+ , possibleFoci
+ }
toJson :: Character -> A.Json
toJson { xp: x, class: c, attributes: a, background: b, possibleFoci: pf } =
@@ 123,5 143,8 @@ _xp = L.lens _.xp $ _ { xp = _ }
_background :: L.Lens' Character (Maybe CB.Background)
_background = L.lens _.background $ _ { background = _ }
+_chosenFoci :: L.Lens' Character (Array ChosenFocus)
+_chosenFoci = L.lens _.chosenFoci $ _ { chosenFoci = _ }
+
_possibleFoci :: L.Lens' Character (Array Focus)
_possibleFoci = L.lens _.possibleFoci $ _ { possibleFoci = _ }
M src/CharSheet/Attributes.purs => src/CharSheet/Attributes.purs +28 -1
@@ 1,9 1,11 @@
-module CharSheet.Attributes (Attributes, isEmpty, manual, fresh, empty, modifier, _str, _dex, _con, _int, _wis, _cha, toJson) where
+module CharSheet.Attributes (Attributes, isEmpty, manual, fresh, empty, modifier, _str, _dex, _con, _int, _wis, _cha, toJson, fromJson, AttributeParseError) where
import Prelude
import Data.Argonaut as A
+import Data.Either (Either, note)
import Data.Int as I
import Data.Lens as L
+import Data.Lens.Index (ix)
import Data.Tuple (Tuple(..))
import Effect (Effect)
import Foreign.Object as Object
@@ 68,6 70,31 @@ modifier i
| i <= 17 = 1
| otherwise = 2
+data AttributeParseError
+ = Str
+ | Dex
+ | Con
+ | Int
+ | Wis
+ | Cha
+
+fromJson :: A.Json -> Either AttributeParseError Attributes
+fromJson j = do
+ str <- note Str $ I.ceil <$> (L.preview (A._Object <<< ix "attributes" <<< A._Object <<< ix "str" <<< A._Number) j)
+ dex <- note Dex $ I.ceil <$> (L.preview (A._Object <<< ix "attributes" <<< A._Object <<< ix "dex" <<< A._Number) j)
+ con <- note Con $ I.ceil <$> (L.preview (A._Object <<< ix "attributes" <<< A._Object <<< ix "con" <<< A._Number) j)
+ int <- note Int $ I.ceil <$> (L.preview (A._Object <<< ix "attributes" <<< A._Object <<< ix "int" <<< A._Number) j)
+ wis <- note Wis $ I.ceil <$> (L.preview (A._Object <<< ix "attributes" <<< A._Object <<< ix "wis" <<< A._Number) j)
+ cha <- note Cha $ I.ceil <$> (L.preview (A._Object <<< ix "attributes" <<< A._Object <<< ix "cha" <<< A._Number) j)
+ pure
+ { str
+ , dex
+ , con
+ , int
+ , wis
+ , cha
+ }
+
-- lenses
_str :: L.Lens' Attributes Int
_str = L.lens _.str $ _ { str = _ }
M src/CharSheet/Background.purs => src/CharSheet/Background.purs +4 -0
@@ 1,6 1,7 @@
module CharSheet.Background where
import Prelude
+
import Data.Argonaut as A
import Data.Lens as L
import Data.Tuple (Tuple(..))
@@ 8,6 9,9 @@ import Data.Tuple (Tuple(..))
newtype Background
= Background (Tuple String String)
+instance showBackground :: Show Background where
+ show (Background (Tuple x y)) = "Background: " <> x <> ", " <> y
+
_b :: L.Lens' Background (Tuple String String)
_b = L.lens getter setter
where
M src/CharSheet/Focus.purs => src/CharSheet/Focus.purs +19 -6
@@ 1,10 1,11 @@
module CharSheet.Focus where
import Prelude
+
import Data.Argonaut as A
+import Data.Either (Either, note)
import Data.Lens as L
import Data.Lens.Index (ix)
-import Data.Maybe (Maybe)
import Data.Tuple (Tuple(..))
import Foreign.Object as Object
@@ 15,6 16,18 @@ type Focus
, levelTwo :: String
}
+data FocusParseError
+ = NoName A.Json
+ | NoDescription
+ | NoLevelOne
+ | NoLevelTwo
+
+instance focusParseErrorShow :: Show FocusParseError where
+ show (NoName json) = "No name provided: " <> A.stringify json
+ show NoDescription = "No description provided"
+ show NoLevelOne = "No 'level one' description provided"
+ show NoLevelTwo = "No 'level two' description provided"
+
focus :: String -> String -> String -> String -> Focus
focus name description levelOne levelTwo =
{ name
@@ 27,12 40,12 @@ focus name description levelOne levelTwo =
_ObjectKey :: String -> L.Traversal' A.Json A.Json
_ObjectKey key = (A._Object <<< ix key)
-fromJson :: A.Json -> Maybe Focus
+fromJson :: A.Json -> Either FocusParseError Focus
fromJson json = do
- name <- L.preview (A._Object <<< ix "name" <<< A._String) json
- description <- L.preview (A._Object <<< ix "description" <<< A._String) json
- levelOne <- L.preview (_ObjectKey "levelOne" <<< A._String) json
- levelTwo <- L.preview (_ObjectKey "levelTwo" <<< A._String) json
+ name <- note (NoName json) $ L.preview (A._Object <<< ix "name" <<< A._String) json
+ description <- note NoDescription $ L.preview (A._Object <<< ix "description" <<< A._String) json
+ levelOne <- note NoLevelOne $ L.preview (_ObjectKey "levelOne" <<< A._String) json
+ levelTwo <- note NoLevelTwo $ L.preview (_ObjectKey "levelTwo" <<< A._String) json
pure
{ name
, description
M src/Main.purs => src/Main.purs +28 -13
@@ 1,12 1,13 @@
module Main where
import Prelude
+
import Beaker.HyperDrive as BHD
import CharSheet as C
+import Data.Bifunctor (lmap)
import Data.Either (Either(..))
-import Data.Maybe (Maybe(..))
import Effect (Effect)
-import Effect.Aff (Aff, attempt, launchAff_)
+import Effect.Aff (Aff, Error, attempt, launchAff_)
import Effect.Class (liftEffect)
import Effect.Console as Console
import Halogen as H
@@ 20,23 21,36 @@ entry = do
body <- HA.awaitBody
runUI Entry.component C.fresh body
+data MainError
+ = ReadFileError Error
+ | CharacterError C.CharacterParseError
+
main :: Effect Unit
main =
launchAff_ do
ui <- entry
- f' <- attempt $ BHD.readFileJSON "/data.json"
- c' <- case f' of
- Left _ -> do
- -- if there's no data.json, make one
+ f <- "/data.json" # BHD.readFileJSON >>> attempt >>> map (lmap ReadFileError)
+
+ let
+ c = do
+ file <- f
+ lmap CharacterError $ C.fromJson file
+
+ case c of
+ Right char -> do
+ liftEffect $ Console.logShow "Character Loaded"
+ liftEffect $ Console.logShow char
+ _ <- ui.query $ H.mkTell $ Entry.Load char
+ pure unit
+ Left (CharacterError e) -> do
+ liftEffect $ Console.logShow e
_ <- C.write C.fresh
- pure Nothing
- Right f -> do
- pure $ C.fromJson f
- _ <- case c' of
- Just c -> ui.query $ H.mkTell $ Entry.Load c
- Nothing -> do
+ pure unit
+ Left _ -> do
+ liftEffect $ Console.log "file error. Writing fresh"
_ <- C.write C.fresh
- pure Nothing
+ pure unit
+
_ <-
H.liftEffect
$ Event.subscribe ui.messages \(Entry.Save char) -> do
@@ 46,4 60,5 @@ main =
Left e -> liftEffect $ Console.logShow e
Right _ -> pure unit
pure unit
+
liftEffect $ Console.logShow "Done"
M src/UI/CharacterSheet.purs => src/UI/CharacterSheet.purs +0 -3
@@ 37,7 37,6 @@ _attributes = Proxy :: Proxy "attributes"
_background = Proxy :: Proxy "background"
-_possibleFoci = Proxy :: Proxy "possibleFoci"
component :: forall m. MonadEffect m => H.Component Query Input Message m
component =
@@ 56,8 55,6 @@ component =
background = L.view C._background char
- possibleFoci = L.view C._possibleFoci char
-
save = do
c <- Hooks.get charID
Hooks.raise outputToken $ Save c
M src/UI/Entry.purs => src/UI/Entry.purs +27 -4
@@ 1,7 1,10 @@
module UI.Entry where
import Prelude
+
import CharSheet as C
+import CharSheet.ChosenFocus as ChosenFocus
+import CharSheet.Focus as Focus
import Data.Lens as L
import Data.Maybe (Maybe(..))
import Data.Tuple.Nested ((/\))
@@ 43,14 46,15 @@ component =
Hooks.raise t.outputToken $ Save c
Hooks.tell t.slotToken _charSheet unit (UCh.Set c)
Hooks.tell t.slotToken _exportBox unit (ExportBox.SetCharacter c)
- Hooks.captures {} Hooks.useTickEffect do
- liftEffect $ Console.log "re-rendering"
- pure Nothing
+ Hooks.tell t.slotToken _possibleFoci unit (PossibleFoci.SetFoci (L.view C._possibleFoci c))
+
Hooks.useQuery t.queryToken \x -> case x of
Load c s -> do
+ liftEffect $ Console.logShow c
Hooks.modify_ charId \_ -> c
updateCharacter c
pure $ Just s
+
let
possibleFoci = L.view C._possibleFoci char
@@ 59,6 63,23 @@ component =
importCharacter = case _ of
ImportBox.ImportCharacter c -> updateCharacter c
+
+ addPossibleFocus = case _ of
+ PossibleFoci.AddFocus f -> do
+ updateCharacter (L.over C._possibleFoci (\fs -> fs <> [ f ]) char)
+ PossibleFoci.ChooseFocus f -> do
+ updateCharacter
+ ( L.over
+ C._chosenFoci
+ ( \cf ->
+ let
+ newFocus = ChosenFocus.chosenFocus (L.view Focus._name f) 1
+ in
+ cf <> [ newFocus ]
+ )
+ char
+ )
+ pure unit
Hooks.pure do
HH.div
[ Util.classes [ "grid", "grid-cols-4" ] ]
@@ 67,7 88,9 @@ component =
[ HH.slot _charSheet unit UCh.component char requestSave ]
, HH.div
[ Util.classes [ "col-span-1", "flex", "flex-col", "pr-4" ] ]
- [ HH.div [] [ HH.slot_ _possibleFoci unit PossibleFoci.component possibleFoci ]
+ [ HH.div
+ []
+ [ HH.slot _possibleFoci unit PossibleFoci.component possibleFoci addPossibleFocus ]
, HH.div
[ Util.classes [ "mb-4" ] ]
[ HH.slot _importBox unit ImportBox.component unit importCharacter ]
M src/UI/Foci/PossibleList.purs => src/UI/Foci/PossibleList.purs +36 -5
@@ 1,11 1,17 @@
module UI.Foci.PossibleList where
import Prelude
+
import CharSheet.Focus as CF
import Data.Lens as L
+import Data.Maybe (Maybe(..))
+import Data.Tuple.Nested ((/\))
import Halogen as H
import Halogen.HTML as HH
+import Halogen.HTML.Events as HE
import Halogen.Hooks as Hooks
+import Type.Proxy (Proxy(..))
+import UI.Foci.PossibleList.Add as Add
-- list the possible foci so the user can select one.
type Input
@@ 13,15 19,40 @@ type Input
data Message
= ChooseFocus CF.Focus
+ | AddFocus CF.Focus
+
+data Query s
+ = SetFoci (Array CF.Focus) s
-type Slot s
- = forall q. H.Slot q Message s
+_addFocus = Proxy :: Proxy "addFocus"
focus :: forall w i. CF.Focus -> HH.HTML w i
focus f = HH.div [] [ HH.h1_ [ HH.text (L.view CF._name f) ] ]
-component :: forall q m. H.Component q Input Message m
+component :: forall m. H.Component Query Input Message m
component =
- Hooks.component \_ possibleFoci -> Hooks.do
+ Hooks.component \t possibleFoci -> Hooks.do
+ adding /\ addingId <- Hooks.useState false
+ foci /\ fociId <- Hooks.useState possibleFoci
+
+ Hooks.useQuery t.queryToken case _ of
+ SetFoci fs s -> do
+ Hooks.modify_ fociId (const fs)
+ pure $ Just s
+ let
+ toggleAdding = \_ -> Hooks.modify_ addingId not
+
+ addFocus = case _ of
+ Add.AddFocus f -> do
+ Hooks.raise t.outputToken $ AddFocus f
+ Hooks.modify_ addingId not
+
Hooks.pure do
- HH.div [] (focus <$> possibleFoci)
+ HH.div
+ []
+ [ HH.div [] (focus <$> foci)
+ , if adding then
+ HH.slot _addFocus unit Add.component unit addFocus
+ else
+ HH.button [ HE.onClick toggleAdding ] [ HH.text "add focus" ]
+ ]
A src/UI/Foci/PossibleList/Add.purs => src/UI/Foci/PossibleList/Add.purs +59 -0
@@ 0,0 1,59 @@
+module UI.Foci.PossibleList.Add where
+
+import Prelude
+import CharSheet.Focus as CF
+import Data.Tuple.Nested ((/\))
+import Halogen as H
+import Halogen.HTML as HH
+import Halogen.HTML.Events as HE
+import Halogen.HTML.Properties as HP
+import Halogen.Hooks as Hooks
+import UI.Util as Util
+
+data Message
+ = AddFocus CF.Focus
+
+component :: forall q i m. H.Component q i Message m
+component =
+ Hooks.component \t _ -> Hooks.do
+ name /\ nameId <- Hooks.useState ""
+ description /\ descriptionId <- Hooks.useState ""
+ levelOne /\ levelOneId <- Hooks.useState ""
+ levelTwo /\ levelTwoId <- Hooks.useState ""
+ let
+ setName = \n -> Hooks.modify_ nameId (const n)
+
+ setDesc = \d -> Hooks.modify_ descriptionId (const d)
+
+ setLvl1 = \l -> Hooks.modify_ levelOneId (const l)
+
+ setLvl2 = \l -> Hooks.modify_ levelTwoId (const l)
+
+ submit = \_ -> Hooks.raise t.outputToken $ AddFocus (CF.focus name description levelOne levelTwo)
+ Hooks.pure do
+ HH.div
+ [ Util.classes [ "flex", "flex-col" ] ]
+ [ HH.input
+ [ HP.value name
+ , HP.placeholder "name"
+ , HE.onValueChange setName
+ ]
+ , HH.textarea
+ [ HP.value description
+ , HP.placeholder "description"
+ , HE.onValueChange setDesc
+ ]
+ , HH.textarea
+ [ HP.value levelOne
+ , HP.placeholder "Level One"
+ , HE.onValueChange setLvl1
+ ]
+ , HH.textarea
+ [ HP.value levelTwo
+ , HP.placeholder "Level Two"
+ , HE.onValueChange setLvl2
+ ]
+ , HH.button
+ [ HE.onClick submit ]
+ [ HH.text "submit focus" ]
+ ]
M src/UI/ImportExport/ImportBox.purs => src/UI/ImportExport/ImportBox.purs +3 -2
@@ 36,8 36,9 @@ component =
-- json into char
-- raise character
case C.fromJson j of
- Nothing -> Hooks.modify_ parseErrorId $ const $ Just (CharacterDecodeError "unable to parse into a Character")
- Just c -> Hooks.raise t.outputToken (ImportCharacter c)
+ -- TODO: use error correctly
+ Left _ -> Hooks.modify_ parseErrorId $ const $ Just (CharacterDecodeError "unable to parse into a Character")
+ Right c -> Hooks.raise t.outputToken (ImportCharacter c)
Hooks.pure do
HH.div
[ Util.classes [ "border-2", "border-black", "flex", "flex-col", "justify-items-center", "p-4" ] ]