module SimpleParser.Examples.Common.Sexp ( Atom (..) , SexpF (..) , Sexp (..) ) where import Data.Scientific (Scientific) import Data.Sequence (Seq) import Data.Text (Text) import SimpleParser.Explain (ShowTextBuildable (..), TextBuildable) data Atom = AtomIdent !Text | AtomString !Text | AtomInt !Integer | AtomSci !Scientific deriving stock (Atom -> Atom -> Bool forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: Atom -> Atom -> Bool $c/= :: Atom -> Atom -> Bool == :: Atom -> Atom -> Bool $c== :: Atom -> Atom -> Bool Eq, Int -> Atom -> ShowS [Atom] -> ShowS Atom -> String forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [Atom] -> ShowS $cshowList :: [Atom] -> ShowS show :: Atom -> String $cshow :: Atom -> String showsPrec :: Int -> Atom -> ShowS $cshowsPrec :: Int -> Atom -> ShowS Show) deriving (Atom -> Builder forall a. (a -> Builder) -> TextBuildable a buildText :: Atom -> Builder $cbuildText :: Atom -> Builder TextBuildable) via (ShowTextBuildable Atom) data SexpF a = SexpAtom !Atom | SexpList !(Seq a) deriving stock (SexpF a -> SexpF a -> Bool forall a. Eq a => SexpF a -> SexpF a -> Bool forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: SexpF a -> SexpF a -> Bool $c/= :: forall a. Eq a => SexpF a -> SexpF a -> Bool == :: SexpF a -> SexpF a -> Bool $c== :: forall a. Eq a => SexpF a -> SexpF a -> Bool Eq, Int -> SexpF a -> ShowS forall a. Show a => Int -> SexpF a -> ShowS forall a. Show a => [SexpF a] -> ShowS forall a. Show a => SexpF a -> String forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [SexpF a] -> ShowS $cshowList :: forall a. Show a => [SexpF a] -> ShowS show :: SexpF a -> String $cshow :: forall a. Show a => SexpF a -> String showsPrec :: Int -> SexpF a -> ShowS $cshowsPrec :: forall a. Show a => Int -> SexpF a -> ShowS Show, forall a b. a -> SexpF b -> SexpF a forall a b. (a -> b) -> SexpF a -> SexpF b forall (f :: * -> *). (forall a b. (a -> b) -> f a -> f b) -> (forall a b. a -> f b -> f a) -> Functor f <$ :: forall a b. a -> SexpF b -> SexpF a $c<$ :: forall a b. a -> SexpF b -> SexpF a fmap :: forall a b. (a -> b) -> SexpF a -> SexpF b $cfmap :: forall a b. (a -> b) -> SexpF a -> SexpF b Functor, forall a. Eq a => a -> SexpF a -> Bool forall a. Num a => SexpF a -> a forall a. Ord a => SexpF a -> a forall m. Monoid m => SexpF m -> m forall a. SexpF a -> Bool forall a. SexpF a -> Int forall a. SexpF a -> [a] forall a. (a -> a -> a) -> SexpF a -> a forall m a. Monoid m => (a -> m) -> SexpF a -> m forall b a. (b -> a -> b) -> b -> SexpF a -> b forall a b. (a -> b -> b) -> b -> SexpF a -> b forall (t :: * -> *). (forall m. Monoid m => t m -> m) -> (forall m a. Monoid m => (a -> m) -> t a -> m) -> (forall m a. Monoid m => (a -> m) -> t a -> m) -> (forall a b. (a -> b -> b) -> b -> t a -> b) -> (forall a b. (a -> b -> b) -> b -> t a -> b) -> (forall b a. (b -> a -> b) -> b -> t a -> b) -> (forall b a. (b -> a -> b) -> b -> t a -> b) -> (forall a. (a -> a -> a) -> t a -> a) -> (forall a. (a -> a -> a) -> t a -> a) -> (forall a. t a -> [a]) -> (forall a. t a -> Bool) -> (forall a. t a -> Int) -> (forall a. Eq a => a -> t a -> Bool) -> (forall a. Ord a => t a -> a) -> (forall a. Ord a => t a -> a) -> (forall a. Num a => t a -> a) -> (forall a. Num a => t a -> a) -> Foldable t product :: forall a. Num a => SexpF a -> a $cproduct :: forall a. Num a => SexpF a -> a sum :: forall a. Num a => SexpF a -> a $csum :: forall a. Num a => SexpF a -> a minimum :: forall a. Ord a => SexpF a -> a $cminimum :: forall a. Ord a => SexpF a -> a maximum :: forall a. Ord a => SexpF a -> a $cmaximum :: forall a. Ord a => SexpF a -> a elem :: forall a. Eq a => a -> SexpF a -> Bool $celem :: forall a. Eq a => a -> SexpF a -> Bool length :: forall a. SexpF a -> Int $clength :: forall a. SexpF a -> Int null :: forall a. SexpF a -> Bool $cnull :: forall a. SexpF a -> Bool toList :: forall a. SexpF a -> [a] $ctoList :: forall a. SexpF a -> [a] foldl1 :: forall a. (a -> a -> a) -> SexpF a -> a $cfoldl1 :: forall a. (a -> a -> a) -> SexpF a -> a foldr1 :: forall a. (a -> a -> a) -> SexpF a -> a $cfoldr1 :: forall a. (a -> a -> a) -> SexpF a -> a foldl' :: forall b a. (b -> a -> b) -> b -> SexpF a -> b $cfoldl' :: forall b a. (b -> a -> b) -> b -> SexpF a -> b foldl :: forall b a. (b -> a -> b) -> b -> SexpF a -> b $cfoldl :: forall b a. (b -> a -> b) -> b -> SexpF a -> b foldr' :: forall a b. (a -> b -> b) -> b -> SexpF a -> b $cfoldr' :: forall a b. (a -> b -> b) -> b -> SexpF a -> b foldr :: forall a b. (a -> b -> b) -> b -> SexpF a -> b $cfoldr :: forall a b. (a -> b -> b) -> b -> SexpF a -> b foldMap' :: forall m a. Monoid m => (a -> m) -> SexpF a -> m $cfoldMap' :: forall m a. Monoid m => (a -> m) -> SexpF a -> m foldMap :: forall m a. Monoid m => (a -> m) -> SexpF a -> m $cfoldMap :: forall m a. Monoid m => (a -> m) -> SexpF a -> m fold :: forall m. Monoid m => SexpF m -> m $cfold :: forall m. Monoid m => SexpF m -> m Foldable, Functor SexpF Foldable SexpF forall (t :: * -> *). Functor t -> Foldable t -> (forall (f :: * -> *) a b. Applicative f => (a -> f b) -> t a -> f (t b)) -> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a)) -> (forall (m :: * -> *) a b. Monad m => (a -> m b) -> t a -> m (t b)) -> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a)) -> Traversable t forall (m :: * -> *) a. Monad m => SexpF (m a) -> m (SexpF a) forall (f :: * -> *) a. Applicative f => SexpF (f a) -> f (SexpF a) forall (m :: * -> *) a b. Monad m => (a -> m b) -> SexpF a -> m (SexpF b) forall (f :: * -> *) a b. Applicative f => (a -> f b) -> SexpF a -> f (SexpF b) sequence :: forall (m :: * -> *) a. Monad m => SexpF (m a) -> m (SexpF a) $csequence :: forall (m :: * -> *) a. Monad m => SexpF (m a) -> m (SexpF a) mapM :: forall (m :: * -> *) a b. Monad m => (a -> m b) -> SexpF a -> m (SexpF b) $cmapM :: forall (m :: * -> *) a b. Monad m => (a -> m b) -> SexpF a -> m (SexpF b) sequenceA :: forall (f :: * -> *) a. Applicative f => SexpF (f a) -> f (SexpF a) $csequenceA :: forall (f :: * -> *) a. Applicative f => SexpF (f a) -> f (SexpF a) traverse :: forall (f :: * -> *) a b. Applicative f => (a -> f b) -> SexpF a -> f (SexpF b) $ctraverse :: forall (f :: * -> *) a b. Applicative f => (a -> f b) -> SexpF a -> f (SexpF b) Traversable) newtype Sexp = Sexp { Sexp -> SexpF Sexp unSexp :: SexpF Sexp } deriving stock (Sexp -> Sexp -> Bool forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: Sexp -> Sexp -> Bool $c/= :: Sexp -> Sexp -> Bool == :: Sexp -> Sexp -> Bool $c== :: Sexp -> Sexp -> Bool Eq, Int -> Sexp -> ShowS [Sexp] -> ShowS Sexp -> String forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [Sexp] -> ShowS $cshowList :: [Sexp] -> ShowS show :: Sexp -> String $cshow :: Sexp -> String showsPrec :: Int -> Sexp -> ShowS $cshowsPrec :: Int -> Sexp -> ShowS Show)