ignore debug logs

.gitattributes

@@ -0,0 +1,2 @@
+*       text=auto
+*.hs    text eol=lf

.gitignore

@@ -22,4 +22,4 @@ cabal.project.local
 cabal.project.local~
 .HTF/
 .ghc.environment.*
-
+debug.log

CHANGELOG.md

@@ -0,0 +1,11 @@
+# Changelog for `pulsar`
+
+All notable changes to this project will be documented in this file.
+
+The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/),
+and this project adheres to the
+[Haskell Package Versioning Policy](https://pvp.haskell.org/).
+
+## Unreleased
+
+## 0.1.0.0 - YYYY-MM-DD

README.md

@@ -1,3 +1,13 @@
 # pulsar
 
-An ECS-driven Sci-Fi RPG to tool around in Haskell with
+An ECS-driven Sci-Fi RPG to tool around in Haskell with
+
+## Setup for Development
+
+Stack is the canoncial build tool for this project. 
+
+Use `stack setup` to configure your environment.
+
+### Hlint
+You can use a system hlint, or use `stack build hlint` to build the same one we use.
+

Setup.hs

@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain

app/Main.hs

@@ -0,0 +1,7 @@
+module Main (main) where
+
+import Lib
+import Overseer
+
+main :: IO ()
+main = undefined

package.yaml

@@ -0,0 +1,69 @@
+name:                pulsar
+version:             0.1.0.0
+git:                 "Rin/pulsar"
+license:             "CC-BY-SA-4.0"
+author:              "Rin"
+maintainer:          "rin@rin.systems"
+copyright:           "2023 Rin"
+
+extra-source-files:
+- CHANGELOG.md
+
+# Metadata used when publishing your package
+# synopsis:            Short description of your package
+# category:            Web
+
+# To avoid duplicated efforts in documentation and dealing with the
+# complications of embedding Haddock markup inside cabal files, it is
+# common to point users to the README.md file.
+description:         Please see the README at <https://gitea.treehouse.systems/Rin/pulsar#readme>
+
+dependencies:
+  - base >= 4.7 && < 5
+  - ghc >= 9.4.7
+  - containers > 0.6.0.0
+  - unordered-containers > 0.2.19.0
+  - dimensional > 1.3
+  - parsec > 3.1.16.0
+
+ghc-options:
+  - -Wall
+  - -Wcompat
+  - -Widentities
+  - -Wincomplete-record-updates
+  - -Wincomplete-record-selectors #  Coming Soon TM
+  - -Wincomplete-uni-patterns
+  - -Wmissing-export-lists
+  - -Wmissing-home-modules
+  - -Wpartial-fields
+  - -Wredundant-constraints
+
+default-extensions:
+  - DerivingVia
+  - LambdaCase
+  - NamedWildCards
+  - LexicalNegation
+  - NoStarIsType
+  - FunctionalDependencies
+  - GADTs
+  - DuplicateRecordFields
+  - RecordWildCards
+
+language: GHC2021
+
+library:
+  source-dirs: src
+
+executables:
+  pulsar-exe:
+    main:                Main.hs
+    source-dirs:         app
+    dependencies:
+    - pulsar
+
+tests:
+  pulsar-test:
+    main:                Spec.hs
+    source-dirs:         test
+    dependencies:
+    - pulsar

pulsar.cabal

@@ -0,0 +1,116 @@
+cabal-version: 2.2
+
+-- This file has been generated from package.yaml by hpack version 0.35.2.
+--
+-- see: https://github.com/sol/hpack
+
+name:           pulsar
+version:        0.1.0.0
+description:    Please see the README at <https://gitea.treehouse.systems/Rin/pulsar#readme>
+author:         Rin
+maintainer:     rin@rin.systems
+copyright:      2023 Rin
+license:        CC-BY-SA-4.0
+license-file:   LICENSE
+build-type:     Simple
+extra-source-files:
+    CHANGELOG.md
+
+source-repository head
+  type: git
+  location: Rin/pulsar
+
+library
+  exposed-modules:
+      Aspect
+      Faith
+      Item
+      Lib
+      Magic
+      Material
+      Overseer
+      Structure
+  other-modules:
+      Paths_pulsar
+  autogen-modules:
+      Paths_pulsar
+  hs-source-dirs:
+      src
+  default-extensions:
+      DerivingVia
+      LambdaCase
+      NamedWildCards
+      LexicalNegation
+      NoStarIsType
+      FunctionalDependencies
+      GADTs
+      DuplicateRecordFields
+      RecordWildCards
+  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-record-selectors -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints
+  build-depends:
+      base >=4.7 && <5
+    , containers >0.6.0.0
+    , dimensional >1.3
+    , ghc >=9.4.7
+    , parsec >3.1.16.0
+    , unordered-containers >0.2.19.0
+  default-language: GHC2021
+
+executable pulsar-exe
+  main-is: Main.hs
+  other-modules:
+      Paths_pulsar
+  autogen-modules:
+      Paths_pulsar
+  hs-source-dirs:
+      app
+  default-extensions:
+      DerivingVia
+      LambdaCase
+      NamedWildCards
+      LexicalNegation
+      NoStarIsType
+      FunctionalDependencies
+      GADTs
+      DuplicateRecordFields
+      RecordWildCards
+  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-record-selectors -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints
+  build-depends:
+      base >=4.7 && <5
+    , containers >0.6.0.0
+    , dimensional >1.3
+    , ghc >=9.4.7
+    , parsec >3.1.16.0
+    , pulsar
+    , unordered-containers >0.2.19.0
+  default-language: GHC2021
+
+test-suite pulsar-test
+  type: exitcode-stdio-1.0
+  main-is: Spec.hs
+  other-modules:
+      Paths_pulsar
+  autogen-modules:
+      Paths_pulsar
+  hs-source-dirs:
+      test
+  default-extensions:
+      DerivingVia
+      LambdaCase
+      NamedWildCards
+      LexicalNegation
+      NoStarIsType
+      FunctionalDependencies
+      GADTs
+      DuplicateRecordFields
+      RecordWildCards
+  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-record-selectors -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints
+  build-depends:
+      base >=4.7 && <5
+    , containers >0.6.0.0
+    , dimensional >1.3
+    , ghc >=9.4.7
+    , parsec >3.1.16.0
+    , pulsar
+    , unordered-containers >0.2.19.0
+  default-language: GHC2021

src/Aspect.hs

@@ -0,0 +1,8 @@
+module Aspect where
+
+import Text.ParserCombinators.Parsec
+
+{-| Aspects represent the tasks that something is suitable for as well as its properties.
+-- They are nominally formed of an Aspect type (which amounts to an Enum), as well an amount.
+|--}
+

src/Faith.hs

@@ -0,0 +1,12 @@
+module Faith where
+
+
+{--| The Faith system uses a system of stringing together prayers to create effects. Miracles differ from magic in that
+--   a prayer can be ended at any time, and deployed at a moment's notice. This allows for dynamic adjustment of effects
+--   if the caster's situation changes. On the flip side, the prayers may require somatic or verbal components or other
+--   active costs during execution.
+
+--   Prayers themselves have slightly randomised effects per playthrough, while keeping to a theme.
+--   In the future, prayer usage should be tracked on a server to provide dynamic resonance and dissonance effects.
+
+|--}

src/Item.hs

@@ -0,0 +1,13 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+
+module Item where
+
+import Numeric.Units.Dimensional.Prelude
+
+class It where
+  bounds :: (Int, Int, Int)
+  volume :: Volume Integer
+  mass :: Mass Integer
+
+class It => We where
+  damage :: [(Aspect, Int)]

src/Lib.hs

@@ -0,0 +1,68 @@
+{-# OPTIONS_GHC -Wno-unused-top-binds #-}
+module Lib(
+  Has,
+  IsUID,
+  ItemUID,
+  BodyPartUID,
+  CreatureUID,
+  StructureUID,
+  CellUID,
+  EventUID,
+  TypeUID,
+  OverseerUID
+) where
+
+-- data Status = Success | Partial | Failure deriving (Eq, Ord, Show, Read)
+
+-- data Response i = ResponseMk {
+--   inform :: i,
+--   msg :: String,
+--   responseCode :: Status
+-- }
+
+import Data.Kind(Type)
+
+data Has :: (k -> Type) -> Type where
+  This :: p x -> Has p
+
+{-# DEPRECATED UID "Use the specialised UID newtypes instead" #-}
+type UID = Int
+
+class (Show a, Read a, Eq a, Ord a, Enum a) => IsUID a where
+  mkUID :: Int -> a
+  unUID :: a -> Int
+
+instance IsUID ItemUID where
+  mkUID = ItemUID
+  unUID (ItemUID a) = a
+instance IsUID BodyPartUID where
+  mkUID = BodyPartUID
+  unUID (BodyPartUID a) = a
+instance IsUID CreatureUID where
+  mkUID = CreatureUID
+  unUID (CreatureUID a) = a
+instance IsUID StructureUID where
+  mkUID = StructureUID
+  unUID (StructureUID a) = a
+instance IsUID CellUID where
+  mkUID = CellUID
+  unUID (CellUID a) = a
+instance IsUID EventUID where
+  mkUID = EventUID
+  unUID (EventUID a) = a
+instance IsUID TypeUID where
+  mkUID = TypeUID
+  unUID (TypeUID a) = a
+
+instance IsUID OverseerUID where
+  mkUID = OverseerUID
+  unUID (OverseerUID a) = a
+
+newtype ItemUID = ItemUID UID deriving (Show,Read,Eq,Ord,Enum) via Int
+newtype BodyPartUID = BodyPartUID UID deriving (Show,Read,Eq,Ord,Enum) via Int
+newtype CreatureUID = CreatureUID UID deriving (Show,Read,Eq,Ord,Enum) via Int
+newtype StructureUID = StructureUID UID deriving (Show,Read,Eq,Ord,Enum) via Int
+newtype CellUID = CellUID UID deriving (Show,Read,Eq,Ord,Enum) via Int
+newtype EventUID = EventUID UID deriving (Show,Read,Eq,Ord,Enum) via Int
+newtype TypeUID = TypeUID UID deriving (Show,Read,Eq,Ord,Enum) via Int
+newtype OverseerUID = OverseerUID UID deriving (Show, Read, Eq, Ord, Enum) via Int

src/Magic.hs

@@ -0,0 +1,66 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+
+module Magic where
+
+import Numeric.Units.Dimensional.Prelude
+
+import Data.String (String)
+import Data.Kind (Type)
+{--| The intent of the magic system is to allow for the creation of complex effects in the style of a programming language,
+--   couched in the language of fantasy writing. A lot of the semantics will match Haskell for both learning and pragmatic reasons.
+--
+--   In this system, spells are built from individual effect blocks. Effect chains have an execution time. Once triggered, they
+--   take mindspace while compiling, and are ready to be released once finished. Retaining a spell once its ready requires feats
+--   and yet more mindspace.
+--   On the bright side, once compilation is triggered, no further active action is required from the caster.
+|--}
+
+
+-- class Noun where
+--   overlays :: [String] -- TODO: Replace this with proper Aspects once they're done
+
+
+-- class Verb v where
+--   data ActionTypes :: Type -> Type
+--   effects :: ActionTypes n
+
+
+-- instance Verb Create where
+--   data ActionTypes = n -> n
+
+-- -- TODO: How to structrue Verbs and Nouns so that they actually form restrictions
+-- --       It may not be practical to do this at the type-level.
+
+data Noun where
+  Noun :: {
+    canonicalName :: String,
+    description :: String
+  } -> Noun
+
+data Verb n where
+  RawVerb :: {
+    canonicalName :: String,
+    description :: String
+  } -> Verb
+  AppliedVerb :: (n ~ Noun) => {
+    appliedName :: String,
+    description :: String
+  } -> Verb n
+
+data Target t where
+  Target :: {
+    canonicalName :: String,
+    description :: String
+  } -> Target t
+
+data Guideline v n t where
+  Guideline :: (v ~ Verb, n ~ Noun, t ~ Target) => {
+    level :: Int,
+    action :: t -> t,
+    description :: String
+  } -> Guideline v n t
+
+data EffectBlock t where
+  SimpleEffect :: {
+    effect :: MagicGuideline Noun Verb
+  } -> EffectBlock t

src/Material.hs

@@ -0,0 +1,31 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+module Material where
+
+import Numeric.Units.Dimensional.Prelude
+
+{- |
+
+The Material Module and data-type present the physical properties of materials, for use in items, structures, etc
+
+-}
+-- All temperature points are assumed to be STP, and should be given in Kelvin
+data Material = Material {
+  name :: String,
+  meltingPoint :: ThermodynamicTemperature Double, --Solid to liquid or vice versa
+  boilingPoint :: ThermodynamicTemperature Double, --Liquid to vapour or vice versa
+  tensileStength :: Pressure Integer, --This is going to be in MPa, so no point keeping fractions around
+  compressiveStrength :: Pressure Integer,
+  density :: Density Double
+} deriving (Show, Eq)
+
+freezingPoint :: Material -> ThermodynamicTemperature Double
+freezingPoint = meltingPoint
+
+condensationPoint :: Material -> ThermodynamicTemperature Double
+condensationPoint = boilingPoint
+
+defaultMaterial :: Material
+defaultMaterial = Material "Default" (10000 *~ kelvin) (100000 *~ kelvin) (100 *~ mega pascal) (100 *~ mega pascal) (100 *~ (kilo gram / cubic meter))
+
+genMaterial :: String -> Double -> Double -> Integer -> Integer -> Double -> Material
+genMaterial n mp bp ts cs d = Material n (mp *~ kelvin) (bp *~ kelvin) (ts *~ mega pascal) (cs *~ mega pascal) (d *~ (kilo gram / cubic meter))

src/Overseer.hs

@@ -0,0 +1,70 @@
+--{-# LANGUAGE TypeFamilyDependencies #-}
+module Overseer(
+  
+) where
+
+import Data.Sequence(Seq)
+import Data.Sequence qualified as S
+import Data.IntMap.Strict qualified as IMS
+
+import Lib
+import Structure
+import Material
+
+
+{-| The Overseer module handles disseminating and redirecting events between the relavent parties. Overall, this means that the Overseer for a type will have the full list of all UIDs in that type. For types with sub-types (such as the Creature -> BodyPart -> Sense relation), the Overseer carries the highest parent type.
+-- An efficient data structure for searching is required, as there will be many searches per tick. A BST is ideal, however this requires restructuring the UID type to be indicative of position (i.e. it should not be monotonically increasing unless the tree is self-balancing)
+-- Signalling success/failure back is important. Obviously, a bunch of events can be queued, however, there are race conditions. E.g. if two creatures attempt to pick up the same item in the same tick. In this case, we should use some deterministic mechanism to solve who gets priority. The other creature should be informed that they failed.
+-- In this system, a list of Actions will be compiled at each tick, and the GameState will fold over them for each Overseer, applying each to its relevant member.
+|-}
+
+---- GameState and Action Definitions -----------------------------------------------------------------------------------------------------
+
+-- TODO: Figure out how to structure actions and event queues
+--       This will likely require some kind of type-level list
+
+
+data GameState where
+  GameStateMk :: {
+    overseers :: [Has Overseer]
+  } -> GameState
+
+-- TODO: Is Partial a desired state?
+data Status = Failure | Partial | Success deriving (Eq, Ord, Show, Read)
+
+data Result k u = ResultMk {
+  originatior :: (IsUID u) => u,
+  status :: Status
+}
+
+data Event k u = EventMk {
+  action :: k -> k,
+  actor :: (IsUID u) => u,
+  precedence :: Int -- ^Precedence is a secondary sorting order for each actor
+}
+
+data Overseer k where
+  OverseerI :: {
+  itemsI :: Seq k,
+  eventsI :: Seq (Has (Event k)), -- ^Using sequence for consistency, list is fine here since we operate the list in order
+  resultsI :: Seq (Has (Result k)), -- ^The use of sequences lets us share results as required with cheap concat
+  oUID :: OverseerUID
+  } -> Overseer k
+  OverseerU :: { -- ^Overseers for 'case class' style definitions of parameters that do are not expected to change - they are defined strictly
+    itemsU  :: IMS.IntMap k,
+    oUID :: OverseerUID
+  } -> Overseer k
+
+
+class OverseerType k o t | k -> o, o -> k, k -> t where
+  -- Where k is the Subject, and i is the UID
+  items   :: (Traversable t) => o -> t k
+  events  :: (Traversable t) => Maybe (t (Event k u))
+  results :: (Traversable t) => Maybe (t (Result k u))
+  overseerUID :: o -> OverseerUID
+
+instance OverseerType Material (Overseer Material) IMS.IntMap where
+  items = itemsU
+  events = Nothing
+  results = Nothing
+  overseerUID = oUID

src/Structure.hs

@@ -0,0 +1,30 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+module Structure where
+
+import qualified Prelude
+
+import Numeric.Units.Dimensional.Prelude
+import Material
+import Lib
+
+data Structure = Structure {
+  integrity :: Integer,
+  mat :: Material,
+  volume :: Volume Double, -- | Either a discrete volume, or fills the entire cell, TODO: Find out some way to signify
+  uid :: StructureUID
+} deriving Show
+
+instance Eq Structure where
+  x == y =  Structure.uid x == Structure.uid y
+
+damageStructure :: Structure -> Integer -> Structure
+damageStructure (Structure i m v u) d = Structure (i Prelude.- d) m v u
+
+repairStructure :: Structure -> Integer -> Structure
+repairStructure (Structure i m v u) r = Structure (i Prelude.+ r) m v u
+
+genStructure :: Integer -> Material -> Double -> StructureUID -> Structure
+genStructure i m v = Structure i m (v *~ cubic metre)
+
+--instance Read Structure where
+--TODO: Research read instances

stack.yaml

@@ -0,0 +1,71 @@
+# This file was automatically generated by 'stack init'
+#
+# Some commonly used options have been documented as comments in this file.
+# For advanced use and comprehensive documentation of the format, please see:
+# https://docs.haskellstack.org/en/stable/yaml_configuration/
+
+# Resolver to choose a 'specific' stackage snapshot or a compiler version.
+# A snapshot resolver dictates the compiler version and the set of packages
+# to be used for project dependencies. For example:
+#
+# resolver: lts-21.13
+# resolver: nightly-2023-09-24
+# resolver: ghc-9.6.2
+#
+# The location of a snapshot can be provided as a file or url. Stack assumes
+# a snapshot provided as a file might change, whereas a url resource does not.
+#
+# resolver: ./custom-snapshot.yaml
+# resolver: https://example.com/snapshots/2023-01-01.yaml
+resolver:
+  url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/21/19.yaml
+
+# User packages to be built.
+# Various formats can be used as shown in the example below.
+#
+# packages:
+# - some-directory
+# - https://example.com/foo/bar/baz-0.0.2.tar.gz
+#   subdirs:
+#   - auto-update
+#   - wai
+packages:
+- .
+# Dependency packages to be pulled from upstream that are not in the resolver.
+# These entries can reference officially published versions as well as
+# forks / in-progress versions pinned to a git hash. For example:
+#
+# extra-deps:
+# - acme-missiles-0.3
+# - git: https://github.com/commercialhaskell/stack.git
+#   commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
+#
+extra-deps:
+  - containers-0.6.7
+  - dimensional-1.5
+  - unordered-containers-0.2.19.1
+  - parsec-3.1.16.1
+
+# Override default flag values for local packages and extra-deps
+# flags: {}
+
+# Extra package databases containing global packages
+# extra-package-dbs: []
+
+# Control whether we use the GHC we find on the path
+# system-ghc: true
+#
+# Require a specific version of Stack, using version ranges
+# require-stack-version: -any # Default
+# require-stack-version: ">=2.13"
+#
+# Override the architecture used by Stack, especially useful on Windows
+# arch: i386
+# arch: x86_64
+#
+# Extra directories used by Stack for building
+# extra-include-dirs: [/path/to/dir]
+# extra-lib-dirs: [/path/to/dir]
+#
+# Allow a newer minor version of GHC than the snapshot specifies
+compiler-check: newer-minor

stack.yaml.lock

@@ -0,0 +1,41 @@
+# This file was autogenerated by Stack.
+# You should not edit this file by hand.
+# For more information, please see the documentation at:
+#   https://docs.haskellstack.org/en/stable/lock_files
+
+packages:
+- completed:
+    hackage: containers-0.6.7@sha256:4aad61c33b21e453e5d18a465e674898fded282f233ffd154b48acc540c89537,2655
+    pantry-tree:
+      sha256: d3430bcc4beafe609d6c5cd4a607549ee4ffe0eafc2ebb9c87b5e7b1b20b24d8
+      size: 2902
+  original:
+    hackage: containers-0.6.7
+- completed:
+    hackage: dimensional-1.5@sha256:9c8a862a3ff8f69855b4094e4e097aa1682b05f8b2e78f2d7a3a238037fd5577,4791
+    pantry-tree:
+      sha256: 17e7232695e7243df6d96d839b310003297e6f6228fda2fa99c177f311c48c21
+      size: 2399
+  original:
+    hackage: dimensional-1.5
+- completed:
+    hackage: unordered-containers-0.2.19.1@sha256:1c28ca429e3960de0330908579a427ccacddd700cb84ec1969e2bbe576152add,3698
+    pantry-tree:
+      sha256: e26f35bfab576bd80e7229e3ed9b8b5e7d83c16cf1a679b9608e4862e9acc141
+      size: 1517
+  original:
+    hackage: unordered-containers-0.2.19.1
+- completed:
+    hackage: parsec-3.1.16.1@sha256:5769242043b01bf759b07b7efedcb19607837ee79015fcddde34645664136aed,4691
+    pantry-tree:
+      sha256: aee875443fc603500dcfcb5bea5c116ebcb990037abcf17e8d7020e493a51476
+      size: 2698
+  original:
+    hackage: parsec-3.1.16.1
+snapshots:
+- completed:
+    sha256: fb482b8e2d5d061cdda4ba1da2957c012740c893a5ee1c1b99001adae7b1fbe7
+    size: 640046
+    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/21/19.yaml
+  original:
+    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/21/19.yaml

test/Spec.hs

@@ -0,0 +1,2 @@
+main :: IO ()
+main = putStrLn "Test suite not yet implemented"