Haskell Blinker

{-# OPTIONS_GHC -fno-warn-orphans #-}
module Blinker where

import Clash.Prelude
import Clash.Intel.ClockGen
import Clash.Annotations.SynthesisAttributes
createDomain vSystem{vName="Input", vPeriod=20000}
createDomain vSystem{vName="Dom20MHz", vPeriod=50000}

topEntity ::
  Clock Input
    `Annotate` 'StringAttr "chip_pin" "R8"
    `Annotate` 'StringAttr
                "altera_attribute" "-name IO_STANDARD \"3.3-V LVTTL\"" ->
  Signal Input Bool
    `Annotate` 'StringAttr "chip_pin" "J15"
    `Annotate` 'StringAttr
                "altera_attribute" "-name IO_STANDARD \"3.3-V LVTTL\"" ->
  Signal Dom20MHz Bit
    `Annotate` 'StringAttr "chip_pin" "E1"
    `Annotate` 'StringAttr
                "altera_attribute" "-name IO_STANDARD \"3.3-V LVTTL\"" ->
  Signal Dom20MHz (BitVector 8)
    `Annotate` 'StringAttr
                "chip_pin" "L3, B1, F3, D1, A11, B13, A13, A15"
    `Annotate` 'StringAttr
                "altera_attribute" "-name IO_STANDARD \"3.3-V LVTTL\""
topEntity clk50Mhz rstBtn modeBtn =
  exposeClockResetEnable
    (mealy blinkerT initialStateBlinkerT . isRising 1)
    clk20Mhz
    rstSync
    en
    modeBtn
  where
  en = enableGen
  initialStateBlinkerT = (1, Rotate, 0)
  rst = unsafeFromLowPolarity rstBtn
  (clk20Mhz, pllStable) =
    altpll
      @Dom20MHz
      (SSymbol @"altpll20")
      clk50Mhz
      rst
  rstSync =
    resetSynchronizer
      clk20Mhz
      (unsafeFromLowPolarity pllStable)
data LedMode
  = Rotate
  | Complement
  deriving (Generic, NFDataX)

flipMode :: LedMode -> LedMode
flipMode Rotate = Complement
flipMode Complement = Rotate

-- Finally, the actual behavior of the circuit
blinkerT ::
  (BitVector 8, LedMode, Index 6660000) ->
  Bool ->
  ((BitVector 8, LedMode, Index 6660000), BitVector 8)
blinkerT (leds, mode, cntr) key1R = ((ledsN, modeN, cntrN), leds)
  where
    -- clock frequency = 20e6  (20 MHz)
    -- led update rate = 333e-3 (every 333ms)
    cnt_max = maxBound :: Index 6660000 -- 20e6 * 333e-3

    cntrN | cntr == cnt_max = 0
          | otherwise       = cntr + 1

    modeN | key1R     = flipMode mode
          | otherwise = mode

    ledsN | cntr == 0 =
              case mode of
                Rotate -> rotateL leds 1
                Complement -> complement leds
          | otherwise = leds