module System.Hardware.Acquisition
( Value
, Measurement (..)
, Sample (..)
, Channel (..)
, ioChannel
, constChannel
, Protocol (..)
, Connection (..)
, Adaptor
, (=>>=)
) where
import Prelude
import Control.Monad.Error
import Data.Word
import qualified System.IO as IO
type Value = Double
data Measurement
= Whatever
| VoltageAC
| VoltageDC
| CurrentAC
| CurrentDC
| Resistance
| Capacitance
| Inductance
| Temperature
| DCGain
| DutyCycle
| Frequency
| Length
| Illuminance
| Mass
| Force
| Time
deriving (Eq, Show)
data Sample = Sample
{ measurement :: Measurement
, value :: Value
} deriving (Eq, Show)
sample :: Value -> Sample
sample v = Sample { measurement = Whatever, value = v }
sampleUnOp :: (Value -> Value) -> Sample -> Sample
sampleUnOp f x = x { value = f (value x) }
sampleBinOp :: (Value -> Value -> Value) -> Sample -> Sample -> Sample
sampleBinOp (?) x y = sample (value x ? value y)
instance Num Sample where
(+) = sampleBinOp (+)
(*) = sampleBinOp (*)
() = sampleBinOp ()
negate = sampleUnOp negate
abs = sampleUnOp abs
signum = sampleUnOp signum
fromInteger = sample . (fromInteger :: Integer -> Value)
instance Fractional Sample where
(/) = sampleBinOp (/)
recip = sampleUnOp recip
fromRational = sample . (fromRational :: Rational -> Value)
instance Floating Sample where
pi = sample pi
exp = sampleUnOp exp
sqrt = sampleUnOp sqrt
log = sampleUnOp log
(**) = sampleBinOp (**)
logBase = sampleBinOp logBase
sin = sampleUnOp sin
tan = sampleUnOp tan
cos = sampleUnOp cos
asin = sampleUnOp asin
atan = sampleUnOp atan
acos = sampleUnOp acos
sinh = sampleUnOp sinh
tanh = sampleUnOp tanh
cosh = sampleUnOp cosh
asinh = sampleUnOp asinh
atanh = sampleUnOp atanh
acosh = sampleUnOp acosh
data Connection = Connection
{ getWord8 :: (Error e, MonadError e m, MonadIO m) => m Word8
, disconnect :: MonadIO m => m ()
} deriving ()
data Protocol = Protocol
{ initialise :: MonadIO m => m [Channel]
, destroy :: MonadIO m => m ()
} deriving ()
data Channel = Channel
{ getSample :: (Error e, MonadError e m, MonadIO m) => m Sample
, close :: MonadIO m => m ()
} deriving ()
ioChannel :: IO Sample -> Channel
ioChannel get = Channel
{ getSample = liftIO get
, close = return () }
constChannel :: Sample -> Channel
constChannel = ioChannel . return
instance Eq Channel where
_ == _ = False
instance Show Channel where
show _ = "<<Channel>>"
channelUnOp :: (Sample -> Sample) -> Channel -> Channel
channelUnOp f c = c { getSample = return f `ap` getSample c }
channelBinOp :: (Sample -> Sample -> Sample) -> Channel -> Channel -> Channel
channelBinOp (?) a b = Channel
{ getSample = return (?) `ap` getSample a `ap` getSample b
, close = return () }
instance Num Channel where
(+) = channelBinOp (+)
(*) = channelBinOp (*)
() = channelBinOp ()
negate = channelUnOp negate
abs = channelUnOp abs
signum = channelUnOp signum
fromInteger = constChannel . fromInteger
instance Fractional Channel where
(/) = channelBinOp (/)
recip = channelUnOp recip
fromRational = constChannel . fromRational
instance Floating Channel where
pi = constChannel pi
exp = channelUnOp exp
sqrt = channelUnOp sqrt
log = channelUnOp log
(**) = channelBinOp (**)
logBase = channelBinOp logBase
sin = channelUnOp sin
tan = channelUnOp tan
cos = channelUnOp cos
asin = channelUnOp asin
atan = channelUnOp atan
acos = channelUnOp acos
sinh = channelUnOp sinh
tanh = channelUnOp tanh
cosh = channelUnOp cosh
asinh = channelUnOp asinh
atanh = channelUnOp atanh
acosh = channelUnOp acosh
type Adaptor m = Channel -> m Channel
(=>>=) :: Monad m => Adaptor m -> Adaptor m -> Adaptor m
(a =>>= b) c = a c >>= b