D-flop with enable and clear, translated from VHDL to Haskell

Question

I am in the process of translating an implementation of dflop_en_clr from VHDL to Haskell:

if (reset = '1') then
 out_1 <= '0';
elsif rising_edge(clk) then
 if (clear_n = '0') then
 out_1 <= '0';
 elsif (enable = '1') then
 out_1 <= in_1;
 end if; 
end if;

Types to know:

data PIn = PIn { _in_1 :: Bit
 , _clk :: Bit
 , _reset :: Bool
 , _enable :: Bool
 , _clear_n :: Bool
 } deriving (Eq)
data St = St { _out_1 :: Bit
 } deriving (Eq)

First attempt

 onTrue :: St -> PIn -> Bool -> St
 onTrue st PIn{..} edgeDetect = shouldReset
 where
 shouldReset = if _reset then St 0 else risingEdge
 risingEdge = if edgeDetect then shouldClear else st
 shouldClear = if _clear_n then St 0 else enabled
 enabled = if _enable then st{ _out_1 = _in_1 } else st

Another:

onTrue'' :: St -> PIn -> Bool -> St
onTrue'' st PIn{..} risingEdge = if _reset then St 0
 else if risingEdge $
 if not _clear_n then St 0
 else if _enable then st{ _out_1 = _in_1 }
 else st
 else st

If I were to covert a more complicated nest logic then there would possible be a lot of extra "else"

Current:

ifTrueApplyFun :: Bool -> a -> (a -> a) -> a
ifTrueApplyFun cond value fun = if cond then fun value
 else value
ifTrueReturnFun :: Bool -> (a -> a) -> (a -> a)
ifTrueReturnFun cond fun = if cond then fun
 else id
onTrue' :: St -> PIn -> Bool -> St
onTrue' st PIn{..} risingEdge = if _reset then St 0
 else ifTrueApplyFun risingEdge st $
 if not _clear_n then (\_ -> St 0)
 else ifTrueReturnFun _enable (\newSt -> newSt{ _out_1 = _in_1 })

This is code that needs to be readable and testable.

Answer 1

I actually think your first attempt is the most readable. The advantage over the VDHL implementation is that you're annotating each case with a function name. This makes it more self-documenting.

I would just multi-line your if-statements, like this:

onTrue :: St -> PIn -> Bool -> St
onTrue st PIn{..} edgeDetect = shouldReset
 where
 nullState = St 0
 shouldReset =
 if _reset
 then nullState
 else risingEdge
 risingEdge =
 if edgeDetect
 then shouldClear
 else st
 shouldClear =
 if _clear_n
 then nullState
 else enabled
 enabled =
 if _enable
 then st{ _out_1 = _in_1 }
 else st