Do hints more
This commit is contained in:
parent
fd88082d77
commit
a6a7473f05
GPG Key ID:
A12F2C2FFDC3D847
|
|
@ -0,0 +1,70 @@
|
|||
# HLint configuration file
|
||||
# https://github.com/ndmitchell/hlint
|
||||
##########################
|
||||
|
||||
# This file contains a template configuration file, which is typically
|
||||
# placed as .hlint.yaml in the root of your project
|
||||
|
||||
|
||||
# Specify additional command line arguments
|
||||
#
|
||||
# - arguments: [--color, --cpp-simple, -XQuasiQuotes]
|
||||
|
||||
|
||||
# Control which extensions/flags/modules/functions can be used
|
||||
#
|
||||
# - extensions:
|
||||
# - default: false # all extension are banned by default
|
||||
# - name: [PatternGuards, ViewPatterns] # only these listed extensions can be used
|
||||
# - {name: CPP, within: CrossPlatform} # CPP can only be used in a given module
|
||||
#
|
||||
# - flags:
|
||||
# - {name: -w, within: []} # -w is allowed nowhere
|
||||
#
|
||||
# - modules:
|
||||
# - {name: [Data.Set, Data.HashSet], as: Set} # if you import Data.Set qualified, it must be as 'Set'
|
||||
# - {name: Control.Arrow, within: []} # Certain modules are banned entirely
|
||||
#
|
||||
# - functions:
|
||||
# - {name: unsafePerformIO, within: []} # unsafePerformIO can only appear in no modules
|
||||
|
||||
|
||||
# Add custom hints for this project
|
||||
#
|
||||
# Will suggest replacing "wibbleMany [myvar]" with "wibbleOne myvar"
|
||||
# - error: {lhs: "wibbleMany [x]", rhs: wibbleOne x}
|
||||
|
||||
# The hints are named by the string they display in warning messages.
|
||||
# For example, if you see a warning starting like
|
||||
#
|
||||
# Main.hs:116:51: Warning: Redundant ==
|
||||
#
|
||||
# You can refer to that hint with `{name: Redundant ==}` (see below).
|
||||
|
||||
# Turn on hints that are off by default
|
||||
#
|
||||
# Ban "module X(module X) where", to require a real export list
|
||||
# - warn: {name: Use explicit module export list}
|
||||
#
|
||||
# Replace a $ b $ c with a . b $ c
|
||||
# - group: {name: dollar, enabled: true}
|
||||
#
|
||||
# Generalise map to fmap, ++ to <>
|
||||
# - group: {name: generalise, enabled: true}
|
||||
|
||||
- group: {name: use-lens, enabled: true}
|
||||
- group: {name: generalise-for-conciseness, enabled: true}
|
||||
- group: {name: teaching, enabled: true}
|
||||
|
||||
|
||||
# Ignore some builtin hints
|
||||
# - ignore: {name: Use let}
|
||||
# - ignore: {name: Use const, within: SpecialModule} # Only within certain modules
|
||||
|
||||
|
||||
# Define some custom infix operators
|
||||
# - fixity: infixr 3 ~^#^~
|
||||
|
||||
|
||||
# To generate a suitable file for HLint do:
|
||||
# $ hlint --default > .hlint.yaml
|
||||
|
|
@ -1,4 +1,3 @@
|
|||
{-# OPTIONS_GHC -Wno-type-defaults #-}
|
||||
module GameLogic
|
||||
( chooseCharacter
|
||||
, applyEffect
|
||||
|
|
@ -80,6 +79,7 @@ forcedMovementValidDirections w h currentLocation (locus, moveType, _) =
|
|||
where
|
||||
directionToLocus = identifyCardinalDirection w h currentLocation locus
|
||||
|
||||
{-# ANN computePossibleSteps "HLint: ignore Apply De Morgan law" #-}
|
||||
computePossibleSteps :: BoardState -> MovementSpecs -> Point -> [(Point, Natural)]
|
||||
computePossibleSteps board (MovementSpecs {..}) currentLocation = mapMaybe getRemainingMov validDestinations
|
||||
where
|
||||
|
|
@ -191,7 +191,7 @@ applyEffect (Move specs@(MovementSpecs{..}) cid) board = case unitPosition board
|
|||
then continue $ board <++ if movMinimum
|
||||
then dontMoveEffects
|
||||
else finishMoveEffects
|
||||
else choiceBuilder $ (++ movementChoices) $ if movCompelled
|
||||
else choiceBuilder . (++ movementChoices) $ if movCompelled
|
||||
then []
|
||||
else if movMinimum
|
||||
then [dontMoveChoice]
|
||||
|
|
@ -223,7 +223,7 @@ applyEffect (Target fromPerspective range eligability ultimateEffect) board = un
|
|||
applyEffect (BodyBlock targettedUnit ultimateEffect) board = if canBB then allChoices else cantBBResult
|
||||
where
|
||||
potentialBBers = fromMaybe [] $ adjacentAllies board targettedUnit
|
||||
canBB = isNecromancer targettedUnit && potentialBBers /= []
|
||||
canBB = isNecromancer targettedUnit && not (null potentialBBers)
|
||||
buildChoice bber = mkChoice ("Bodyblock with " ++ renderCharacterHandle board bber) (ultimateEffect bber)
|
||||
dontBodyblock = mkChoice "Take the hit to your necromancer" (ultimateEffect targettedUnit)
|
||||
bbChoices = buildChoice <$> potentialBBers
|
||||
|
|
@ -251,7 +251,7 @@ applyEffect (ResolveAttack attacker attack defender) board = Roll actualDiceRoll
|
|||
actualDiceRolled = fromIntegral $ if netDice <= 0 then 2 else netDice
|
||||
keepHighest = netDice > 0
|
||||
toHit = maybe 1 getDefense defender'
|
||||
attackerStrWeak = fromMaybe 0 $ attacker' ^? _Just . tokenCount . ofToken StrWeak
|
||||
attackerStrWeak = sum $ attacker' ^? _Just . tokenCount . ofToken StrWeak
|
||||
tokenDamageModifier
|
||||
| attackerStrWeak < 0 = \x -> x-1
|
||||
| attackerStrWeak > 0 = (+1)
|
||||
|
|
@ -262,7 +262,7 @@ applyEffect (ResolveAttack attacker attack defender) board = Roll actualDiceRoll
|
|||
onHit = hitDamage : otherEffects attack
|
||||
onHeadshot = onHit ++ headshotEffects attack
|
||||
consequence Six
|
||||
| not $ null $ headshotEffects attack = mkChoice "Headshot!" onHeadshot
|
||||
| not . null $ headshotEffects attack = mkChoice "Headshot!" onHeadshot
|
||||
consequence r
|
||||
| r >= toHit = mkChoice "Hit!" onHit
|
||||
| otherwise = mkChoice "Graze" onMiss
|
||||
|
|
@ -272,7 +272,7 @@ applyEffect (InflictDamage damageType incomingAmount recipient) board = continue
|
|||
recipient' = board ^? ixCharacter recipient
|
||||
armorType = maybe NoArmor (^. baseStats . armL) recipient'
|
||||
armorReduction = if armorType `blocks` damageType then 1 else 0
|
||||
tokenReduction = signum $ fromMaybe 0 $ recipient' ^? _Just . tokenCount . ofToken VitalVulnr
|
||||
tokenReduction = signum . sum $ (recipient' ^? _Just . tokenCount . ofToken VitalVulnr)
|
||||
totalReduction = if damageType == DevilDamage then min 0 tokenReduction else armorReduction + tokenReduction
|
||||
netDamage
|
||||
| totalReduction >= incomingAmount' = 0
|
||||
|
|
@ -288,7 +288,7 @@ applyEffect (InflictDamage damageType incomingAmount recipient) board = continue
|
|||
applyEffect (InflictTokens tokenType numberToAdd target) board = continue $ board &
|
||||
ixCharacter target . tokenCount . ofToken tokenType +~ numberToAdd
|
||||
applyEffect (Kill unit) board = if isNecromancer unit
|
||||
then Victory $ otherPlayer $ owner unit
|
||||
then Victory . otherPlayer $ owner unit
|
||||
else continue $ unitRemoved <++ [deathAlert]
|
||||
where
|
||||
deathLocation = unitPosition board unit
|
||||
|
|
@ -318,7 +318,7 @@ instance Show (ChoiceTree' a) where
|
|||
choicesText :: [String]
|
||||
choicesText = firstDecisions choices
|
||||
numberedChoices :: [String]
|
||||
numberedChoices = zipWith (\n c -> show (1+n) ++ ") " ++ c) [0..] choicesText
|
||||
numberedChoices = zipWith (\n c -> show n ++ ") " ++ c) ([1..] :: [Int]) choicesText
|
||||
viewChoices :: String
|
||||
viewChoices = mconcat $ intersperse "\n" numberedChoices
|
||||
show (Random numDice rollType _) = "Roll " ++ show numDice ++ "d6 and take the " ++ (if rollType then "highest" else "lowest")
|
||||
|
|
@ -352,11 +352,11 @@ buildChoiceTree board = case popEffect board of
|
|||
PlayerChoice chooser choices -> ChoiceTree $ Node board' chooser (convertChoice board' <$> choices)
|
||||
Roll n d outcomes -> ChoiceTree $ Random n d (convertChoice board' <$> outcomes)
|
||||
Continue board'' -> buildChoiceTree board''
|
||||
Victory player -> ChoiceTree $ EndOfGame $ Just player
|
||||
Victory player -> ChoiceTree . EndOfGame $ Just player
|
||||
|
||||
makeChoice :: n -> ChoiceTree' n -> Maybe ChoiceTree
|
||||
makeChoice n (EndOfGame _) = never n
|
||||
makeChoice die (Random _ _ outcomes) = Just $ ctTree $ outcomes die
|
||||
makeChoice die (Random _ _ outcomes) = Just . ctTree $ outcomes die
|
||||
makeChoice indx (Node b p options) = trimmedChoices <$> providedDecision
|
||||
where
|
||||
providedDecision :: Maybe String
|
||||
|
|
|
|||
|
|
@ -1,5 +1,3 @@
|
|||
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
|
||||
{-# HLINT ignore "Eta reduce" #-}
|
||||
{-# OPTIONS_GHC -Wno-name-shadowing #-}
|
||||
module GameModel
|
||||
( DieFace(..)
|
||||
|
|
@ -166,7 +164,7 @@ instance Random DieFace where
|
|||
lowN = fromEnum low
|
||||
hiN = fromEnum hi
|
||||
(r, g') = randomR (lowN, hiN) g
|
||||
random g = randomR (One, Six) g
|
||||
random = randomR (One, Six)
|
||||
|
||||
bestOrWorst :: Bool -> [DieFace] -> DieFace
|
||||
bestOrWorst True = maximum
|
||||
|
|
@ -590,7 +588,7 @@ instance Show BaseStats where
|
|||
newtype TokenCount = TokenCount (forall n. Token n -> n)
|
||||
|
||||
instance Show TokenCount where
|
||||
show tc = mconcat $ intersperse "\n" $ filter (/=[])
|
||||
show tc = mconcat . intersperse "\n" $ filter (not . null)
|
||||
[ showHealth
|
||||
, showReload
|
||||
, " "
|
||||
|
|
@ -955,9 +953,9 @@ enumerateUnits = enumerateUnits'
|
|||
fUnit :: Player -> Int -> Character -> f Character
|
||||
fUnit player indx c = snd <$> f ((player, indx), c)
|
||||
fRoster :: Player -> [Character] -> f [Character]
|
||||
fRoster player roster = zipWithM (fUnit player) [0..] roster
|
||||
fCharacters :: PPair [Character] -> f (PPair [Character])
|
||||
fCharacters (PPair p1 p2) = PPair <$> fRoster Min p1 <*> fRoster Max p2
|
||||
fRoster player = zipWithM (fUnit player) [0..]
|
||||
|
||||
untappedUnits :: SimpleFold BoardState CharacterIdentifier
|
||||
untappedUnits = enumerateUnits . filtered (untapped . snd) . _1
|
||||
|
|
@ -971,7 +969,7 @@ pushEffects newEffects = effectStack %~ (newEffects ++)
|
|||
unitPosition :: BoardState -> CharacterIdentifier -> Maybe Point
|
||||
unitPosition (BoardState {_movingUnit=Just (movingCid, movingPoint)}) cid
|
||||
| movingCid == cid = Just movingPoint
|
||||
unitPosition (BoardState {_tiles}) cid = headMay $ catMaybes $ zipWith aux [0..] _tiles
|
||||
unitPosition (BoardState {_tiles}) cid = headMay . catMaybes $ zipWith aux [0..] _tiles
|
||||
where
|
||||
aux :: Natural -> (Maybe CharacterIdentifier, [EnvTile]) -> Maybe Point
|
||||
aux p (potentialCid, _)
|
||||
|
|
@ -1002,7 +1000,7 @@ adjacentAllies :: BoardState -> CharacterIdentifier -> Maybe [CharacterIdentifie
|
|||
adjacentAllies board cid = filter (owner >>> (owner cid ==)) <$> adjacentUnits board cid
|
||||
|
||||
isElevated :: BoardState -> CharacterIdentifier -> Bool
|
||||
isElevated board cid = maybe False (\p -> elem Elevation $ board ^. terrainAt p) $ unitPosition board cid
|
||||
isElevated board cid = any (\p -> elem Elevation $ board ^. terrainAt p) $ unitPosition board cid
|
||||
|
||||
removeUnit :: CharacterIdentifier -> BoardState -> BoardState
|
||||
removeUnit cid = tiles . each . _1 %~ mfilter (/= cid)
|
||||
|
|
|
|||
|
|
@ -7,14 +7,11 @@ import GameModel
|
|||
( adjacentAllies
|
||||
, Armor(..)
|
||||
, BaseStats(..)
|
||||
, BoardState
|
||||
, CharacterIdentifier
|
||||
, Choice
|
||||
, DamageType(..)
|
||||
, Effect(..)
|
||||
, Stat(..)
|
||||
, Token(..)
|
||||
, Trigger(..)
|
||||
, Trait(..)
|
||||
, Modifier(..)
|
||||
)
|
||||
|
|
|
|||
|
|
@ -8,7 +8,6 @@ module Util
|
|||
, note
|
||||
) where
|
||||
|
||||
import Data.Bool (bool)
|
||||
import Lens.Micro.TH (LensRules, lensRules, lensField, DefName (TopName))
|
||||
import Language.Haskell.TH (mkName, nameBase)
|
||||
import Lens.Micro
|
||||
|
|
@ -24,7 +23,7 @@ infixl 4 ??
|
|||
f ?? a = ($ a) <$> f
|
||||
|
||||
secondClassLensNames :: LensRules
|
||||
secondClassLensNames = lensRules & lensField .~ (\_ _ n -> [TopName $ mkName $ nameBase n ++ "L"])
|
||||
secondClassLensNames = lensRules & lensField .~ (\_ _ n -> [TopName . mkName $ nameBase n ++ "L"])
|
||||
|
||||
data Never
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue