package Uart where

import FIFOF
import GetPut
import Util

interface Clock =
  clk :: Bool

mkDivider :: Integer -> Module Clock
mkDivider divisor =
  module
    count :: Reg (Bit 32) <- mkReg 0

    rules
      "increment_divider": when True ==> do
        if count == fromInteger (divisor - 1) then do
          count := 0
        else
          count := count + 1

    interface Clock
      clk = count == 0

-- | A shift register.
interface ShiftRegister item numItems =
  -- | Shifts an item into the shift register.
  put :: Put item
  -- | Shifts an item out of the shift register.
  get :: Get item
  -- | The number of items currently in the shift register.
  size :: Bit (TLog numItems)

-- | Creates a shift register.
mkShiftRegister :: (Bits item itemSize) => Module (ShiftRegister item numItems)
mkShiftRegister =
  module
    size :: Reg (Bit (TLog numItems)) <- mkReg 0
    buffer :: Reg (Bit (TMul itemSize numItems)) <- mkReg 0

    interface ShiftRegister
      put = interface Put
              put _ = return ()
      get = interface Get
              get = return (unpack 0) when False
      size = size

-- | The state of the TX side of the UART.
data TxState
  = -- | The UART is not currently sending anything. May transition to
    -- 'Start b' when ready to send 'b'.
    Idle
  | -- | The UART is about to send the start bit. 'Start b' transitions to
    -- 'Data b 7' by sending the start bit.
    Start (Bit 8)
  | -- | The UART is about to send a data bit. 'Data b n' transitions to
    -- 'Data (b >> 1) (n - 1)' by sending a data bit. 'Data b 0' transitions to
    -- 'Stop' by sending the last data bit.
    Data (Bit 8) (Bit 3)
  | -- | The UART is about to send the stop bit. Transitions to 'Idle'.
    Stop
  deriving (Bits)

-- | The TX side of the UART.
interface TxUart =
  -- | The TX pin.
  pin :: Bit 1
  -- Writes a byte to the UART.
  send :: Put (Bit 8)

mkTxUart :: Clock -> Integer -> Module TxUart
mkTxUart baudClock bufferSize =
  module
    fifo :: FIFOF (Bit 8) <- mkSizedFIFOF bufferSize
    state <- mkReg Idle
    rules
      "uart_tx_send": when baudClock.clk ==> do
        case state of
          Idle -> do
            b <- (toGet fifo).get
            state := Start b
          Start b -> do
            state := Data b 7
          Data _ 0 -> do
            state := Stop
          Data b n -> do
            state := Data (b >> 1) (n - 1)
          Stop -> do
            state := Idle
    interface TxUart
      pin = case state of
              Idle -> 1
              Start _ -> 0
              Data b _ -> b[0:0]
              Stop -> 1
      send = toPut fifo

-- An 8n1 UART.
interface Uart =
  -- The RX pin.
  rxPin :: Bit 1 -> Action
  -- The TX pin.
  txPin :: Bit 1

  -- Reads a byte from the UART.
  recv :: Get (Bit 8)
  -- Writes a byte to the UART.
  send :: Put (Bit 8)

mkUart :: Integer -> Module Uart
mkUart baudDivisor =
  module
    baudClock <- mkDivider baudDivisor
    tx <- mkTxUart baudClock 1

    interface Uart
      rxPin _bit = when_ baudClock.clk $ do
        return () -- TODO
      txPin = tx.pin

      recv = interface Get
               get = return 0 when False
      send = tx.send

-- vim: set ft=haskell :