{-# LANGUAGE NamedFieldPuns #-}
module System.Hardware.Arduino.Parts.ShiftRegisters(
ShiftRegister(..)
, SR_74HC595(..)
) where
import Data.Foldable (forM_)
import System.Hardware.Arduino
import System.Hardware.Arduino.Data (die)
class ShiftRegister a where
size :: a -> Int
name :: a -> String
dataSheet :: a -> String
initialize :: a -> Arduino ()
disable :: a -> Arduino ()
enable :: a -> Arduino ()
clear :: a -> Arduino ()
push :: a -> Bool -> Arduino ()
store :: a -> Arduino ()
read :: a -> Arduino [Bool]
data SR_74HC595 = SR_74HC595 {
SR_74HC595 -> Pin
serial :: Pin
, SR_74HC595 -> Pin
nEnable :: Pin
, SR_74HC595 -> Pin
rClock :: Pin
, SR_74HC595 -> Pin
sClock :: Pin
, SR_74HC595 -> Pin
nClear :: Pin
, SR_74HC595 -> Maybe [Pin]
mbBits :: Maybe [Pin]
}
instance ShiftRegister SR_74HC595 where
size :: SR_74HC595 -> Int
size SR_74HC595
_ = Int
8
name :: SR_74HC595 -> String
name SR_74HC595
_ = String
"TI SR_74HC595"
dataSheet :: SR_74HC595 -> String
dataSheet SR_74HC595
_ = String
"http://www.ti.com/lit/ds/symlink/sn74hc595.pdf"
initialize :: SR_74HC595 -> Arduino ()
initialize sr :: SR_74HC595
sr@SR_74HC595{Pin
nEnable :: Pin
nEnable :: SR_74HC595 -> Pin
nEnable, Pin
serial :: Pin
serial :: SR_74HC595 -> Pin
serial, Pin
rClock :: Pin
rClock :: SR_74HC595 -> Pin
rClock, Pin
sClock :: Pin
sClock :: SR_74HC595 -> Pin
sClock, Pin
nClear :: Pin
nClear :: SR_74HC595 -> Pin
nClear, Maybe [Pin]
mbBits :: Maybe [Pin]
mbBits :: SR_74HC595 -> Maybe [Pin]
mbBits} =
do forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Pin -> PinMode -> Arduino ()
`setPinMode` PinMode
OUTPUT) [Pin
nEnable, Pin
nClear, Pin
serial, Pin
rClock, Pin
sClock]
forall a. ShiftRegister a => a -> Arduino ()
clear SR_74HC595
sr
forall a. ShiftRegister a => a -> Arduino ()
enable SR_74HC595
sr
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe [Pin]
mbBits (forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Pin -> PinMode -> Arduino ()
`setPinMode` PinMode
INPUT))
disable :: SR_74HC595 -> Arduino ()
disable SR_74HC595{Pin
nEnable :: Pin
nEnable :: SR_74HC595 -> Pin
nEnable} = Pin -> Bool -> Arduino ()
digitalWrite Pin
nEnable Bool
True
enable :: SR_74HC595 -> Arduino ()
enable SR_74HC595{Pin
nEnable :: Pin
nEnable :: SR_74HC595 -> Pin
nEnable} = Pin -> Bool -> Arduino ()
digitalWrite Pin
nEnable Bool
False
clear :: SR_74HC595 -> Arduino ()
clear SR_74HC595{Pin
nClear :: Pin
nClear :: SR_74HC595 -> Pin
nClear} = do Pin -> Bool -> Arduino ()
digitalWrite Pin
nClear Bool
False
Pin -> Bool -> Arduino ()
digitalWrite Pin
nClear Bool
True
push :: SR_74HC595 -> Bool -> Arduino ()
push SR_74HC595{Pin
serial :: Pin
serial :: SR_74HC595 -> Pin
serial, Pin
sClock :: Pin
sClock :: SR_74HC595 -> Pin
sClock} Bool
b = forall a. Pin -> Arduino a -> Arduino a
fallingEdge Pin
sClock forall a b. (a -> b) -> a -> b
$ Pin -> Bool -> Arduino ()
digitalWrite Pin
serial Bool
b
store :: SR_74HC595 -> Arduino ()
store SR_74HC595{Pin
rClock :: Pin
rClock :: SR_74HC595 -> Pin
rClock} = forall a. Pin -> Arduino a -> Arduino a
fallingEdge Pin
rClock (forall (m :: * -> *) a. Monad m => a -> m a
return ())
read :: SR_74HC595 -> Arduino [Bool]
read sr :: SR_74HC595
sr@SR_74HC595{Maybe [Pin]
mbBits :: Maybe [Pin]
mbBits :: SR_74HC595 -> Maybe [Pin]
mbBits} = case Maybe [Pin]
mbBits of
Maybe [Pin]
Nothing -> forall a. String -> [String] -> Arduino a
die (forall a. ShiftRegister a => a -> String
name SR_74HC595
sr forall a. [a] -> [a] -> [a]
++ String
": Not configured for bit-reading")
[ String
"Datasheet: " forall a. [a] -> [a] -> [a]
++ forall a. ShiftRegister a => a -> String
dataSheet SR_74HC595
sr
, String
"Make sure to set the `bits' field when configuring"
]
Just [Pin]
pins -> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Pin -> Arduino Bool
digitalRead [Pin]
pins
fallingEdge :: Pin -> Arduino a -> Arduino a
fallingEdge :: forall a. Pin -> Arduino a -> Arduino a
fallingEdge Pin
clk Arduino a
action = do a
r <- Arduino a
action
Pin -> Bool -> Arduino ()
digitalWrite Pin
clk Bool
True
Pin -> Bool -> Arduino ()
digitalWrite Pin
clk Bool
False
forall (m :: * -> *) a. Monad m => a -> m a
return a
r