Implement messages
Implement messages almost the same as in the Rust version, only with YAML instead of TOML this time, and a regular old mustache template instead of something handrolled. Besides that, pretty much everything here is the same.
This commit is contained in:
parent
4ef19aa35a
commit
2fd3e4c9ad
13 changed files with 587 additions and 17 deletions
40
src/Xanthous/Random.hs
Normal file
40
src/Xanthous/Random.hs
Normal file
|
|
@ -0,0 +1,40 @@
|
|||
{-# LANGUAGE TupleSections #-}
|
||||
{-# LANGUAGE UndecidableInstances #-}
|
||||
|
||||
module Xanthous.Random
|
||||
( Choose(..)
|
||||
, ChooseElement(..)
|
||||
) where
|
||||
|
||||
import Xanthous.Prelude
|
||||
import Data.List.NonEmpty (NonEmpty)
|
||||
import System.Random
|
||||
import Control.Monad.Random.Class (MonadRandom(getRandomR))
|
||||
|
||||
class Choose a where
|
||||
type RandomResult a
|
||||
choose :: MonadRandom m => a -> m (RandomResult a)
|
||||
|
||||
newtype ChooseElement a = ChooseElement a
|
||||
|
||||
instance MonoFoldable a => Choose (ChooseElement a) where
|
||||
type RandomResult (ChooseElement a) = Maybe (Element a)
|
||||
choose (ChooseElement xs) = do
|
||||
chosenIdx <- getRandomR (0, olength xs - 1)
|
||||
let pick _ (Just x) = Just x
|
||||
pick (x, i) Nothing
|
||||
| i == chosenIdx = Just x
|
||||
| otherwise = Nothing
|
||||
pure $ ofoldr pick Nothing $ zip (toList xs) [0..]
|
||||
|
||||
instance MonoFoldable a => Choose (NonNull a) where
|
||||
type RandomResult (NonNull a) = Element a
|
||||
choose
|
||||
= fmap (fromMaybe (error "unreachable")) -- why not lol
|
||||
. choose
|
||||
. ChooseElement
|
||||
. toNullable
|
||||
|
||||
instance Choose (NonEmpty a) where
|
||||
type RandomResult (NonEmpty a) = a
|
||||
choose = choose . fromNonEmpty @[_]
|
||||
Loading…
Add table
Add a link
Reference in a new issue