{-# LANGUAGE LambdaCase, ApplicativeDo #-}
module RetroClash.Port
    ( PortCommand(..)
    , portFromAddr
    ) where

import Clash.Prelude

import Data.Bifunctor
import Data.Bifoldable
import Data.Bitraversable

data PortCommand port a
    = ReadPort port
    | WritePort port a
    deriving ((forall x. PortCommand port a -> Rep (PortCommand port a) x)
-> (forall x. Rep (PortCommand port a) x -> PortCommand port a)
-> Generic (PortCommand port a)
forall x. Rep (PortCommand port a) x -> PortCommand port a
forall x. PortCommand port a -> Rep (PortCommand port a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall port a x. Rep (PortCommand port a) x -> PortCommand port a
forall port a x. PortCommand port a -> Rep (PortCommand port a) x
$cfrom :: forall port a x. PortCommand port a -> Rep (PortCommand port a) x
from :: forall x. PortCommand port a -> Rep (PortCommand port a) x
$cto :: forall port a x. Rep (PortCommand port a) x -> PortCommand port a
to :: forall x. Rep (PortCommand port a) x -> PortCommand port a
Generic, HasCallStack => String -> PortCommand port a
PortCommand port a -> Bool
PortCommand port a -> ()
PortCommand port a -> PortCommand port a
(HasCallStack => String -> PortCommand port a)
-> (PortCommand port a -> Bool)
-> (PortCommand port a -> PortCommand port a)
-> (PortCommand port a -> ())
-> NFDataX (PortCommand port a)
forall a.
(HasCallStack => String -> a)
-> (a -> Bool) -> (a -> a) -> (a -> ()) -> NFDataX a
forall port a.
(NFDataX port, NFDataX a, HasCallStack) =>
String -> PortCommand port a
forall port a.
(NFDataX port, NFDataX a) =>
PortCommand port a -> Bool
forall port a.
(NFDataX port, NFDataX a) =>
PortCommand port a -> ()
forall port a.
(NFDataX port, NFDataX a) =>
PortCommand port a -> PortCommand port a
$cdeepErrorX :: forall port a.
(NFDataX port, NFDataX a, HasCallStack) =>
String -> PortCommand port a
deepErrorX :: HasCallStack => String -> PortCommand port a
$chasUndefined :: forall port a.
(NFDataX port, NFDataX a) =>
PortCommand port a -> Bool
hasUndefined :: PortCommand port a -> Bool
$censureSpine :: forall port a.
(NFDataX port, NFDataX a) =>
PortCommand port a -> PortCommand port a
ensureSpine :: PortCommand port a -> PortCommand port a
$crnfX :: forall port a.
(NFDataX port, NFDataX a) =>
PortCommand port a -> ()
rnfX :: PortCommand port a -> ()
NFDataX, Int -> PortCommand port a -> ShowS
[PortCommand port a] -> ShowS
PortCommand port a -> String
(Int -> PortCommand port a -> ShowS)
-> (PortCommand port a -> String)
-> ([PortCommand port a] -> ShowS)
-> Show (PortCommand port a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall port a.
(Show port, Show a) =>
Int -> PortCommand port a -> ShowS
forall port a. (Show port, Show a) => [PortCommand port a] -> ShowS
forall port a. (Show port, Show a) => PortCommand port a -> String
$cshowsPrec :: forall port a.
(Show port, Show a) =>
Int -> PortCommand port a -> ShowS
showsPrec :: Int -> PortCommand port a -> ShowS
$cshow :: forall port a. (Show port, Show a) => PortCommand port a -> String
show :: PortCommand port a -> String
$cshowList :: forall port a. (Show port, Show a) => [PortCommand port a] -> ShowS
showList :: [PortCommand port a] -> ShowS
Show)

instance Functor (PortCommand port) where
    {-# INLINE fmap #-}
    fmap :: forall a b. (a -> b) -> PortCommand port a -> PortCommand port b
fmap a -> b
f = \case
        ReadPort port
port -> port -> PortCommand port b
forall port a. port -> PortCommand port a
ReadPort port
port
        WritePort port
port a
val -> port -> b -> PortCommand port b
forall port a. port -> a -> PortCommand port a
WritePort port
port (a -> b
f a
val)

instance Bifunctor PortCommand where
    {-# INLINE bimap #-}
    bimap :: forall a b c d.
(a -> b) -> (c -> d) -> PortCommand a c -> PortCommand b d
bimap a -> b
f c -> d
g = \case
        ReadPort a
port -> b -> PortCommand b d
forall port a. port -> PortCommand port a
ReadPort (a -> b
f a
port)
        WritePort a
port c
val -> b -> d -> PortCommand b d
forall port a. port -> a -> PortCommand port a
WritePort (a -> b
f a
port) (c -> d
g c
val)

    {-# INLINE second #-}
    second :: forall b c a. (b -> c) -> PortCommand a b -> PortCommand a c
second = (b -> c) -> PortCommand a b -> PortCommand a c
forall a b. (a -> b) -> PortCommand a a -> PortCommand a b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap

instance Bifoldable PortCommand where
    {-# INLINE bifoldMap #-}
    bifoldMap :: forall m a b.
Monoid m =>
(a -> m) -> (b -> m) -> PortCommand a b -> m
bifoldMap a -> m
f b -> m
g = \case
        ReadPort a
port -> a -> m
f a
port
        WritePort a
port b
val -> a -> m
f a
port m -> m -> m
forall a. Semigroup a => a -> a -> a
<> b -> m
g b
val

instance Bitraversable PortCommand where
    {-# INLINE bitraverse #-}
    bitraverse :: forall (f :: Type -> Type) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> PortCommand a b -> f (PortCommand c d)
bitraverse a -> f c
f b -> f d
g = \case
        ReadPort a
port -> c -> PortCommand c d
forall port a. port -> PortCommand port a
ReadPort (c -> PortCommand c d) -> f c -> f (PortCommand c d)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f c
f a
port
        WritePort a
port b
val -> c -> d -> PortCommand c d
forall port a. port -> a -> PortCommand port a
WritePort (c -> d -> PortCommand c d) -> f c -> f (d -> PortCommand c d)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f c
f a
port f (d -> PortCommand c d) -> f d -> f (PortCommand c d)
forall a b. f (a -> b) -> f a -> f b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> b -> f d
g b
val

portFromAddr :: Signal dom (Maybe port) -> Signal dom (Maybe a) -> Signal dom (Maybe (PortCommand port a))
portFromAddr :: forall (dom :: Symbol) port a.
Signal dom (Maybe port)
-> Signal dom (Maybe a) -> Signal dom (Maybe (PortCommand port a))
portFromAddr Signal dom (Maybe port)
addr Signal dom (Maybe a)
w = do
    Maybe port
addr <- Signal dom (Maybe port)
addr
    Maybe a
w <- Signal dom (Maybe a)
w
    pure $ case (Maybe port
addr, Maybe a
w) of
        (Just port
addr, Maybe a
Nothing) -> PortCommand port a -> Maybe (PortCommand port a)
forall a. a -> Maybe a
Just (PortCommand port a -> Maybe (PortCommand port a))
-> PortCommand port a -> Maybe (PortCommand port a)
forall a b. (a -> b) -> a -> b
$ port -> PortCommand port a
forall port a. port -> PortCommand port a
ReadPort port
addr
        (Just port
addr, Just a
w) -> PortCommand port a -> Maybe (PortCommand port a)
forall a. a -> Maybe a
Just (PortCommand port a -> Maybe (PortCommand port a))
-> PortCommand port a -> Maybe (PortCommand port a)
forall a b. (a -> b) -> a -> b
$ port -> a -> PortCommand port a
forall port a. port -> a -> PortCommand port a
WritePort port
addr a
w
        (Maybe port, Maybe a)
_ -> Maybe (PortCommand port a)
forall a. Maybe a
Nothing