{-# LANGUAGE FlexibleContexts #-}

module Saturn.Unstable.Type.Element where

import qualified Data.Coerce as Coerce
import qualified Data.Set as Set
import qualified Data.Text.Lazy.Builder as Builder
import qualified Data.Word as Word
import qualified Saturn.Unstable.Extra.Parsec as Parsec
import qualified Saturn.Unstable.Type.Number as Number
import qualified Saturn.Unstable.Type.Range as Range
import qualified Text.Parsec as Parsec

newtype Element
  = Element (Either Range.Range Number.Number)
  deriving (Element -> Element -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Element -> Element -> Bool
$c/= :: Element -> Element -> Bool
== :: Element -> Element -> Bool
$c== :: Element -> Element -> Bool
Eq, Int -> Element -> ShowS
[Element] -> ShowS
Element -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Element] -> ShowS
$cshowList :: [Element] -> ShowS
show :: Element -> String
$cshow :: Element -> String
showsPrec :: Int -> Element -> ShowS
$cshowsPrec :: Int -> Element -> ShowS
Show)

fromEither :: Either Range.Range Number.Number -> Element
fromEither :: Either Range Number -> Element
fromEither = coerce :: forall a b. Coercible a b => a -> b
Coerce.coerce

toEither :: Element -> Either Range.Range Number.Number
toEither :: Element -> Either Range Number
toEither = coerce :: forall a b. Coercible a b => a -> b
Coerce.coerce

parsec :: (Parsec.Stream s m Char) => Parsec.ParsecT s u m Element
parsec :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Element
parsec = Either Range Number -> Element
fromEither forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s u (m :: * -> *) a b.
ParsecT s u m a -> ParsecT s u m b -> ParsecT s u m (Either a b)
Parsec.either (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
Parsec.try forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Range
Range.parsec) forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Number
Number.parsec

toBuilder :: Element -> Builder.Builder
toBuilder :: Element -> Builder
toBuilder = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Range -> Builder
Range.toBuilder Number -> Builder
Number.toBuilder forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> Either Range Number
toEither

isValid :: (Word.Word8, Word.Word8) -> Element -> Bool
isValid :: (Word8, Word8) -> Element -> Bool
isValid (Word8, Word8)
tuple = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ((Word8, Word8) -> Range -> Bool
Range.isValid (Word8, Word8)
tuple) ((Word8, Word8) -> Number -> Bool
Number.isValid (Word8, Word8)
tuple) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> Either Range Number
toEither

expand :: Element -> Set.Set Word.Word8
expand :: Element -> Set Word8
expand = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Range -> Set Word8
Range.expand (forall a. a -> Set a
Set.singleton forall b c a. (b -> c) -> (a -> b) -> a -> c
. Number -> Word8
Number.toWord8) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> Either Range Number
toEither