{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Internal.Test.QuickCheck.Quid.Representations.Latin
    where

import Control.DeepSeq
    ( NFData )
import Control.Monad
    ( replicateM )
import Data.Char
    ( ord )
import Data.Data
    ( Data )
import Data.Hashable
    ( Hashable (..) )
import Data.List.NonEmpty
    ( NonEmpty (..) )
import Data.Maybe
    ( fromMaybe )
import Data.String
    ( IsString (..) )
import GHC.Generics
    ( Generic )
import Internal.Test.QuickCheck
    ( shrinkListNonEmpty )
import Internal.Test.QuickCheck.Quid
    ( Quid (..) )
import Internal.Test.QuickCheck.Quid.Representations
    ( nonEmptyListFromQuid, nonEmptyListToQuid )
import Test.QuickCheck
    ( Arbitrary (..)
    , Function
    , Gen
    , arbitraryBoundedEnum
    , shrinkMap
    , shrinkMapBy
    , sized
    )
import Text.Read
    ( Read (..), readMaybe )

import qualified Data.Foldable as F
import qualified Data.List.NonEmpty as NE

--------------------------------------------------------------------------------
-- Latin representation
--------------------------------------------------------------------------------

newtype Latin a = Latin { forall a. Latin a -> a
unLatin :: a }
    deriving stock (Typeable (Latin a)
Typeable (Latin a) =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Latin a -> c (Latin a))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (Latin a))
-> (Latin a -> Constr)
-> (Latin a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (Latin a)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Latin a)))
-> ((forall b. Data b => b -> b) -> Latin a -> Latin a)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Latin a -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Latin a -> r)
-> (forall u. (forall d. Data d => d -> u) -> Latin a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Latin a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Latin a -> m (Latin a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Latin a -> m (Latin a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Latin a -> m (Latin a))
-> Data (Latin a)
Latin a -> Constr
Latin a -> DataType
(forall b. Data b => b -> b) -> Latin a -> Latin a
forall a. Data a => Typeable (Latin a)
forall a. Data a => Latin a -> Constr
forall a. Data a => Latin a -> DataType
forall a.
Data a =>
(forall b. Data b => b -> b) -> Latin a -> Latin a
forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> Latin a -> u
forall a u.
Data a =>
(forall d. Data d => d -> u) -> Latin a -> [u]
forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Latin a -> r
forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Latin a -> r
forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Latin a -> m (Latin a)
forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Latin a -> m (Latin a)
forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Latin a)
forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Latin a -> c (Latin a)
forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Latin a))
forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Latin a))
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Latin a -> u
forall u. (forall d. Data d => d -> u) -> Latin a -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Latin a -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Latin a -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Latin a -> m (Latin a)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Latin a -> m (Latin a)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Latin a)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Latin a -> c (Latin a)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Latin a))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Latin a))
$cgfoldl :: forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Latin a -> c (Latin a)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Latin a -> c (Latin a)
$cgunfold :: forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Latin a)
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Latin a)
$ctoConstr :: forall a. Data a => Latin a -> Constr
toConstr :: Latin a -> Constr
$cdataTypeOf :: forall a. Data a => Latin a -> DataType
dataTypeOf :: Latin a -> DataType
$cdataCast1 :: forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Latin a))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Latin a))
$cdataCast2 :: forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Latin a))
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Latin a))
$cgmapT :: forall a.
Data a =>
(forall b. Data b => b -> b) -> Latin a -> Latin a
gmapT :: (forall b. Data b => b -> b) -> Latin a -> Latin a
$cgmapQl :: forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Latin a -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Latin a -> r
$cgmapQr :: forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Latin a -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Latin a -> r
$cgmapQ :: forall a u.
Data a =>
(forall d. Data d => d -> u) -> Latin a -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Latin a -> [u]
$cgmapQi :: forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> Latin a -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Latin a -> u
$cgmapM :: forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Latin a -> m (Latin a)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Latin a -> m (Latin a)
$cgmapMp :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Latin a -> m (Latin a)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Latin a -> m (Latin a)
$cgmapMo :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Latin a -> m (Latin a)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Latin a -> m (Latin a)
Data, Latin a -> Latin a -> Bool
(Latin a -> Latin a -> Bool)
-> (Latin a -> Latin a -> Bool) -> Eq (Latin a)
forall a. Eq a => Latin a -> Latin a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Latin a -> Latin a -> Bool
== :: Latin a -> Latin a -> Bool
$c/= :: forall a. Eq a => Latin a -> Latin a -> Bool
/= :: Latin a -> Latin a -> Bool
Eq, (forall x. Latin a -> Rep (Latin a) x)
-> (forall x. Rep (Latin a) x -> Latin a) -> Generic (Latin a)
forall x. Rep (Latin a) x -> Latin a
forall x. Latin a -> Rep (Latin a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Latin a) x -> Latin a
forall a x. Latin a -> Rep (Latin a) x
$cfrom :: forall a x. Latin a -> Rep (Latin a) x
from :: forall x. Latin a -> Rep (Latin a) x
$cto :: forall a x. Rep (Latin a) x -> Latin a
to :: forall x. Rep (Latin a) x -> Latin a
Generic, Eq (Latin a)
Eq (Latin a) =>
(Latin a -> Latin a -> Ordering)
-> (Latin a -> Latin a -> Bool)
-> (Latin a -> Latin a -> Bool)
-> (Latin a -> Latin a -> Bool)
-> (Latin a -> Latin a -> Bool)
-> (Latin a -> Latin a -> Latin a)
-> (Latin a -> Latin a -> Latin a)
-> Ord (Latin a)
Latin a -> Latin a -> Bool
Latin a -> Latin a -> Ordering
Latin a -> Latin a -> Latin 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 (Latin a)
forall a. Ord a => Latin a -> Latin a -> Bool
forall a. Ord a => Latin a -> Latin a -> Ordering
forall a. Ord a => Latin a -> Latin a -> Latin a
$ccompare :: forall a. Ord a => Latin a -> Latin a -> Ordering
compare :: Latin a -> Latin a -> Ordering
$c< :: forall a. Ord a => Latin a -> Latin a -> Bool
< :: Latin a -> Latin a -> Bool
$c<= :: forall a. Ord a => Latin a -> Latin a -> Bool
<= :: Latin a -> Latin a -> Bool
$c> :: forall a. Ord a => Latin a -> Latin a -> Bool
> :: Latin a -> Latin a -> Bool
$c>= :: forall a. Ord a => Latin a -> Latin a -> Bool
>= :: Latin a -> Latin a -> Bool
$cmax :: forall a. Ord a => Latin a -> Latin a -> Latin a
max :: Latin a -> Latin a -> Latin a
$cmin :: forall a. Ord a => Latin a -> Latin a -> Latin a
min :: Latin a -> Latin a -> Latin a
Ord)
    deriving newtype (Eq (Latin a)
Eq (Latin a) =>
(Int -> Latin a -> Int) -> (Latin a -> Int) -> Hashable (Latin a)
Int -> Latin a -> Int
Latin a -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
forall a. Hashable a => Eq (Latin a)
forall a. Hashable a => Int -> Latin a -> Int
forall a. Hashable a => Latin a -> Int
$chashWithSalt :: forall a. Hashable a => Int -> Latin a -> Int
hashWithSalt :: Int -> Latin a -> Int
$chash :: forall a. Hashable a => Latin a -> Int
hash :: Latin a -> Int
Hashable, Latin a -> ()
(Latin a -> ()) -> NFData (Latin a)
forall a. NFData a => Latin a -> ()
forall a. (a -> ()) -> NFData a
$crnf :: forall a. NFData a => Latin a -> ()
rnf :: Latin a -> ()
NFData)
    deriving anyclass (forall b. (Latin a -> b) -> Latin a :-> b) -> Function (Latin a)
forall a b. Function a => (Latin a -> b) -> Latin a :-> b
forall b. (Latin a -> b) -> Latin a :-> b
forall a. (forall b. (a -> b) -> a :-> b) -> Function a
$cfunction :: forall a b. Function a => (Latin a -> b) -> Latin a :-> b
function :: forall b. (Latin a -> b) -> Latin a :-> b
Function

instance Read (Latin Quid) where
    readPrec :: ReadPrec (Latin Quid)
readPrec = String -> Latin Quid
forall a. IsString a => String -> a
fromString (String -> Latin Quid) -> ReadPrec String -> ReadPrec (Latin Quid)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadPrec String
forall a. Read a => ReadPrec a
readPrec

instance Show (Latin Quid) where
    show :: Latin Quid -> String
show = LatinString -> String
forall a. Show a => a -> String
show (LatinString -> String)
-> (Latin Quid -> LatinString) -> Latin Quid -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Quid -> LatinString
latinStringFromQuid (Quid -> LatinString)
-> (Latin Quid -> Quid) -> Latin Quid -> LatinString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Latin Quid -> Quid
forall a. Latin a -> a
unLatin

instance IsString (Latin Quid) where
    fromString :: String -> Latin Quid
fromString = Quid -> Latin Quid
forall a. a -> Latin a
Latin (Quid -> Latin Quid) -> (String -> Quid) -> String -> Latin Quid
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LatinString -> Quid
latinStringToQuid (LatinString -> Quid) -> (String -> LatinString) -> String -> Quid
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> LatinString
forall a. IsString a => String -> a
fromString

--------------------------------------------------------------------------------
-- Latin characters
--------------------------------------------------------------------------------

data LatinChar
    = A | B | C | D | E | F | G | H | I | J | K | L | M
    | N | O | P | Q | R | S | T | U | V | W | X | Y | Z
    deriving (LatinChar
LatinChar -> LatinChar -> Bounded LatinChar
forall a. a -> a -> Bounded a
$cminBound :: LatinChar
minBound :: LatinChar
$cmaxBound :: LatinChar
maxBound :: LatinChar
Bounded, Int -> LatinChar
LatinChar -> Int
LatinChar -> [LatinChar]
LatinChar -> LatinChar
LatinChar -> LatinChar -> [LatinChar]
LatinChar -> LatinChar -> LatinChar -> [LatinChar]
(LatinChar -> LatinChar)
-> (LatinChar -> LatinChar)
-> (Int -> LatinChar)
-> (LatinChar -> Int)
-> (LatinChar -> [LatinChar])
-> (LatinChar -> LatinChar -> [LatinChar])
-> (LatinChar -> LatinChar -> [LatinChar])
-> (LatinChar -> LatinChar -> LatinChar -> [LatinChar])
-> Enum LatinChar
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: LatinChar -> LatinChar
succ :: LatinChar -> LatinChar
$cpred :: LatinChar -> LatinChar
pred :: LatinChar -> LatinChar
$ctoEnum :: Int -> LatinChar
toEnum :: Int -> LatinChar
$cfromEnum :: LatinChar -> Int
fromEnum :: LatinChar -> Int
$cenumFrom :: LatinChar -> [LatinChar]
enumFrom :: LatinChar -> [LatinChar]
$cenumFromThen :: LatinChar -> LatinChar -> [LatinChar]
enumFromThen :: LatinChar -> LatinChar -> [LatinChar]
$cenumFromTo :: LatinChar -> LatinChar -> [LatinChar]
enumFromTo :: LatinChar -> LatinChar -> [LatinChar]
$cenumFromThenTo :: LatinChar -> LatinChar -> LatinChar -> [LatinChar]
enumFromThenTo :: LatinChar -> LatinChar -> LatinChar -> [LatinChar]
Enum, LatinChar -> LatinChar -> Bool
(LatinChar -> LatinChar -> Bool)
-> (LatinChar -> LatinChar -> Bool) -> Eq LatinChar
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LatinChar -> LatinChar -> Bool
== :: LatinChar -> LatinChar -> Bool
$c/= :: LatinChar -> LatinChar -> Bool
/= :: LatinChar -> LatinChar -> Bool
Eq, Eq LatinChar
Eq LatinChar =>
(LatinChar -> LatinChar -> Ordering)
-> (LatinChar -> LatinChar -> Bool)
-> (LatinChar -> LatinChar -> Bool)
-> (LatinChar -> LatinChar -> Bool)
-> (LatinChar -> LatinChar -> Bool)
-> (LatinChar -> LatinChar -> LatinChar)
-> (LatinChar -> LatinChar -> LatinChar)
-> Ord LatinChar
LatinChar -> LatinChar -> Bool
LatinChar -> LatinChar -> Ordering
LatinChar -> LatinChar -> LatinChar
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
$ccompare :: LatinChar -> LatinChar -> Ordering
compare :: LatinChar -> LatinChar -> Ordering
$c< :: LatinChar -> LatinChar -> Bool
< :: LatinChar -> LatinChar -> Bool
$c<= :: LatinChar -> LatinChar -> Bool
<= :: LatinChar -> LatinChar -> Bool
$c> :: LatinChar -> LatinChar -> Bool
> :: LatinChar -> LatinChar -> Bool
$c>= :: LatinChar -> LatinChar -> Bool
>= :: LatinChar -> LatinChar -> Bool
$cmax :: LatinChar -> LatinChar -> LatinChar
max :: LatinChar -> LatinChar -> LatinChar
$cmin :: LatinChar -> LatinChar -> LatinChar
min :: LatinChar -> LatinChar -> LatinChar
Ord, ReadPrec [LatinChar]
ReadPrec LatinChar
Int -> ReadS LatinChar
ReadS [LatinChar]
(Int -> ReadS LatinChar)
-> ReadS [LatinChar]
-> ReadPrec LatinChar
-> ReadPrec [LatinChar]
-> Read LatinChar
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS LatinChar
readsPrec :: Int -> ReadS LatinChar
$creadList :: ReadS [LatinChar]
readList :: ReadS [LatinChar]
$creadPrec :: ReadPrec LatinChar
readPrec :: ReadPrec LatinChar
$creadListPrec :: ReadPrec [LatinChar]
readListPrec :: ReadPrec [LatinChar]
Read, Int -> LatinChar -> ShowS
[LatinChar] -> ShowS
LatinChar -> String
(Int -> LatinChar -> ShowS)
-> (LatinChar -> String)
-> ([LatinChar] -> ShowS)
-> Show LatinChar
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LatinChar -> ShowS
showsPrec :: Int -> LatinChar -> ShowS
$cshow :: LatinChar -> String
show :: LatinChar -> String
$cshowList :: [LatinChar] -> ShowS
showList :: [LatinChar] -> ShowS
Show)

instance Arbitrary LatinChar where
    arbitrary :: Gen LatinChar
arbitrary = Gen LatinChar
arbitraryLatinChar
    shrink :: LatinChar -> [LatinChar]
shrink = LatinChar -> [LatinChar]
shrinkLatinChar

--------------------------------------------------------------------------------
-- Generation and shrinking of arbitrary Latin characters
--------------------------------------------------------------------------------

arbitraryLatinChar :: Gen LatinChar
arbitraryLatinChar :: Gen LatinChar
arbitraryLatinChar = Gen LatinChar
forall a. (Bounded a, Enum a) => Gen a
arbitraryBoundedEnum

shrinkLatinChar :: LatinChar -> [LatinChar]
shrinkLatinChar :: LatinChar -> [LatinChar]
shrinkLatinChar = (Int -> LatinChar)
-> (LatinChar -> Int) -> LatinChar -> [LatinChar]
forall a b. Arbitrary a => (a -> b) -> (b -> a) -> b -> [b]
shrinkMap Int -> LatinChar
forall a. Enum a => Int -> a
toEnum LatinChar -> Int
forall a. Enum a => a -> Int
fromEnum

--------------------------------------------------------------------------------
-- Conversion between Latin characters and ordinary characters
--------------------------------------------------------------------------------

charToLatinChar :: Char -> Maybe LatinChar
charToLatinChar :: Char -> Maybe LatinChar
charToLatinChar Char
c = String -> Maybe LatinChar
forall a. Read a => String -> Maybe a
readMaybe [Char
c]

latinCharToChar :: LatinChar -> Char
latinCharToChar :: LatinChar -> Char
latinCharToChar = Int -> Char
forall a. Enum a => Int -> a
toEnum (Int -> Char) -> (LatinChar -> Int) -> LatinChar -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
ord Char
'A') (Int -> Int) -> (LatinChar -> Int) -> LatinChar -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LatinChar -> Int
forall a. Enum a => a -> Int
fromEnum

--------------------------------------------------------------------------------
-- Latin strings
--------------------------------------------------------------------------------

newtype LatinString = LatinString
    { LatinString -> NonEmpty LatinChar
unLatinString :: NonEmpty LatinChar }
    deriving stock (LatinString -> LatinString -> Bool
(LatinString -> LatinString -> Bool)
-> (LatinString -> LatinString -> Bool) -> Eq LatinString
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LatinString -> LatinString -> Bool
== :: LatinString -> LatinString -> Bool
$c/= :: LatinString -> LatinString -> Bool
/= :: LatinString -> LatinString -> Bool
Eq, Eq LatinString
Eq LatinString =>
(LatinString -> LatinString -> Ordering)
-> (LatinString -> LatinString -> Bool)
-> (LatinString -> LatinString -> Bool)
-> (LatinString -> LatinString -> Bool)
-> (LatinString -> LatinString -> Bool)
-> (LatinString -> LatinString -> LatinString)
-> (LatinString -> LatinString -> LatinString)
-> Ord LatinString
LatinString -> LatinString -> Bool
LatinString -> LatinString -> Ordering
LatinString -> LatinString -> LatinString
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
$ccompare :: LatinString -> LatinString -> Ordering
compare :: LatinString -> LatinString -> Ordering
$c< :: LatinString -> LatinString -> Bool
< :: LatinString -> LatinString -> Bool
$c<= :: LatinString -> LatinString -> Bool
<= :: LatinString -> LatinString -> Bool
$c> :: LatinString -> LatinString -> Bool
> :: LatinString -> LatinString -> Bool
$c>= :: LatinString -> LatinString -> Bool
>= :: LatinString -> LatinString -> Bool
$cmax :: LatinString -> LatinString -> LatinString
max :: LatinString -> LatinString -> LatinString
$cmin :: LatinString -> LatinString -> LatinString
min :: LatinString -> LatinString -> LatinString
Ord)
    deriving newtype NonEmpty LatinString -> LatinString
LatinString -> LatinString -> LatinString
(LatinString -> LatinString -> LatinString)
-> (NonEmpty LatinString -> LatinString)
-> (forall b. Integral b => b -> LatinString -> LatinString)
-> Semigroup LatinString
forall b. Integral b => b -> LatinString -> LatinString
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: LatinString -> LatinString -> LatinString
<> :: LatinString -> LatinString -> LatinString
$csconcat :: NonEmpty LatinString -> LatinString
sconcat :: NonEmpty LatinString -> LatinString
$cstimes :: forall b. Integral b => b -> LatinString -> LatinString
stimes :: forall b. Integral b => b -> LatinString -> LatinString
Semigroup

instance Arbitrary LatinString where
    arbitrary :: Gen LatinString
arbitrary = Gen LatinString
arbitraryLatinString
    shrink :: LatinString -> [LatinString]
shrink = LatinString -> [LatinString]
shrinkLatinString

--------------------------------------------------------------------------------
-- Conversion between Latin strings and ordinary strings
--------------------------------------------------------------------------------

instance Read LatinString where
    readPrec :: ReadPrec LatinString
readPrec = String -> LatinString
forall a. IsString a => String -> a
fromString (String -> LatinString) -> ReadPrec String -> ReadPrec LatinString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadPrec String
forall a. Read a => ReadPrec a
readPrec

instance Show LatinString where
    show :: LatinString -> String
show = ShowS
forall a. Show a => a -> String
show ShowS -> (LatinString -> String) -> LatinString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LatinString -> String
latinStringToString

instance IsString LatinString where
    fromString :: String -> LatinString
fromString = String -> LatinString
unsafeStringtoLatinString

latinStringToString :: LatinString -> String
latinStringToString :: LatinString -> String
latinStringToString (LatinString NonEmpty LatinChar
cs) = (LatinChar -> String) -> NonEmpty LatinChar -> String
forall m a. Monoid m => (a -> m) -> NonEmpty a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
F.foldMap LatinChar -> String
forall a. Show a => a -> String
show NonEmpty LatinChar
cs

stringToLatinString :: String -> Maybe LatinString
stringToLatinString :: String -> Maybe LatinString
stringToLatinString String
s =
    NonEmpty LatinChar -> LatinString
LatinString (NonEmpty LatinChar -> LatinString)
-> Maybe (NonEmpty LatinChar) -> Maybe LatinString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([LatinChar] -> Maybe (NonEmpty LatinChar)
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty ([LatinChar] -> Maybe (NonEmpty LatinChar))
-> Maybe [LatinChar] -> Maybe (NonEmpty LatinChar)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Char -> Maybe LatinChar) -> String -> Maybe [LatinChar]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Char -> Maybe LatinChar
charToLatinChar String
s)

unsafeStringtoLatinString :: String -> LatinString
unsafeStringtoLatinString :: String -> LatinString
unsafeStringtoLatinString = LatinString -> Maybe LatinString -> LatinString
forall a. a -> Maybe a -> a
fromMaybe LatinString
forall {a}. a
raiseError (Maybe LatinString -> LatinString)
-> (String -> Maybe LatinString) -> String -> LatinString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe LatinString
stringToLatinString
  where
    raiseError :: a
raiseError = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords
        [ String
"A Latin quid string must be composed of one or more uppercase"
        , String
"characters in the range [A-Z]."
        ]

--------------------------------------------------------------------------------
-- Generation and shrinking of arbitrary Latin strings
--------------------------------------------------------------------------------

arbitraryLatinString :: Gen LatinString
arbitraryLatinString :: Gen LatinString
arbitraryLatinString = (Int -> Gen LatinString) -> Gen LatinString
forall a. (Int -> Gen a) -> Gen a
sized ((Int -> Gen LatinString) -> Gen LatinString)
-> (Int -> Gen LatinString) -> Gen LatinString
forall a b. (a -> b) -> a -> b
$ \Int
size ->
    (NonEmpty LatinChar -> LatinString)
-> ([LatinChar] -> NonEmpty LatinChar)
-> [LatinChar]
-> LatinString
forall a b. (a -> b) -> ([LatinChar] -> a) -> [LatinChar] -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NonEmpty LatinChar -> LatinString
LatinString (([LatinChar] -> NonEmpty LatinChar) -> [LatinChar] -> LatinString)
-> (LatinChar -> [LatinChar] -> NonEmpty LatinChar)
-> LatinChar
-> [LatinChar]
-> LatinString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LatinChar -> [LatinChar] -> NonEmpty LatinChar
forall a. a -> [a] -> NonEmpty a
(:|)
        (LatinChar -> [LatinChar] -> LatinString)
-> Gen LatinChar -> Gen ([LatinChar] -> LatinString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen LatinChar
arbitraryLatinChar
        Gen ([LatinChar] -> LatinString)
-> Gen [LatinChar] -> Gen LatinString
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Gen LatinChar -> Gen [LatinChar]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
size Gen LatinChar
arbitraryLatinChar

shrinkLatinString :: LatinString -> [LatinString]
shrinkLatinString :: LatinString -> [LatinString]
shrinkLatinString =
    (NonEmpty LatinChar -> LatinString)
-> (LatinString -> NonEmpty LatinChar)
-> (NonEmpty LatinChar -> [NonEmpty LatinChar])
-> LatinString
-> [LatinString]
forall a b. (a -> b) -> (b -> a) -> (a -> [a]) -> b -> [b]
shrinkMapBy NonEmpty LatinChar -> LatinString
LatinString LatinString -> NonEmpty LatinChar
unLatinString ((NonEmpty LatinChar -> [NonEmpty LatinChar])
 -> LatinString -> [LatinString])
-> (NonEmpty LatinChar -> [NonEmpty LatinChar])
-> LatinString
-> [LatinString]
forall a b. (a -> b) -> a -> b
$ (LatinChar -> [LatinChar])
-> NonEmpty LatinChar -> [NonEmpty LatinChar]
forall a. (a -> [a]) -> NonEmpty a -> [NonEmpty a]
shrinkListNonEmpty LatinChar -> [LatinChar]
shrinkLatinChar

--------------------------------------------------------------------------------
-- Conversion between Latin strings and quids
--------------------------------------------------------------------------------

latinStringToQuid :: LatinString -> Quid
latinStringToQuid :: LatinString -> Quid
latinStringToQuid = NonEmpty LatinChar -> Quid
forall a. (Bounded a, Enum a) => NonEmpty a -> Quid
nonEmptyListToQuid (NonEmpty LatinChar -> Quid)
-> (LatinString -> NonEmpty LatinChar) -> LatinString -> Quid
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LatinString -> NonEmpty LatinChar
unLatinString

latinStringFromQuid :: Quid -> LatinString
latinStringFromQuid :: Quid -> LatinString
latinStringFromQuid = NonEmpty LatinChar -> LatinString
LatinString (NonEmpty LatinChar -> LatinString)
-> (Quid -> NonEmpty LatinChar) -> Quid -> LatinString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Quid -> NonEmpty LatinChar
forall a. (Bounded a, Enum a) => Quid -> NonEmpty a
nonEmptyListFromQuid