-- | 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
randomSeed = RandomSeed
RandomSeed

data RandomSeed = RandomSeed

instance Output Arduino RandomSeed (Event () (Stream Word8)) where
	RandomSeed
RandomSeed =: :: RandomSeed -> Event () (Stream Word8) -> GenSketch Arduino ()
=: Event () (Stream Word8)
e = forall a p. Typed a => Event p (Stream a) -> GenSketch Arduino ()
randomSeedWith Event () (Stream Word8)
e

-- Seeds with the first 8 bits read from the ADC, discarding the rest.
instance Output Arduino RandomSeed (Event () (Stream ADC)) where
	RandomSeed
RandomSeed =: :: RandomSeed -> Event () (Stream ADC) -> GenSketch Arduino ()
=: Event () (Stream ADC)
e = forall a p. Typed a => Event p (Stream a) -> GenSketch Arduino ()
randomSeedWith Event () (Stream ADC)
e

randomSeedWith :: Typed a => Event p (Stream a) -> Sketch ()
randomSeedWith :: forall a p. Typed a => Event p (Stream a) -> GenSketch Arduino ()
randomSeedWith (Event Stream a
n Stream Bool
c) = do
		(GenFramework Arduino
f, String
triggername) <- forall ctx.
String
-> GenFramework ctx -> GenSketch ctx (GenFramework ctx, String)
defineTriggerAlias String
"randomSeed" forall a. Monoid a => a
mempty
		forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [(String -> TriggerLimit -> Spec
go String
triggername, \TriggerLimit
_ -> GenFramework Arduino
f)]
	  where
		go :: String -> TriggerLimit -> Spec
go String
triggername TriggerLimit
tl = 
			let c' :: Stream Bool
c' = TriggerLimit -> Stream Bool -> Stream Bool
addTriggerLimit TriggerLimit
tl Stream Bool
c
			in String -> Stream Bool -> [Arg] -> Spec
trigger String
triggername Stream Bool
c' [forall a. Typed a => Stream a -> Arg
arg Stream a
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 :: forall (t :: [PinCapabilities]).
IsAnalogInputPin t =>
Pin t -> GenSketch Arduino ()
randomSeedPin Pin t
p = do
	Stream ADC
seed <- forall ctx o t. Input ctx o t => o -> GenSketch ctx (Behavior t)
input Pin t
p :: Sketch (Behavior ADC)
	RandomSeed
randomSeed forall ctx o t. Output ctx o t => o -> t -> GenSketch ctx ()
=: Stream ADC
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 :: Word32 -> RandomInput
random Word32
hi = Word32 -> Word32 -> RandomInput
RandomInput Word32
0 Word32
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 :: (Word32, Word32) -> RandomInput
randomR (Word32
lo, Word32
hi) = Word32 -> Word32 -> RandomInput
RandomInput Word32
lo Word32
hi

instance Input Arduino RandomInput Word32 where
	input' :: RandomInput -> [Word32] -> GenSketch Arduino (Behavior Word32)
input' (RandomInput Word32
lo Word32
hi) [Word32]
interpretvalues = do
		UniqueId
i <- forall ctx. String -> GenSketch ctx UniqueId
getUniqueId String
"random"
		let varname :: String
varname = String -> UniqueId -> String
uniqueName String
"randomval" UniqueId
i
		let word32 :: String
word32 = forall {k} (t :: k). ShowCType t => Proxy t -> String
showCType (forall {k} (t :: k). Proxy t
Proxy @Word32)
		forall ctx t. MkInputSource ctx t -> GenSketch ctx (Behavior t)
mkInput forall a b. (a -> b) -> a -> b
$ InputSource
			{ setupInput :: [CChunk]
setupInput = []
			, defineVar :: [CChunk]
defineVar = [CLine] -> [CChunk]
mkCChunk
				[ String -> CLine
CLine forall a b. (a -> b) -> a -> b
$ String
word32 forall a. Semigroup a => a -> a -> a
<> String
" " forall a. Semigroup a => a -> a -> a
<> String
varname forall a. Semigroup a => a -> a -> a
<> String
";"
				]
			, inputPinmode :: Map Arduino PinMode
inputPinmode = forall a. Monoid a => a
mempty
			, readInput :: [CChunk]
readInput = [CLine] -> [CChunk]
mkCChunk
				[ String -> CLine
CLine forall a b. (a -> b) -> a -> b
$ String
varname forall a. Semigroup a => a -> a -> a
<> String
" = random"
					forall a. Semigroup a => a -> a -> a
<> String
"("
						forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
Prelude.show Word32
lo
						forall a. Semigroup a => a -> a -> a
<> String
", " 
						forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
Prelude.show Word32
hi
					forall a. Semigroup a => a -> a -> a
<> String
");"]
			, inputStream :: Behavior Word32
inputStream = forall a. Typed a => String -> Maybe [a] -> Stream a
extern String
varname Maybe [Word32]
interpretvalues'
			}
  	  where
		interpretvalues' :: Maybe [Word32]
interpretvalues'
			| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Word32]
interpretvalues = forall a. Maybe a
Nothing
			| Bool
otherwise = forall a. a -> Maybe a
Just [Word32]
interpretvalues