hunt warnings

This commit is contained in:
nek0 2020-05-05 00:54:47 +02:00
parent c110f29c8f
commit 83b3bbcd9b
5 changed files with 19 additions and 19 deletions

View File

@ -3,14 +3,7 @@
{-# LANGUAGE FlexibleInstances #-}
module Object where
import Affection as A
import Control.Monad (when)
import Data.Ecstasy
import Data.Maybe
import Linear
-- internal imports

View File

@ -16,7 +16,6 @@ instance ActionTime ObjType ObjState where
actionTime ObjComputer "off" = 0
actionTime ObjComputer "on" = 20
actionTime ObjComputer "hack" = 20
actionTime ObjComputer "hack" = 20
actionTime ObjDoor "open" = 2
actionTime o s = A.log

View File

@ -6,7 +6,6 @@ module Object.Computer where
import Affection as A
import Control.Monad (when)
import Control.Monad.IO.Class (MonadIO(..))
import Data.Ecstasy
@ -19,7 +18,7 @@ import Linear
import Types
import Object.ActionTime
import Object.ActionTime ()
computerObjectAction
:: (Monad m, MonadIO m)

View File

@ -10,11 +10,8 @@ import Control.Monad (when)
import Control.Monad.IO.Class
import Data.Ecstasy
import Data.Maybe
import Data.String (IsString(..))
import Linear
import Types
copierObjectAction

View File

@ -7,19 +7,24 @@ module Object.Door where
import Affection as A
import Control.Monad (when)
import Control.Monad.IO.Class (MonadIO)
import Data.Ecstasy
import Data.Maybe
import Data.String
import Linear
-- internal imports
import Types
import Object.ActionTime
import Object.ActionTime ()
doorObjectAction :: (Eq a, IsString a, MonadIO m)
=> Double
-> ObjType
-> a
-> Ent
-> SystemT Entity m ()
doorObjectAction dt t@ObjDoor s@"open" ent = do
emap (anEnt ent) $ do
mtime <- queryMaybe objStateTime
@ -39,8 +44,15 @@ doorObjectAction dt t@ObjDoor s@"open" ent = do
doorObjectAction _ _ _ _ = return ()
doorObjectTransition t@ObjDoor s _ ent (Just aent) = do
clearance <- head <$> efor (anEnt aent) (query clearanceLvl)
doorObjectTransition :: (MonadIO m, Eq a, IsString a)
=> ObjType
-> a
-> p
-> Ent
-> Maybe Ent
-> SystemT Entity m (Entity 'SetterOf)
doorObjectTransition t@ObjDoor _ _ ent (Just aent) = do
curClearance <- head <$> efor (anEnt aent) (query clearanceLvl)
e <- efor (anEnt ent) $ do
dir <- query rot
oclear <- query clearanceLvl
@ -52,7 +64,7 @@ doorObjectTransition t@ObjDoor s _ ent (Just aent) = do
fromString (show ent)
)
-- liftIO $ A.logIO A.Debug ("door clearance: " ++ show oclear ++ ", entity clearance: " ++ show clearance)
if clearance >= oclear
if curClearance >= oclear
then do
liftIO $ A.logIO
A.Verbose