~sjm/builds-character

e29824743c898736e8842dd42620716ced7749bd — Sam Marshall 3 years ago 6c9f1cd
chore: use an Either for parsing the Character from JSON
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" ] ]