Permalink
Browse files

Use the Reader monad more heavily, starting to move some functions ou…

…t of the DB monad.
  • Loading branch information...
1 parent 2fba10d commit 02641ea4a89915d44fc8d5d96e3c2e24f0c52dd0 @clanehin committed Oct 29, 2013
View
@@ -6,10 +6,13 @@ dontuse:
echo "cabal install"
configure:
- cabal-dev configure --ghc-options="-Werror" --enable-library-profiling --enable-executable-profiling
+ cabal-dev configure --ghc-options="-Werror"
+
+configure-profiling:
+ --enable-library-profiling --enable-executable-profiling
build:
- cabal-dev build
+ cabal-dev build -j
clean:
cabal-dev clean
@@ -22,20 +25,4 @@ check: clean
cabal-dev build
depends:
- cabal-dev install cipher-aes-0.1.8
- cabal-dev install MaybeT
- cabal-dev install MonadCatchIO-transformers
- cabal-dev install aeson
- cabal-dev install data-lens-template
- cabal-dev install data-memocombinators
- cabal-dev install hastache
- cabal-dev install hslogger
- cabal-dev install mwc-random
- cabal-dev install snap-core
- cabal-dev install snap-server
- cabal-dev install snap
- cabal-dev install streams
- cabal-dev install system-uuid
- cabal-dev install data-lens-template
- cabal-dev install snap
- cabal-dev install streams
+ cabal-dev install -j cipher-aes MaybeT MonadCatchIO-transformers aeson data-lens-template data-memocombinators hastache hslogger mwc-random snap-core snap-server snap streams system-uuid data-lens-template snap streams
@@ -15,6 +15,7 @@ import Roguestar.Lib.Data.FacingData
import Roguestar.Lib.Time
import Roguestar.Lib.Tool
import Control.Monad.Error
+import Control.Monad.Reader
import Roguestar.Lib.Behavior.Combat
import Roguestar.Lib.Behavior.Activate
import Roguestar.Lib.Behavior.Travel
@@ -127,7 +128,7 @@ dbBehave_ (Unwield) creature_ref =
increaseTime creature_ref =<< actionTime creature_ref
dbBehave_ (Drop tool_ref) creature_ref =
- do tool_parent <- liftM parentReference $ whereIs tool_ref
+ do tool_parent <- liftM parentReference $ asks $ whereIs tool_ref
already_wielded <- getWielded creature_ref
when (tool_parent =/= creature_ref) $ throwError $ DBErrorFlag ToolIs_NotInInventory
_ <- move tool_ref =<< dropTool tool_ref
@@ -10,6 +10,7 @@ import Roguestar.Lib.Core.Monster
import Roguestar.Lib.DB
import Control.Monad.Error
import Control.Monad.Random
+import Control.Monad.Reader
import Roguestar.Lib.Data.Substances
-- | Outcome of activating a tool.
@@ -21,7 +22,7 @@ data ActivationOutcome =
resolveActivation :: (MonadRandom db, DBReadable db) => MonsterRef -> db ActivationOutcome
resolveActivation creature_ref =
do tool_ref <- maybe (throwError $ DBErrorFlag NoToolWielded) return =<< getWielded creature_ref
- tool <- dbGetTool tool_ref
+ tool <- asks $ getTool tool_ref
case tool of
DeviceTool {} -> throwError $ DBErrorFlag ToolIs_Innapropriate
Sphere (ChromaliteSubstance c) ->
@@ -15,6 +15,7 @@ import Roguestar.Lib.Tool
import Roguestar.Lib.Data.ToolData
import Control.Monad.Error
import Control.Monad.Random
+import Control.Monad.Reader
import Roguestar.Lib.Data.FacingData
import Data.Maybe
import Roguestar.Lib.Utility.Contact
@@ -49,7 +50,7 @@ attackModel attacker_ref =
case m_tool_ref of
Nothing -> return $ UnarmedAttackModel attacker_ref
Just tool_ref ->
- do tool <- dbGetTool tool_ref
+ do tool <- asks $ getTool tool_ref
case tool of
DeviceTool Gun device -> return $ RangedAttackModel attacker_ref tool_ref device
DeviceTool Sword device -> return $ MeleeAttackModel attacker_ref tool_ref device
@@ -13,15 +13,15 @@ import Roguestar.Lib.Data.TerrainData
import Roguestar.Lib.Data.FacingData
import Control.Monad
import Control.Monad.Maybe
-import Control.Monad.Trans
+import Control.Monad.Reader
import Roguestar.Lib.Position
import Data.Maybe
-- | Modifies terrain in the specified walking direction, returning
-- True iff any terrain modification actually occured.
modifyFacingTerrain :: (Terrain -> Terrain) -> Facing -> MonsterRef -> DB Bool
modifyFacingTerrain f face creature_ref = liftM (fromMaybe False) $ runMaybeT $
- do (Parent plane_ref :: Parent Plane,position :: Position) <- MaybeT $ liftM fromLocation $ whereIs creature_ref
+ do (Parent plane_ref :: Parent Plane,position :: Position) <- MaybeT $ liftM fromLocation $ asks $ whereIs creature_ref
let target_position = offsetPosition (facingToRelative face) position
prev_terrain <- lift $ terrainAt plane_ref target_position
let new_terrain = f prev_terrain
@@ -13,28 +13,28 @@ module Roguestar.Lib.Behavior.Travel
resolveStepWithTemporalWeb)
where
-import Control.Monad.Maybe
-import Roguestar.Lib.Data.FacingData
-import Roguestar.Lib.DB as DB
-import Roguestar.Lib.Core.Plane as Plane
-import Data.Maybe
import Control.Monad
-import Control.Monad.Trans
import Control.Monad.Error
+import Control.Monad.Maybe
import Control.Monad.Random
+import Control.Monad.Reader
+import Data.Maybe
import Data.Ord
-import Roguestar.Lib.Position as Position
-import Roguestar.Lib.Data.TerrainData
import Data.List (minimumBy)
+import Roguestar.Lib.Behavior.Outcome
import Roguestar.Lib.Core.Monster
+import Roguestar.Lib.Core.Plane as Plane
+import Roguestar.Lib.DB as DB
+import Roguestar.Lib.Data.FacingData
import Roguestar.Lib.Data.MonsterData
-import Roguestar.Lib.Logging
+import Roguestar.Lib.Data.TerrainData
import Roguestar.Lib.Data.TravelData
+import Roguestar.Lib.Logging
+import Roguestar.Lib.PlaneVisibility
+import Roguestar.Lib.Position as Position
+import Roguestar.Lib.Time
import Roguestar.Lib.Utility.DetailedLocation
import Roguestar.Lib.Utility.DetailedTravel as DetailedTravel
-import Roguestar.Lib.Behavior.Outcome
-import Roguestar.Lib.Time
-import Roguestar.Lib.PlaneVisibility
data MoveOutcome =
MoveGood { _move_monster :: MonsterRef, move_from :: Standing, _move_to :: Standing }
@@ -114,7 +114,7 @@ resolveClimb creature_ref direction = liftM (fromMaybe ClimbFailed) $ runMaybeT
lift $ logDB gameplay_log DEBUG $ "Stepping " ++ show direction ++ " from: " ++ show (plane_ref,pos)
plane_destination <- MaybeT $ case direction of
ClimbDown -> getBeneath plane_ref
- ClimbUp -> liftM (fmap asParent . fromLocation) $ DB.whereIs plane_ref
+ ClimbUp -> liftM (fmap asParent . fromLocation) $ asks $ DB.whereIs plane_ref
lift $ logDB gameplay_log DEBUG $ "Stepping " ++ show direction ++ " to: " ++ show plane_destination
pos' <- lift $ pickRandomClearSite 10 0 0 pos (== expected_landing_terrain) plane_destination
return $ ClimbGood direction creature_ref $
@@ -13,6 +13,7 @@ import Roguestar.Lib.Data.SpeciesData
import Roguestar.Lib.Data.MonsterData (Monster)
import Roguestar.Lib.Core.Plane
import Control.Monad
+import Control.Monad.Reader
import Roguestar.Lib.Core.Monster
import Data.Ratio
import Roguestar.Lib.Data.FacingData
@@ -47,7 +48,7 @@ dbFinishPlanarAITurns :: PlaneRef -> DB ()
dbFinishPlanarAITurns plane_ref =
do logDB gameplay_log INFO $ "Running turns for plane: id=" ++ show (toUID plane_ref)
sweepDead plane_ref
- (all_creatures_on_plane :: [MonsterRef]) <- liftM asChildren $ getContents plane_ref
+ (all_creatures_on_plane :: [MonsterRef]) <- liftM asChildren $ asks $ getContents plane_ref
any_players_left <- liftM (any (== Player)) $ mapM getMonsterFaction all_creatures_on_plane
next_turn <- dbNextTurn $ List.map genericReference all_creatures_on_plane ++ [genericReference plane_ref]
case next_turn of
@@ -76,7 +77,7 @@ monster_spawns = [(RecreantFactory,RedRecreant)]
dbPerform1PlanarAITurn :: PlaneRef -> DB ()
dbPerform1PlanarAITurn plane_ref =
do logDB gameplay_log INFO $ "dbPerform1PlanarAITurn; Beginning planar AI turn (for the plane itself):"
- (creature_locations :: [DetailedLocation (Child Monster)]) <- liftM mapLocations $ getContents plane_ref
+ (creature_locations :: [DetailedLocation (Child Monster)]) <- liftM mapLocations $ asks $ getContents plane_ref
player_locations <- filterRO (liftM (== Player) . getMonsterFaction . asChild . detail) creature_locations
num_npcs <- liftM length $ filterRO (liftM (/= Player) . getMonsterFaction . asChild . detail) creature_locations
when (num_npcs < length player_locations * 3) $
@@ -16,11 +16,12 @@ import Roguestar.Lib.Data.FacingData
import Data.Maybe
import Control.Monad.Maybe
import Control.Monad.Random
+import Control.Monad.Error
+import Control.Monad.Reader
import Roguestar.Lib.Data.PlaneData
import Roguestar.Lib.Core.Plane
import Roguestar.Lib.Position
import Roguestar.Lib.Data.TerrainData
-import Control.Monad.Error
import Roguestar.Lib.Data.PowerUpData
import Roguestar.Lib.Behavior.CharacterAdvancement
import Roguestar.Lib.Utility.DetailedLocation
@@ -32,16 +33,16 @@ buildingSize = liftM (genericLength . buildingOccupies) . buildingShape
buildingShape :: (DBReadable db) => BuildingRef -> db BuildingShape
buildingShape building_ref =
- do constructed <- liftM fromLocation $ whereIs building_ref
+ do constructed <- liftM fromLocation $ asks $ whereIs building_ref
case constructed of
Just building_shape -> return building_shape
_ -> error "buildingType: impossible case"
buildingSignal :: (DBReadable db) => BuildingRef -> db (Maybe BuildingSignal)
-buildingSignal = liftM building_signal . dbGetBuilding
+buildingSignal = liftM building_signal . asks . getBuilding
buildingBehavior :: (DBReadable db) => BuildingRef -> db BuildingBehavior
-buildingBehavior building_ref = liftM building_behavior $ dbGetBuilding building_ref
+buildingBehavior building_ref = liftM building_behavior $ asks $ getBuilding building_ref
deleteBuilding :: BuildingRef -> DB ()
deleteBuilding building_ref = dbUnsafeDeleteObject building_ref
@@ -50,7 +51,7 @@ deleteBuilding building_ref = dbUnsafeDeleteObject building_ref
-- | Activate the facing building, returns True iff any building was actually activated.
activateFacingBuilding :: Facing -> MonsterRef -> DB Bool
activateFacingBuilding face creature_ref = liftM (fromMaybe False) $ runMaybeT $
- do (Parent plane_ref,position) <- MaybeT $ liftM fromLocation $ whereIs creature_ref
+ do (Parent plane_ref,position) <- MaybeT $ liftM fromLocation $ asks $ whereIs creature_ref
buildings <- lift $ liftM mapLocations $ whatIsOccupying plane_ref $ offsetPosition (facingToRelative face) position
liftM or $ lift $ forM buildings $ \(Child building_ref) ->
do building_behavior_type <- buildingBehavior building_ref
@@ -85,7 +86,7 @@ activateBuilding (OneWayStargate region) creature_ref building_ref =
-- the dbMove result from the action.
portalMonsterTo :: Maybe BuildingBehavior -> Integer -> MonsterRef -> PlaneRef -> DB (Location,Location)
portalMonsterTo building_behavior_type offset creature_ref plane_ref =
- do (all_buildings :: [BuildingRef]) <- liftM asChildren (getContents plane_ref)
+ do (all_buildings :: [BuildingRef]) <- liftM asChildren (asks $ getContents plane_ref)
portals <- filterM (liftM ((== building_behavior_type) . Just) . buildingBehavior) all_buildings
ideal_position <- if null portals
then liftM2 (\x y -> Position (x,y)) (getRandomR (-40,40)) (getRandomR (-40,40))
@@ -97,7 +98,7 @@ portalMonsterTo building_behavior_type offset creature_ref plane_ref =
captureNode :: PowerUpData -> MonsterRef -> BuildingRef -> DB ()
captureNode power_up_data creature_ref building_ref =
- do c <- dbGetMonster creature_ref
+ do c <- asks $ getMonster creature_ref
let result = bumpCharacter power_up_data c
dbModMonster (const $ character_new result) creature_ref
deleteBuilding building_ref
@@ -0,0 +1,12 @@
+module Roguestar.Lib.Core.Entities
+ (getAncestors)
+ where
+
+import Roguestar.Lib.Data.LocationData
+import Roguestar.Lib.DB
+
+getAncestors :: Reference a -> DB_BaseType -> [Location]
+getAncestors reference _ | reference =:= the_universe = []
+getAncestors reference db = location : getAncestors reference' db
+ where reference' = parentReference location
+ location = whereIs reference db
@@ -23,6 +23,7 @@ import Roguestar.Lib.Data.SpeciesTraits
import Roguestar.Lib.Data.FactionData
import Control.Monad.Error
import Control.Monad.Random
+import Control.Monad.Reader
import Roguestar.Lib.Data.FacingData
import Roguestar.Lib.Position
import Roguestar.Lib.Core.Plane
@@ -39,7 +40,7 @@ generateMonster faction species =
do r <- getRandomR (1,1000000)
return $ applyToMonster (species_specials $ speciesInfo species) $
applyToMonster (species_traits $ speciesInfo species) $
- empty_creature {
+ empty_monster {
creature_species = species,
creature_faction = faction,
creature_random_id = r }
@@ -61,11 +62,11 @@ newMonster faction species loc =
dbAddMonster creature loc
getMonsterSpecial :: (DBReadable db) => MonsterSpecial -> MonsterRef -> db Bool
-getMonsterSpecial special creature_ref = liftM (Set.member special . creature_specials) $ dbGetMonster creature_ref
+getMonsterSpecial special creature_ref = liftM (Set.member special . creature_specials) $ asks $ getMonster creature_ref
getMonsterAbilityScore :: (DBReadable db) => MonsterAbility -> MonsterRef -> db Integer
getMonsterAbilityScore ability creature_ref =
- do raw_ideal <- liftM (creatureAbilityScore ability) $ dbGetMonster creature_ref
+ do raw_ideal <- liftM (creatureAbilityScore ability) $ asks $ getMonster creature_ref
terrain_ideal <- getTerrainAffinity creature_ref
return $ raw_ideal + terrain_ideal
@@ -75,7 +76,7 @@ getTerrainAffinity creature_ref =
do (Parent plane_ref,pos) <- liftM detail $ getPlanarLocation creature_ref
terrain_affinity_points <- liftM sum $ forM [minBound..maxBound] $ \face ->
do t <- terrainAt plane_ref $ offsetPosition (facingToRelative face) pos
- liftM (creatureAbilityScore $ TerrainAffinity t) $ dbGetMonster creature_ref
+ liftM (creatureAbilityScore $ TerrainAffinity t) $ asks $ getMonster creature_ref
return $ terrain_affinity_points `div` 4
-- | Get the current creature, if it belongs to the specified faction, based on the current playerState.
@@ -86,7 +87,7 @@ getCurrentMonster faction =
return $ if is_one_of_us then m_who else Nothing
getMonsterFaction :: (DBReadable db) => MonsterRef -> db Faction
-getMonsterFaction = liftM creature_faction . dbGetMonster
+getMonsterFaction = liftM creature_faction . asks . getMonster
injureMonster :: Integer -> MonsterRef -> DB ()
injureMonster x = dbModMonster $ \c -> c { creature_damage = max 0 $ creature_damage c + x }
@@ -96,10 +97,10 @@ healMonster = injureMonster . negate
-- | Health as a fraction of 1.
getMonsterHealth :: (DBReadable db) => MonsterRef -> db MonsterHealth
-getMonsterHealth creature_ref = liftM creatureHealth $ dbGetMonster creature_ref
+getMonsterHealth creature_ref = liftM creatureHealth $ asks $ getMonster creature_ref
getDead :: (DBReadable db) => Reference a -> db [MonsterRef]
-getDead parent_ref = filterRO (liftM ((<= 0) . creature_health) . getMonsterHealth) =<< liftM asChildren (getContents parent_ref)
+getDead parent_ref = filterRO (liftM ((<= 0) . creature_health) . getMonsterHealth) =<< liftM asChildren (asks $ getContents parent_ref)
deleteMonster :: MonsterRef -> DB ()
deleteMonster creature_ref =
Oops, something went wrong.

0 comments on commit 02641ea

Please sign in to comment.