-------------------------------------------------------------------------------------------------
-- |
-- Module      :  System.Hardware.Arduino.Parts.ShiftRegisters
-- Copyright   :  (c) Levent Erkok
-- License     :  BSD3
-- Maintainer  :  erkokl@gmail.com
-- Stability   :  experimental
--
-- Abstractions for shift-register IC parts.
-------------------------------------------------------------------------------------------------

{-# LANGUAGE NamedFieldPuns #-}
module System.Hardware.Arduino.Parts.ShiftRegisters(
     -- * Shift register abstraction
     ShiftRegister(..)
     -- * Supported shift-registers
     -- ** Texas Instruments 7HC595
   , SR_74HC595(..)
   ) where

import Data.Foldable (forM_)

import System.Hardware.Arduino
import System.Hardware.Arduino.Data (die)

-- | A shift-register class as supported by the hArduino library.
class ShiftRegister a where
  -- | Capacity
  size :: a -> Int
  -- | Display name
  name :: a -> String
  -- | Data sheet (typically a URL)
  dataSheet :: a -> String
  -- | Initialize the shift-register
  initialize :: a -> Arduino ()
  -- | Disable the output, putting it into high-impedance state
  disable :: a -> Arduino ()
  -- | Enable the output, getting it out of the high-impedance state
  enable :: a -> Arduino ()
  -- | Clear the contents
  clear  :: a -> Arduino ()
  -- | Push a single bit down the shift-register
  push   :: a -> Bool -> Arduino ()
  -- | Store the pushed-in values in the storage register
  store  :: a -> Arduino ()
  -- | Read the current value stored
  read :: a -> Arduino [Bool]

-- | The Texas-Instruments 74HC595 8-bit shift register with 3-state
-- outputs. Data sheet: <http://www.ti.com/lit/ds/symlink/sn74hc595.pdf>.
--
-- This is a versatile 8-bit shift-register with separate serial and register
-- clocks, allowing shifting to be done while the output remains untouched. We
-- model all control pins provided. Note that the enable and clear lines are
-- negated.
data SR_74HC595 = SR_74HC595 {
               SR_74HC595 -> Pin
serial  :: Pin         -- ^ Chip Pin: 14: Serial input
             , SR_74HC595 -> Pin
nEnable :: Pin         -- ^ Chip Pin: 13: Negated output-enable
             , SR_74HC595 -> Pin
rClock  :: Pin         -- ^ Chip Pin: 12: Register clock, positive triggered
             , SR_74HC595 -> Pin
sClock  :: Pin         -- ^ Chip Pin: 11: Serial clock, positive triggered
             , SR_74HC595 -> Pin
nClear  :: Pin         -- ^ Chip Pin: 10: Negated clear-data
             , SR_74HC595 -> Maybe [Pin]
mbBits  :: Maybe [Pin] -- ^ Chip Pins: 15, 1-7, and 8: Sequence of output bits, connect only if reading is necessary
             }

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

-- | Execute action, followed by a simulated falling edge on the given clock
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