    {-# LANGUAGE FlexibleInstances #-}

    -- |
    -- Module      : Test.QuickCheck.Unicode
    -- Copyright   : (c) 2014-2017 Bryan O'Sullivan
    -- License     : BSD-style
    -- Maintainer  : bos@serpentine.com
    -- Stability   : stable
    -- Portability : portable
    --
    -- QuickCheck Generator and shrink functions for testing software that
    -- uses Unicode data.
    --
    -- The default 'Arbitrary' instance for the 'Char' type intentionally
    -- generates only ASCII values.  This can lead to a false sense of
    -- security in cases where Unicode compliance is required, as
    -- encodings that span multiple bytes or code units will simply not be
    -- exercised at all.
    --
    -- This module deliberately avoids using the @text@ and @bytestring@
    -- packages to avoid pulling in extra dependencies.

    module Test.QuickCheck.Unicode
        (
        -- * Newtype wrapper for convenience
          Unicode(fromUnicode)

        -- * Generators
        , char
        , string
        , string1

        -- ** Helpers
        , list
        , list1

        -- ** Basic generators
        , planes
        , ascii
        , plane0
        , plane1
        , plane2
        , plane14

        -- * Predicates
        , reserved

        -- * Shrinking functions
        , shrinkChar
        ) where

    import Control.Applicative ((<$>))
    import Data.Bits ((.&.))
    import Data.Char (chr, ord)
    import Test.QuickCheck hiding ((.&.))

    -- | A wrapper for 'Char' and 'String', for which the 'Arbitrary'
    -- instance generates full-Unicode characters.
    newtype Unicode a = Unicode { forall a. Unicode a -> a
    fromUnicode :: a }
                      deriving (Unicode a -> Unicode a -> Bool
    (Unicode a -> Unicode a -> Bool)
    -> (Unicode a -> Unicode a -> Bool) -> Eq (Unicode a)
    forall a. Eq a => Unicode a -> Unicode a -> Bool
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: forall a. Eq a => Unicode a -> Unicode a -> Bool
    == :: Unicode a -> Unicode a -> Bool
    $c/= :: forall a. Eq a => Unicode a -> Unicode a -> Bool
    /= :: Unicode a -> Unicode a -> Bool
    Eq, Eq (Unicode a)
    Eq (Unicode a) =>
    (Unicode a -> Unicode a -> Ordering)
    -> (Unicode a -> Unicode a -> Bool)
    -> (Unicode a -> Unicode a -> Bool)
    -> (Unicode a -> Unicode a -> Bool)
    -> (Unicode a -> Unicode a -> Bool)
    -> (Unicode a -> Unicode a -> Unicode a)
    -> (Unicode a -> Unicode a -> Unicode a)
    -> Ord (Unicode a)
    Unicode a -> Unicode a -> Bool
    Unicode a -> Unicode a -> Ordering
    Unicode a -> Unicode a -> Unicode a
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    forall a. Ord a => Eq (Unicode a)
    forall a. Ord a => Unicode a -> Unicode a -> Bool
    forall a. Ord a => Unicode a -> Unicode a -> Ordering
    forall a. Ord a => Unicode a -> Unicode a -> Unicode a
    $ccompare :: forall a. Ord a => Unicode a -> Unicode a -> Ordering
    compare :: Unicode a -> Unicode a -> Ordering
    $c< :: forall a. Ord a => Unicode a -> Unicode a -> Bool
    < :: Unicode a -> Unicode a -> Bool
    $c<= :: forall a. Ord a => Unicode a -> Unicode a -> Bool
    <= :: Unicode a -> Unicode a -> Bool
    $c> :: forall a. Ord a => Unicode a -> Unicode a -> Bool
    > :: Unicode a -> Unicode a -> Bool
    $c>= :: forall a. Ord a => Unicode a -> Unicode a -> Bool
    >= :: Unicode a -> Unicode a -> Bool
    $cmax :: forall a. Ord a => Unicode a -> Unicode a -> Unicode a
    max :: Unicode a -> Unicode a -> Unicode a
    $cmin :: forall a. Ord a => Unicode a -> Unicode a -> Unicode a
    min :: Unicode a -> Unicode a -> Unicode a
    Ord, Int -> Unicode a -> ShowS
    [Unicode a] -> ShowS
    Unicode a -> String
    (Int -> Unicode a -> ShowS)
    -> (Unicode a -> String)
    -> ([Unicode a] -> ShowS)
    -> Show (Unicode a)
    forall a. Show a => Int -> Unicode a -> ShowS
    forall a. Show a => [Unicode a] -> ShowS
    forall a. Show a => Unicode a -> String
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: forall a. Show a => Int -> Unicode a -> ShowS
    showsPrec :: Int -> Unicode a -> ShowS
    $cshow :: forall a. Show a => Unicode a -> String
    show :: Unicode a -> String
    $cshowList :: forall a. Show a => [Unicode a] -> ShowS
    showList :: [Unicode a] -> ShowS
    Show, ReadPrec [Unicode a]
    ReadPrec (Unicode a)
    Int -> ReadS (Unicode a)
    ReadS [Unicode a]
    (Int -> ReadS (Unicode a))
    -> ReadS [Unicode a]
    -> ReadPrec (Unicode a)
    -> ReadPrec [Unicode a]
    -> Read (Unicode a)
    forall a. Read a => ReadPrec [Unicode a]
    forall a. Read a => ReadPrec (Unicode a)
    forall a. Read a => Int -> ReadS (Unicode a)
    forall a. Read a => ReadS [Unicode a]
    forall a.
    (Int -> ReadS a)
    -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
    $creadsPrec :: forall a. Read a => Int -> ReadS (Unicode a)
    readsPrec :: Int -> ReadS (Unicode a)
    $creadList :: forall a. Read a => ReadS [Unicode a]
    readList :: ReadS [Unicode a]
    $creadPrec :: forall a. Read a => ReadPrec (Unicode a)
    readPrec :: ReadPrec (Unicode a)
    $creadListPrec :: forall a. Read a => ReadPrec [Unicode a]
    readListPrec :: ReadPrec [Unicode a]
    Read)

    instance Arbitrary (Unicode Char) where
        arbitrary :: Gen (Unicode Char)
    arbitrary = Char -> Unicode Char
    forall a. a -> Unicode a
    Unicode (Char -> Unicode Char) -> Gen Char -> Gen (Unicode Char)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Gen Char
    char
        shrink :: Unicode Char -> [Unicode Char]
    shrink    = (Char -> Unicode Char) -> String -> [Unicode Char]
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Unicode Char
    forall a. a -> Unicode a
    Unicode (String -> [Unicode Char])
    -> (Unicode Char -> String) -> Unicode Char -> [Unicode Char]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> String
    shrinkChar (Char -> String)
    -> (Unicode Char -> Char) -> Unicode Char -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Unicode Char -> Char
    forall a. Unicode a -> a
    fromUnicode

    instance Arbitrary (Unicode [Char]) where
        arbitrary :: Gen (Unicode String)
    arbitrary = String -> Unicode String
    forall a. a -> Unicode a
    Unicode (String -> Unicode String) -> Gen String -> Gen (Unicode String)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Gen String
    string
        shrink :: Unicode String -> [Unicode String]
    shrink    = (String -> Unicode String) -> [String] -> [Unicode String]
    forall a b. (a -> b) -> [a] -> [b]
    map String -> Unicode String
    forall a. a -> Unicode a
    Unicode ([String] -> [Unicode String])
    -> (Unicode String -> [String])
    -> Unicode String
    -> [Unicode String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char -> String) -> String -> [String]
    forall a. (a -> [a]) -> [a] -> [[a]]
    shrinkList Char -> String
    shrinkChar (String -> [String])
    -> (Unicode String -> String) -> Unicode String -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Unicode String -> String
    forall a. Unicode a -> a
    fromUnicode

    -- | Generate a Unicode code point.  This has a much larger range than
    -- the default 'Arbitrary' instance for 'Char'.
    char :: Gen Char
    char :: Gen Char
    char = Int -> Char
    chr (Int -> Char) -> Gen Int -> Gen Char
    forall a b. (a -> b) -> Gen a -> Gen b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` (Int -> Bool) -> Gen Int -> Gen Int
    forall a. (a -> Bool) -> Gen a -> Gen a
    excluding Int -> Bool
    reserved ([(Int, Gen Int)] -> Gen Int
    forall a. HasCallStack => [(Int, Gen a)] -> Gen a
    frequency [(Int, Gen Int)]
    planes)

    -- | Generate a list of Unicode code points.
    string :: Gen String
    string :: Gen String
    string = Gen Char -> Gen String
    forall a. Gen a -> Gen [a]
    list Gen Char
    char

    -- | Generate a non-empty list of Unicode code points.
    string1 :: Gen String
    string1 :: Gen String
    string1 = Gen Char -> Gen String
    forall a. Gen a -> Gen [a]
    list Gen Char
    char

    -- | Generate a list of values.
    list :: Gen a -> Gen [a]
    list :: forall a. Gen a -> Gen [a]
    list Gen a
    gen = Int -> Gen a -> Gen [a]
    forall a. Int -> Gen a -> Gen [a]
    listN Int
    0 Gen a
    gen

    -- | Generate a non-empty list of values.
    list1 :: Gen a -> Gen [a]
    list1 :: forall a. Gen a -> Gen [a]
    list1 Gen a
    gen = Int -> Gen a -> Gen [a]
    forall a. Int -> Gen a -> Gen [a]
    listN Int
    1 Gen a
    gen

    -- | Generate a list of at least /n/ values.
    listN :: Int -> Gen a -> Gen [a]
    listN :: forall a. Int -> Gen a -> Gen [a]
    listN Int
    m Gen a
    gen =
      (Int -> Gen [a]) -> Gen [a]
    forall a. (Int -> Gen a) -> Gen a
    sized ((Int -> Gen [a]) -> Gen [a]) -> (Int -> Gen [a]) -> Gen [a]
    forall a b. (a -> b) -> a -> b
    $ \Int
    n ->
        do k <- (Int, Int) -> Gen Int
    forall a. Random a => (a, a) -> Gen a
    choose (Int
    m,Int
    n)
           vectorOf k gen

    -- | Shrink a Unicode code point.
    shrinkChar :: Char -> [Char]
    shrinkChar :: Char -> String
    shrinkChar = (Int -> Char) -> [Int] -> String
    forall a b. (a -> b) -> [a] -> [b]
    map Int -> Char
    chr ([Int] -> String) -> (Char -> [Int]) -> Char -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Int -> Bool) -> [Int] -> [Int]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool) -> (Int -> Bool) -> Int -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> Bool
    reserved) ([Int] -> [Int]) -> (Char -> [Int]) -> Char -> [Int]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> [Int]
    forall a. Integral a => a -> [a]
    shrinkIntegral (Int -> [Int]) -> (Char -> Int) -> Char -> [Int]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> Int
    ord

    excluding :: (a -> Bool) -> Gen a -> Gen a
    excluding :: forall a. (a -> Bool) -> Gen a -> Gen a
    excluding a -> Bool
    bad Gen a
    gen = Gen a
    loop
      where
        loop :: Gen a
    loop = do
          x <- Gen a
    gen
          if bad x
            then loop
            else return x

    -- | Indicate whether a code point is reserved.
    reserved :: Int -> Bool
    reserved :: Int -> Bool
    reserved = [Int -> Bool] -> Int -> Bool
    forall {p}. [p -> Bool] -> p -> Bool
    anyOf [(Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <Int
    0), (Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >Int
    0x10FFFF), Int -> Bool
    forall {a}. (Ord a, Num a) => a -> Bool
    lowSurrogate, Int -> Bool
    forall {a}. (Ord a, Num a) => a -> Bool
    highSurrogate, Int -> Bool
    forall {a}. (Bits a, Num a) => a -> Bool
    nonCharacter]
      where
        anyOf :: [p -> Bool] -> p -> Bool
    anyOf [p -> Bool]
    fs p
    xs     = [Bool] -> Bool
    forall (t :: * -> *). Foldable t => t Bool -> Bool
    or (((p -> Bool) -> Bool) -> [p -> Bool] -> [Bool]
    forall a b. (a -> b) -> [a] -> [b]
    map ((p -> Bool) -> p -> Bool
    forall a b. (a -> b) -> a -> b
    $ p
    xs) [p -> Bool]
    fs)
        lowSurrogate :: a -> Bool
    lowSurrogate a
    c  = a
    c a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    >= a
    0xDC00 Bool -> Bool -> Bool
    && a
    c a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    <= a
    0xDFFF
        highSurrogate :: a -> Bool
    highSurrogate a
    c = a
    c a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    >= a
    0xD800 Bool -> Bool -> Bool
    && a
    c a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    <= a
    0xDBFF
        nonCharacter :: a -> Bool
    nonCharacter a
    c  = a
    masked a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == a
    0xFFFE Bool -> Bool -> Bool
    || a
    masked a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == a
    0xFFFF
          where masked :: a
    masked  = a
    c a -> a -> a
    forall a. Bits a => a -> a -> a
    .&. a
    0xFFFF

    -- | A weighted list of generators that favours ASCII characters,
    -- followed by planes 0 and 1.
    planes :: [(Int, Gen Int)]
    planes :: [(Int, Gen Int)]
    planes = [(Int
    60, Gen Int
    ascii),
              (Int
    14, Gen Int
    plane0),
              (Int
    14, Gen Int
    plane1),
              (Int
    6,  Gen Int
    plane2),
              (Int
    6,  Gen Int
    plane14)]

    -- ASCII.
    ascii :: Gen Int
    ascii :: Gen Int
    ascii = (Int, Int) -> Gen Int
    forall a. Random a => (a, a) -> Gen a
    choose (Int
    0,Int
    0x7F)

    -- | Basic Multilingual Plane.
    plane0 :: Gen Int
    plane0 :: Gen Int
    plane0 = (Int, Int) -> Gen Int
    forall a. Random a => (a, a) -> Gen a
    choose (Int
    0xF0, Int
    0xFFFF)

    -- | Supplementary Multilingual Plane.
    plane1 :: Gen Int
    plane1 :: Gen Int
    plane1 = [Gen Int] -> Gen Int
    forall a. HasCallStack => [Gen a] -> Gen a
    oneof [ (Int, Int) -> Gen Int
    forall a. Random a => (a, a) -> Gen a
    choose (Int
    0x10000, Int
    0x10FFF)
                   , (Int, Int) -> Gen Int
    forall a. Random a => (a, a) -> Gen a
    choose (Int
    0x11000, Int
    0x11FFF)
                   , (Int, Int) -> Gen Int
    forall a. Random a => (a, a) -> Gen a
    choose (Int
    0x12000, Int
    0x12FFF)
                   , (Int, Int) -> Gen Int
    forall a. Random a => (a, a) -> Gen a
    choose (Int
    0x13000, Int
    0x13FFF)
                   , (Int, Int) -> Gen Int
    forall a. Random a => (a, a) -> Gen a
    choose (Int
    0x1D000, Int
    0x1DFFF)
                   , (Int, Int) -> Gen Int
    forall a. Random a => (a, a) -> Gen a
    choose (Int
    0x1F000, Int
    0x1FFFF)
                   ]

    -- | Supplementary Ideographic Plane.
    plane2 :: Gen Int
    plane2 :: Gen Int
    plane2 = [Gen Int] -> Gen Int
    forall a. HasCallStack => [Gen a] -> Gen a
    oneof [ (Int, Int) -> Gen Int
    forall a. Random a => (a, a) -> Gen a
    choose (Int
    0x20000, Int
    0x20FFF)
                   , (Int, Int) -> Gen Int
    forall a. Random a => (a, a) -> Gen a
    choose (Int
    0x21000, Int
    0x21FFF)
                   , (Int, Int) -> Gen Int
    forall a. Random a => (a, a) -> Gen a
    choose (Int
    0x22000, Int
    0x22FFF)
                   , (Int, Int) -> Gen Int
    forall a. Random a => (a, a) -> Gen a
    choose (Int
    0x23000, Int
    0x23FFF)
                   , (Int, Int) -> Gen Int
    forall a. Random a => (a, a) -> Gen a
    choose (Int
    0x24000, Int
    0x24FFF)
                   , (Int, Int) -> Gen Int
    forall a. Random a => (a, a) -> Gen a
    choose (Int
    0x25000, Int
    0x25FFF)
                   , (Int, Int) -> Gen Int
    forall a. Random a => (a, a) -> Gen a
    choose (Int
    0x26000, Int
    0x26FFF)
                   , (Int, Int) -> Gen Int
    forall a. Random a => (a, a) -> Gen a
    choose (Int
    0x27000, Int
    0x27FFF)
                   , (Int, Int) -> Gen Int
    forall a. Random a => (a, a) -> Gen a
    choose (Int
    0x28000, Int
    0x28FFF)
                   , (Int, Int) -> Gen Int
    forall a. Random a => (a, a) -> Gen a
    choose (Int
    0x29000, Int
    0x29FFF)
                   , (Int, Int) -> Gen Int
    forall a. Random a => (a, a) -> Gen a
    choose (Int
    0x2A000, Int
    0x2AFFF)
                   , (Int, Int) -> Gen Int
    forall a. Random a => (a, a) -> Gen a
    choose (Int
    0x2B000, Int
    0x2BFFF)
                   , (Int, Int) -> Gen Int
    forall a. Random a => (a, a) -> Gen a
    choose (Int
    0x2F000, Int
    0x2FFFF)
                   ]

    -- | Supplementary Special-Purpose Plane.
    plane14 :: Gen Int
    plane14 :: Gen Int
    plane14 = (Int, Int) -> Gen Int
    forall a. Random a => (a, a) -> Gen a
    choose (Int
    0xE0000, Int
    0xE0FFF)