-- | Random value library for arduino-copilot.
--
-- Here's an example that flashes the LED randomly.
--
-- > main :: IO ()
-- > main = arduino $ do
-- >	if firstIteration
-- > 		then randomSeedPin a0
-- > 		else do
-- > 			n <- input (random 10) :: Sketch (Behavior Word32)
-- > 			led =: (n >= 5)
--
-- The use of `firstIteration` makes the RNG be seeded in the first
-- iteration, and then random numbers are generated in subsequent
-- iterations. That's a typical pattern when using this module.

{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE RebindableSyntax #-}
{-# LANGUAGE TypeApplications #-}

module Copilot.Arduino.Library.Random (
        randomSeed,
        randomSeedPin,
        RandomSeed,
        RandomInput,
        random,
        randomR,
) where

import Copilot.Arduino hiding (show)
import Copilot.Arduino.Internals
import Control.Monad.Writer
import Data.Proxy
import Prelude ()
import qualified Prelude

-- | Use this to seed the RNG.
--
-- > randomSeed =: constant (1 :: Word8)
randomSeed :: RandomSeed
randomSeed = RandomSeed

data RandomSeed = RandomSeed

instance Output RandomSeed (Event () (Stream Word8)) where
        RandomSeed =: e = randomSeedWith e

-- Seeds with the first 8 bits read from the ADC, discarding the rest.
instance Output RandomSeed (Event () (Stream ADC)) where
        RandomSeed =: e = randomSeedWith e

randomSeedWith :: Typed a => Event p (Stream a) -> Sketch ()
randomSeedWith (Event n c) = do
                (f, triggername) <- defineTriggerAlias "randomSeed" mempty
                tell [(go triggername, \_ -> f)]
          where
                go triggername tl =
                        let c' = addTriggerLimit tl c
                        in trigger triggername c' [arg n]

-- | Seed the RNG by reading from an analog input pin.
--
-- If the pin is left unconnected, noise will be read from it.
randomSeedPin :: IsAnalogInputPin t => Pin t -> Sketch ()
randomSeedPin p = do
        seed <- input p :: Sketch (Behavior ADC)
        randomSeed =: seed

data RandomInput = RandomInput Word32 Word32

-- | Generate a random number, up to but exclusive of an upper bound.
--
-- > n <- input (random 10)
random :: Word32 -> RandomInput
random hi = RandomInput 0 hi

-- | Generate a random number in the range (lo, hi). The number will be 
-- @>= lo@ and @< hi@
--
-- > n <- input (randomR 5 10) :: Sketch (Behavior Word32)
randomR :: (Word32, Word32) -> RandomInput
randomR (lo, hi) = RandomInput lo hi

instance Input RandomInput Word32 where
        input' (RandomInput lo hi) interpretvalues = do
                i <- getUniqueId "random"
                let varname = uniqueName "randomval" i
                let word32 = showCType (Proxy @Word32)
                mkInput $ InputSource
                        { setupInput = []
                        , defineVar = mkCChunk
                                [ CLine $ word32 <> " " <> varname <> ";"
                                ]
                        , inputPinmode = mempty
                        , readInput = mkCChunk
                                [ CLine $ varname <> " = random"
                                        <> "("
                                                <> Prelude.show lo
                                                <> ", "
                                                <> Prelude.show hi
                                        <> ");"]
                        , inputStream = extern varname interpretvalues'
                        }
          where
                interpretvalues'
                        | null interpretvalues = Nothing
                        | otherwise = Just interpretvalues