sprinkle some NFData everywhere

(also some evaluateNF, leading to slightly less memory usage)

6 files changed, 45 insertions, 30 deletions

diff --git a/lib/Badges.hs b/lib/Badges.hs
index 5da2643..c1a17b3 100644
--- a/lib/Badges.hs
+++ b/lib/Badges.hs
@@ -1,11 +1,14 @@
-{-# LANGUAGE DeriveAnyClass    #-}
-{-# LANGUAGE DeriveGeneric     #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RecordWildCards   #-}
+{-# LANGUAGE DeriveAnyClass             #-}
+{-# LANGUAGE DeriveGeneric              #-}
+{-# LANGUAGE DerivingStrategies         #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE OverloadedStrings          #-}
+{-# LANGUAGE RecordWildCards            #-}
 
 -- | module defining Badge types and utility functions
 module Badges where
 
+import           Control.DeepSeq (NFData)
 import           Data.Aeson      (Options (fieldLabelModifier, sumEncoding),
                                   SumEncoding (UntaggedValue), ToJSON (toJSON),
                                   defaultOptions, genericToJSON, (.=))
@@ -27,10 +30,10 @@ data BadgeArea =
    , areaWidth  :: Double
    , areaHeight :: Double
    }
-  deriving (Ord, Eq, Generic, Show)
+  deriving (Ord, Eq, Generic, Show, NFData)
 
 newtype BadgeToken = BadgeToken Text
-  deriving (Eq, Ord, Show)
+  deriving newtype (Eq, Ord, Show, NFData)
 
 instance ToJSON BadgeArea where
   toJSON = genericToJSON defaultOptions
@@ -46,7 +49,7 @@ parseToken text = if text =~ ("^[a-zA-Z0-9]{50}$" :: Text)
   else Nothing
 
 data Badge = Badge BadgeToken BadgeArea
-  deriving (Ord, Eq, Generic, Show)
+  deriving (Ord, Eq, Generic, Show, NFData)
 
 instance ToJSON Badge where
   toJSON (Badge token area) = A.object $ case area of
diff --git a/lib/CheckDir.hs b/lib/CheckDir.hs
index b9a3a31..652d58f 100644
--- a/lib/CheckDir.hs
+++ b/lib/CheckDir.hs
@@ -10,6 +10,7 @@
 module CheckDir (maximumLintLevel, recursiveCheckDir, DirResult(..), MissingAsset(..), MissingDep(..), resultIsFatal)  where
 
 import           CheckMap               (MapResult (..), loadAndLintMap)
+import           Control.DeepSeq        (NFData)
 import           Control.Monad          (void)
 import           Control.Monad.Extra    (mapMaybeM)
 import           Data.Aeson             (ToJSON, (.=))
@@ -36,6 +37,7 @@ import           Types                  (Dep (Local, LocalMap), Hint (Hint),
                                          Level (..), hintLevel)
 import           Util                   (PrettyPrint (prettyprint))
 
+
 -- based on the startling observation that Data.Map has lower complexity
 -- for difference than Data.Set, but the same complexity for fromList
 type Set a = Map a ()
@@ -52,19 +54,20 @@ data DirResult = DirResult
   -- ^ all dependencies to things outside this repository
   , dirresultMissingAssets :: [MissingAsset]
   -- ^ entrypoints of maps which are referred to but missing
-  , dirresultGraph         :: Dot ()
-  } deriving (Generic)
+  , dirresultGraph         :: Text
+  } deriving (Generic, NFData)
 
 data MissingDep = MissingDep
   { depFatal   :: Maybe Bool
   , entrypoint :: Text
   , neededBy   :: [FilePath]
-  } deriving (Generic, ToJSON)
+  } deriving (Generic, ToJSON, NFData)
 
 -- | Missing assets are the same thing as missing dependencies,
 -- but should not be confused (and also serialise differently
 -- to json)
 newtype MissingAsset = MissingAsset MissingDep
+  deriving (Generic, NFData)
 
 -- | given this config, should the result be considered to have failed?
 resultIsFatal :: LintConfig' -> DirResult -> Bool
@@ -97,7 +100,7 @@ instance ToJSON DirResult where
       [ "missingDeps" .= dirresultDeps res
       , "missingAssets" .= dirresultMissingAssets res
       , "mapLints" .= dirresultMaps res
-      , "exitGraph" .= showDot (dirresultGraph res)
+      , "exitGraph" .= dirresultGraph res
       ]
     , "severity" .= maximumLintLevel res
     , "mapInfo" .= fmap (\tm -> A.object [ "badges" .= mapresultBadges tm ])
@@ -163,7 +166,7 @@ recursiveCheckDir config prefix root = do
   pure $ DirResult { dirresultDeps = missingDeps root maps'
                    , dirresultMissingAssets = mAssets
                    , dirresultMaps = maps'
-                   , dirresultGraph = graphToDot exitGraph
+                   , dirresultGraph = T.pack $ showDot $ graphToDot exitGraph
                    }
 
 
diff --git a/lib/CheckMap.hs b/lib/CheckMap.hs
index cfa4b6e..9dd0530 100644
--- a/lib/CheckMap.hs
+++ b/lib/CheckMap.hs
@@ -21,6 +21,7 @@ import           GHC.Generics     (Generic)
 
 
 import           Badges           (Badge)
+import           Control.DeepSeq  (NFData)
 import           LintConfig       (LintConfig')
 import           LintWriter       (LintResult, invertLintResult,
                                    resultToAdjusted, resultToBadges,
@@ -55,7 +56,7 @@ data MapResult = MapResult
   -- ^ badges that can be found on this map
   , mapresultGeneral  :: [Hint]
   -- ^ general-purpose lints that didn't fit anywhere else
-  } deriving (Generic)
+  } deriving (Generic, NFData)
 
 instance ToJSON MapResult where
   toJSON res = A.object
diff --git a/lib/Paths.hs b/lib/Paths.hs
index b9b0d50..15dc66b 100644
--- a/lib/Paths.hs
+++ b/lib/Paths.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE DeriveAnyClass    #-}
+{-# LANGUAGE DeriveGeneric     #-}
 {-# LANGUAGE MultiWayIf        #-}
 {-# LANGUAGE OverloadedStrings #-}
 
@@ -5,8 +7,10 @@
 -- I just hope you are running this on some kind of Unix
 module Paths where
 
+import           Control.DeepSeq       (NFData)
 import           Data.Text             (Text, isPrefixOf)
 import qualified Data.Text             as T
+import           GHC.Generics          (Generic)
 import           System.FilePath       (splitPath)
 import           System.FilePath.Posix ((</>))
 import           Text.Regex.TDFA
@@ -16,7 +20,7 @@ import           Util                  (PrettyPrint (prettyprint))
 -- a path without any . or .. in it. Also possibly a
 -- fragment, mostly for map links.
 data RelPath = Path Int Text (Maybe Text)
-  deriving (Show, Eq, Ord)
+  deriving (Show, Eq, Ord, NFData, Generic)
 
 
 
diff --git a/lib/Tiled.hs b/lib/Tiled.hs
index bca5f1a..ab7d4f4 100644
--- a/lib/Tiled.hs
+++ b/lib/Tiled.hs
@@ -1,5 +1,7 @@
 {-# LANGUAGE AllowAmbiguousTypes        #-}
+{-# LANGUAGE DeriveAnyClass             #-}
 {-# LANGUAGE DeriveGeneric              #-}
+{-# LANGUAGE DerivingStrategies         #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE LambdaCase                 #-}
 {-# LANGUAGE NamedFieldPuns             #-}
@@ -15,6 +17,7 @@
 -- http://doc.mapeditor.org/en/latest/reference/tmx-map-format/
 module Tiled where
 
+import           Control.DeepSeq        (NFData)
 import           Control.Exception      (try)
 import           Control.Exception.Base (SomeException)
 import           Data.Aeson             hiding (Object)
@@ -43,26 +46,26 @@ aesonOptions l = defaultOptions
 
 -- | A globally indexed identifier.
 newtype GlobalId = GlobalId { unGlobalId :: Int }
-  deriving (Ord, Eq, Enum, Num, Generic, Show, FromJSON, ToJSON, FromJSONKey, ToJSONKey)
+  deriving newtype (Ord, Eq, Enum, Num, Show, FromJSON, ToJSON, FromJSONKey, ToJSONKey, NFData)
 
 mkTiledId :: Int -> GlobalId
 mkTiledId i = GlobalId { unGlobalId = i }
 
 -- | A locally indexed identifier.
 newtype LocalId = LocalId { unLocalId :: Int }
-  deriving (Ord, Eq, Enum, Num, Generic, Show, FromJSON, ToJSON, FromJSONKey, ToJSONKey)
+  deriving newtype (Ord, Eq, Enum, Num, Show, FromJSON, ToJSON, FromJSONKey, ToJSONKey, NFData)
 
 type Color = Text
 
 -- | A custom tiled property, which just has a name and a value.
 data Property = Property Text PropertyValue
-  deriving (Eq, Generic, Show)
+  deriving (Eq, Generic, Show, NFData)
 
 -- | The value of a custom tiled property.
 -- It is strongly typed via a tag in the json representation,
 -- and needs a custom ToJSON and FromJSON instance because of that.
 data PropertyValue = StrProp Text | BoolProp Bool | IntProp Int | FloatProp Float
-  deriving (Eq, Generic, Show)
+  deriving (Eq, Generic, Show, NFData)
 
 instance IsString PropertyValue where
   fromString s = StrProp (T.pack s)
@@ -111,7 +114,7 @@ instance ToJSON Property where
 
 data Point = Point { pointX :: Double
                    , pointY :: Double
-                   } deriving (Eq, Generic, Show)
+                   } deriving (Eq, Generic, Show, NFData)
 
 instance FromJSON Point where
   parseJSON = genericParseJSON (aesonOptions 5)
@@ -178,7 +181,7 @@ data Object = ObjectRectangle
   , objectHeight     :: Maybe Double
   , objectEllipse    :: Maybe Bool
   , objectType       :: Text
-  } deriving (Eq, Generic, Show)
+  } deriving (Eq, Generic, Show, NFData)
 
 
 
@@ -226,7 +229,7 @@ data Layer = Layer { layerWidth            :: Maybe Double
                    , layerStartX           :: Maybe Int
                    , layerStartY           :: Maybe Int
                    , layerColor            :: Maybe Color
-                   } deriving (Eq, Generic, Show)
+                   } deriving (Eq, Generic, Show, NFData)
 
 instance FromJSON Layer where
   parseJSON = genericParseJSON (aesonOptions 5)
@@ -238,7 +241,7 @@ data Terrain = Terrain { terrainName :: String
                          -- ^ Name of terrain
                        , terrainTile :: LocalId
                          -- ^ Local ID of tile representing terrain
-                       } deriving (Eq, Generic, Show)
+                       } deriving (Eq, Generic, Show, NFData)
 
 instance FromJSON Terrain where
   parseJSON (A.Object o) = Terrain <$> o .: "name"
@@ -254,7 +257,7 @@ instance ToJSON Terrain where
 
 data Frame = Frame { frameDuration :: Int
                    , frameTileId   :: LocalId
-                   } deriving (Eq, Generic, Show)
+                   } deriving (Eq, Generic, Show, NFData)
 
 instance FromJSON Frame where
   parseJSON (A.Object o) = Frame <$> o .: "duration"
@@ -277,7 +280,7 @@ data Tile = Tile { tileId          :: Int
                  , tileProbability :: Maybe Float
                  , tileType        :: Maybe Text
                  , tileTerrain     :: Maybe [Int]
-                 } deriving (Eq, Generic, Show)
+                 } deriving (Eq, Generic, Show, NFData)
 
 instance FromJSON Tile where
   parseJSON = genericParseJSON (aesonOptions 4)
@@ -331,10 +334,10 @@ data Tileset = Tileset { tilesetFirstgid         :: GlobalId
                        , tilesetWangsets         :: Maybe Value
                        , tilesetType             :: Maybe Text
                        , tilesetFileName         :: Maybe Text
-                       } deriving (Eq, Generic, Show)
+                       } deriving (Eq, Generic, Show, NFData)
 
 newtype TransitiveTilesetMap = TransitiveTilesetMap (Map LocalId Value)
-  deriving (Show, Eq, Generic, FromJSON)
+  deriving newtype (Show, Eq, FromJSON)
 
 instance FromJSON Tileset where
   parseJSON = genericParseJSON (aesonOptions 7)
@@ -378,7 +381,7 @@ data Tiledmap = Tiledmap { tiledmapVersion          :: Value
                          , tiledmapStaggerindex     :: Maybe String
                          , tiledmapType             :: String
                          , tiledmapEditorsettings   :: Maybe Value
-                         } deriving (Eq, Generic, Show)
+                         } deriving (Eq, Generic, Show, NFData)
 
 instance FromJSON Tiledmap where
   parseJSON = genericParseJSON (aesonOptions 8)
diff --git a/lib/Types.hs b/lib/Types.hs
index 588c8ea..43a5131 100644
--- a/lib/Types.hs
+++ b/lib/Types.hs
@@ -24,6 +24,7 @@ import           Data.Text                 (Text)
 import           GHC.Generics              (Generic)
 
 import           Badges                    (Badge)
+import           Control.DeepSeq           (NFData)
 import qualified Data.Aeson                as A
 import           Data.Maybe                (mapMaybe)
 import           Paths                     (RelPath)
@@ -37,7 +38,7 @@ import           WithCli.Pure              (Argument (argumentType, parseArgumen
 -- | Levels of errors and warnings, collectively called
 -- "Hints" until I can think of some better name
 data Level = Info | Suggestion | Warning | Forbidden | Error | Fatal
-  deriving (Show, Generic, Ord, Eq, ToJSON, FromJSON)
+  deriving (Show, Generic, Ord, Eq, ToJSON, FromJSON, NFData)
 
 instance Argument Level where
   argumentType Proxy = "Lint Level"
@@ -60,12 +61,12 @@ data Lint = Depends Dep | Offers Text | Lint Hint | Badge Badge
   deriving (Ord, Eq, Generic, ToJSONKey)
 
 data Dep = Local RelPath | Link Text | MapLink Text | LocalMap RelPath
-  deriving (Generic, Ord, Eq)
+  deriving (Generic, Ord, Eq, NFData)
 
 data Hint = Hint
   { hintLevel :: Level
   , hintMsg   :: Text
-  } deriving (Generic, Ord, Eq)
+  } deriving (Generic, Ord, Eq, NFData)
 
 -- | shorter constructor (called hint because (a) older name and
 -- (b) lint also exists and is monadic)