bf-optimize/test/Arbitrary/ValidBrainfuckText.hs

48 lines
1.5 KiB
Haskell

{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE DerivingStrategies #-}
module Arbitrary.ValidBrainfuckText (ValidBrainfuckText(..)) where
import Data.Text (Text)
import Test.QuickCheck.Arbitrary (Arbitrary (arbitrary))
import Test.QuickCheck.Gen (Gen, sized, frequency, oneof, resize)
import Data.Coerce (coerce)
import qualified Data.Text as Text
newtype ValidBrainfuckText = ValidBrainfuckText { get :: Text }
deriving stock Show
instance Arbitrary ValidBrainfuckText where
arbitrary :: Gen ValidBrainfuckText
arbitrary = coerce . fmap Text.pack $ character []
where
character rest = do
body <- frequency
[ (1, comment)
, (9, operator)
]
sized $ \ size -> frequency
[ (1 , pure body)
, (size, character body)
]
where
operator = let
simpleOperator = oneof $ map (pure . (:rest)) "+-<>,."
loopOperator = fmap ('[':) . sized $ \ s -> resize (s `div` 8) (character (']':rest))
in frequency
[ (3, simpleOperator)
, (1, loopOperator)
]
comment = do
commentChar <- oneof $ map pure "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
pure $ commentChar : rest
-- >>> import Test.QuickCheck.Gen (generate)
-- >>> generate $ (arbitrary :: Gen ValidBrainfuckText)
-- ValidBrainfuckText {get = "<[><]>[>],>+,[.-K.]+.>[<],z[p[[<]]+<],<[+]+[P[+][[e]]+,]+,.[-][[<],>>++]+"}