diff options
Diffstat (limited to 'hsm-status/Hsm')
-rw-r--r-- | hsm-status/Hsm/Status.hs | 41 | ||||
-rw-r--r-- | hsm-status/Hsm/Status/Error.hs | 13 |
2 files changed, 41 insertions, 13 deletions
diff --git a/hsm-status/Hsm/Status.hs b/hsm-status/Hsm/Status.hs new file mode 100644 index 0000000..8154611 --- /dev/null +++ b/hsm-status/Hsm/Status.hs @@ -0,0 +1,41 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE OverloadedRecordDot #-} +{-# LANGUAGE OverloadedStrings #-} + +module Hsm.Status + ( StatusEnv(..) + , statusEnvDefault + , status + ) where + +import Foreign.Ptr (Ptr) +import GHC.Records (HasField) +import Hsm.GPIO (GPIO(..), LineRequest, active, inactive, setPins) +import Hsm.Log qualified as L + +data StatusEnv = StatusEnv + { gpioOk :: GPIO + , gpioError :: GPIO + } + +statusEnvDefault :: StatusEnv +statusEnvDefault = StatusEnv {gpioOk = GPIO17, gpioError = GPIO27} + +status :: + HasField "statusEnv" env StatusEnv + => Ptr LineRequest + -> env + -> [Bool] + -> IO () +status lineRequest env signals = do + if and signals + then do + logMsg "All signals OK" + setPins lineRequest [env.statusEnv.gpioError] inactive + setPins lineRequest [env.statusEnv.gpioOk] active + else do + logMsg "Error signal received" + setPins lineRequest [env.statusEnv.gpioError] active + setPins lineRequest [env.statusEnv.gpioOk] inactive + where + logMsg = L.logMsg ["status"] diff --git a/hsm-status/Hsm/Status/Error.hs b/hsm-status/Hsm/Status/Error.hs deleted file mode 100644 index 2853d6b..0000000 --- a/hsm-status/Hsm/Status/Error.hs +++ /dev/null @@ -1,13 +0,0 @@ -{-# LANGUAGE DeriveAnyClass #-} - -module Hsm.Status.Error - ( Error(Error) - ) where - -import Data.Binary (Binary) -import Data.Text (Text) -import GHC.Generics (Generic) - -data Error = - Error Int Text - deriving (Binary, Generic, Show) |