I need more perf for a side project ;)

bartavelle · Jan 24, 2018 · ead2803 · ead2803
1 parent 661b7bc
commit ead2803
Show file tree

Hide file tree

Showing 4 changed files with 32 additions and 30 deletions.
diff --git a/7startups.cabal b/7startups.cabal
@@ -35,7 +35,7 @@ library
                         Strategies.Compose,
                         Strategies.Bot1
                         STM.Promise
-  ghc-options:         -Wall
+  ghc-options:         -Wall -O2
   ghc-prof-options:    -auto-all -caf-all
   other-extensions:    OverloadedStrings, GeneralizedNewtypeDeriving
   build-depends:       base >=4.7 && <5,

diff --git a/Startups/Base.hs b/Startups/Base.hs
@@ -32,7 +32,7 @@ data Company = Facebook     -- ^ Rhodes
 data CompanySide = A | B
                  deriving (Eq, Ord, Enum, Show, Bounded)
 
-data CompanyProfile = CompanyProfile Company CompanySide
+data CompanyProfile = CompanyProfile !Company !CompanySide
                     deriving (Eq, Ord, Show)
 
 data Resource = Hype        -- ^ Glass
@@ -76,7 +76,7 @@ instance Monoid Funding where
     Funding a `mappend` Funding b = Funding (a + b)
 
 data PoachingOutcome = Defeat
-                     | Victory Age
+                     | Victory !Age
                      deriving (Eq, Ord, Show)
 
 data VictoryType = PoachingVictory
@@ -86,7 +86,7 @@ data VictoryType = PoachingVictory
                  | RnDVictory
                  | CommercialVictory
                  | CommunityVictory
-                 deriving (Ord, Eq, Show)
+                 deriving (Ord, Eq, Show, Enum, Bounded)
 
 makePrisms ''Age
 makePrisms ''PoachingOutcome

diff --git a/Startups/Cards.hs b/Startups/Cards.hs
@@ -30,16 +30,16 @@ data Neighbor = NLeft
               | NRight
               deriving (Ord, Eq, Show)
 
-data EffectDirection = Neighboring Neighbor
+data EffectDirection = Neighboring !Neighbor
                      | Own
                      deriving (Ord, Eq, Show)
 
 type Target = S.Set EffectDirection
 
 data Condition = HappensOnce
-               | PerCard Target (S.Set CardType)
-               | ByPoachingResult Target (S.Set PoachingOutcome)
-               | ByStartupStage Target
+               | PerCard !Target (S.Set CardType)
+               | ByPoachingResult !Target (S.Set PoachingOutcome)
+               | ByStartupStage !Target
                deriving (Ord, Eq, Show)
 
 neighbors :: Target
@@ -59,21 +59,21 @@ data ResearchType = Scaling
                   | CustomSolution
                   deriving (Ord, Eq, Show)
 
-data Effect = ProvideResource Resource Int Sharing
-            | ResourceChoice (S.Set Resource) Sharing
+data Effect = ProvideResource !Resource !Int !Sharing
+            | ResourceChoice (S.Set Resource) !Sharing
             | CheapExchange (S.Set Resource) (S.Set Neighbor)
-            | AddVictory VictoryType VictoryPoint Condition
-            | GainFunding Funding Condition
-            | RnD ResearchType
-            | Poaching Poacher
+            | AddVictory !VictoryType !VictoryPoint !Condition
+            | GainFunding !Funding !Condition
+            | RnD !ResearchType
+            | Poaching !Poacher
             | ScientificBreakthrough -- gives any science type
             | Recycling -- play a card in the discard pile
             | Opportunity (S.Set Age) -- build for free once per age
             | Efficiency -- play the last card
             | CopyCommunity
             deriving (Ord, Eq, Show)
 
-data Cost = Cost (MS.MultiSet Resource) Funding
+data Cost = Cost (MS.MultiSet Resource) !Funding
           deriving (Ord, Eq, Show)
 
 instance Monoid Cost where
@@ -93,17 +93,17 @@ instance IsString Cost where
             toCost '$' = Cost mempty 1
             toCost _   = error "Invalid cost string"
 
-data Card = Card { _cName       :: T.Text
-                 , _cMinplayers :: PlayerCount
-                 , _cAge        :: Age
-                 , _cType       :: CardType
-                 , _cCost       :: Cost
+data Card = Card { _cName       :: !T.Text
+                 , _cMinplayers :: !PlayerCount
+                 , _cAge        :: !Age
+                 , _cType       :: !CardType
+                 , _cCost       :: !Cost
                  , _cFree       :: [T.Text]
                  , _cEffect     :: [Effect]
                  }
-          | CompanyCard { _cCompany :: CompanyProfile
-                        , _cStage   :: CompanyStage
-                        , _cCost    :: Cost
+          | CompanyCard { _cCompany :: !CompanyProfile
+                        , _cStage   :: !CompanyStage
+                        , _cCost    :: !Cost
                         , _cEffect  :: [Effect]
                         }
           deriving (Ord,Eq,Show)

diff --git a/Startups/GameTypes.hs b/Startups/GameTypes.hs
@@ -33,16 +33,16 @@ showPlayerId = emph . pe
 
 data GameState = GameState { _playermap   :: M.Map PlayerId PlayerState
                            , _discardpile :: [Card]
-                           , _rnd         :: StdGen
+                           , _rnd         :: !StdGen
                            } deriving Show
 
 type Neighborhood = (PlayerId, PlayerId)
 
-data PlayerState = PlayerState { _pCompany         :: CompanyProfile
-                               , _pCompanyStage    :: CompanyStage
+data PlayerState = PlayerState { _pCompany         :: !CompanyProfile
+                               , _pCompanyStage    :: !CompanyStage
                                , _pCards           :: [Card]
-                               , _pFunds           :: Funding
-                               , _pNeighborhood    :: Neighborhood
+                               , _pFunds           :: !Funding
+                               , _pNeighborhood    :: !Neighborhood
                                , _pPoachingResults :: [PoachingOutcome]
                                } deriving Show
 
@@ -51,9 +51,11 @@ makeLenses ''PlayerState
 
 cardEffects :: Traversal' PlayerState Effect
 cardEffects = pCards . traverse . cEffect . traverse
+{-# INLINE cardEffects #-}
 
 playerEffects :: PlayerId -> Traversal' GameState Effect
 playerEffects pid = playermap . ix pid . cardEffects
+{-# INLINE playerEffects #-}
 
 neighbor :: Neighbor -> Lens' PlayerState PlayerId
 neighbor NLeft  = pNeighborhood . _1
@@ -85,8 +87,8 @@ data CommunicationType = PlayerCom PlayerId Communication
 
 data ActionRecap
   = ActionRecap
-  { _arAge     :: Age
-  , _arTurn    :: Turn
+  { _arAge     :: !Age
+  , _arTurn    :: !Turn
   , _arPlayers :: M.Map PlayerId PlayerState
   , _arActions :: M.Map PlayerId (PlayerAction, Exchange, Maybe SpecialInformation)
   } deriving Show