{-|
Copyright        : (c) Galois, Inc. 2025
Maintainer       : Langston Barrett <langston@galois.com>
-}

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneKindSignatures #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

module Lang.Crucible.Debug.Regex
  ( type Regex
  , type Empty
  , type Lit
  , type (:|)
  , type Then
  , type Star
  , RegexRepr(..)
  , AcceptsEmpty
  , acceptsEmpty
  , DerivativeResult(..)
  , derivative
  , Match(..)
  , MatchError(..)
  , TokenParser(..)
  , match
  , nextLits
  , liftOrs
  , Sugar(..)
  , sugar
  , prettySugar
  ) where

import Data.Bifunctor (first)
import Data.Foldable qualified as Foldable
import Data.Kind (Type)
import Data.Parameterized.BoolRepr (BoolRepr (..), (%||), (%&&))
import Data.Parameterized.Classes (KnownRepr(knownRepr))
import Data.Parameterized.Some (Some (Some))
import Data.Parameterized.TraversableFC qualified as TFC
import Data.Sequence qualified as Seq
import Data.Sequence (Seq)
import Data.Type.Bool (type (||), type (&&))
import Data.Type.Equality (TestEquality (testEquality), type (:~:)(Refl))
import Prettyprinter qualified as PP

-- | Type-level only
data Regex a
  = TFail
  | TEmpty
  | TLit a
  | TOr (Regex a) (Regex a)
  | TThen (Regex a) (Regex a)
  | TStar (Regex a)

type Empty = 'TEmpty
type Lit = 'TLit
type a :| b = 'TOr a b
type Then = 'TThen
type Star = 'TStar

-- | Value-level representative of 'Regex'
--
-- The order of the type parameters is a bit arbitrary... This order gives
-- 'KnownRepr' and 'TestEquality' instances but requires flipping the type
-- parameters to get 'TraversableF'.
type RegexRepr :: (k -> Type) -> Regex k -> Type
data RegexRepr f r where
  Empty :: RegexRepr f 'TEmpty
  Fail :: RegexRepr f 'TFail
  Lit :: f t -> RegexRepr f ('TLit t)
  Or :: RegexRepr f l -> RegexRepr f r -> RegexRepr f ('TOr l r)
  Star :: RegexRepr f r -> RegexRepr f ('TStar r)
  Then :: RegexRepr f l -> RegexRepr f r -> RegexRepr f ('TThen l r)

instance TestEquality f => TestEquality (RegexRepr f) where
  testEquality :: forall (a :: Regex k) (b :: Regex k).
RegexRepr f a -> RegexRepr f b -> Maybe (a :~: b)
testEquality RegexRepr f a
rgx RegexRepr f b
rgx' =
    case (RegexRepr f a
rgx, RegexRepr f b
rgx') of
      (RegexRepr f a
Empty, RegexRepr f b
Empty) -> (a :~: b) -> Maybe (a :~: b)
forall a. a -> Maybe a
Just a :~: a
a :~: b
forall {k} (a :: k). a :~: a
Refl
      (RegexRepr f a
Empty, RegexRepr f b
_) -> Maybe (a :~: b)
forall a. Maybe a
Nothing
      (RegexRepr f a
Fail, RegexRepr f b
Fail) -> (a :~: b) -> Maybe (a :~: b)
forall a. a -> Maybe a
Just a :~: a
a :~: b
forall {k} (a :: k). a :~: a
Refl
      (RegexRepr f a
Fail, RegexRepr f b
_) -> Maybe (a :~: b)
forall a. Maybe a
Nothing
      (Lit f t
l, Lit f t
l') ->
        case f t -> f t -> Maybe (t :~: t)
forall (a :: k) (b :: k). f a -> f b -> Maybe (a :~: b)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality f t
l f t
l' of
          Just t :~: t
Refl -> (a :~: b) -> Maybe (a :~: b)
forall a. a -> Maybe a
Just a :~: a
a :~: b
forall {k} (a :: k). a :~: a
Refl
          Maybe (t :~: t)
Nothing -> Maybe (a :~: b)
forall a. Maybe a
Nothing
      (Lit {}, RegexRepr f b
_) -> Maybe (a :~: b)
forall a. Maybe a
Nothing
      (Or RegexRepr f l
l RegexRepr f r
r, Or RegexRepr f l
l' RegexRepr f r
r') ->
        case (RegexRepr f l -> RegexRepr f l -> Maybe (l :~: l)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
forall (a :: Regex k) (b :: Regex k).
RegexRepr f a -> RegexRepr f b -> Maybe (a :~: b)
testEquality RegexRepr f l
l RegexRepr f l
l', RegexRepr f r -> RegexRepr f r -> Maybe (r :~: r)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
forall (a :: Regex k) (b :: Regex k).
RegexRepr f a -> RegexRepr f b -> Maybe (a :~: b)
testEquality RegexRepr f r
r RegexRepr f r
r') of
          (Just l :~: l
Refl, Just r :~: r
Refl) -> (a :~: b) -> Maybe (a :~: b)
forall a. a -> Maybe a
Just a :~: a
a :~: b
forall {k} (a :: k). a :~: a
Refl
          (Maybe (l :~: l), Maybe (r :~: r))
_ -> Maybe (a :~: b)
forall a. Maybe a
Nothing
      (Or {}, RegexRepr f b
_) -> Maybe (a :~: b)
forall a. Maybe a
Nothing
      (Star RegexRepr f r
r, Star RegexRepr f r
r') ->
        case RegexRepr f r -> RegexRepr f r -> Maybe (r :~: r)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
forall (a :: Regex k) (b :: Regex k).
RegexRepr f a -> RegexRepr f b -> Maybe (a :~: b)
testEquality RegexRepr f r
r RegexRepr f r
r' of
          Just r :~: r
Refl -> (a :~: b) -> Maybe (a :~: b)
forall a. a -> Maybe a
Just a :~: a
a :~: b
forall {k} (a :: k). a :~: a
Refl
          Maybe (r :~: r)
Nothing -> Maybe (a :~: b)
forall a. Maybe a
Nothing
      (Star {}, RegexRepr f b
_) -> Maybe (a :~: b)
forall a. Maybe a
Nothing
      (Then RegexRepr f l
l RegexRepr f r
r, Then RegexRepr f l
l' RegexRepr f r
r') ->
        case (RegexRepr f l -> RegexRepr f l -> Maybe (l :~: l)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
forall (a :: Regex k) (b :: Regex k).
RegexRepr f a -> RegexRepr f b -> Maybe (a :~: b)
testEquality RegexRepr f l
l RegexRepr f l
l', RegexRepr f r -> RegexRepr f r -> Maybe (r :~: r)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
forall (a :: Regex k) (b :: Regex k).
RegexRepr f a -> RegexRepr f b -> Maybe (a :~: b)
testEquality RegexRepr f r
r RegexRepr f r
r') of
          (Just l :~: l
Refl, Just r :~: r
Refl) -> (a :~: b) -> Maybe (a :~: b)
forall a. a -> Maybe a
Just a :~: a
a :~: b
forall {k} (a :: k). a :~: a
Refl
          (Maybe (l :~: l), Maybe (r :~: r))
_ -> Maybe (a :~: b)
forall a. Maybe a
Nothing
      (Then {}, RegexRepr f b
_) -> Maybe (a :~: b)
forall a. Maybe a
Nothing

instance KnownRepr (RegexRepr f) 'TEmpty where
  knownRepr :: RegexRepr f 'TEmpty
knownRepr = RegexRepr f 'TEmpty
forall k (f :: k -> *). RegexRepr f 'TEmpty
Empty

instance KnownRepr (RegexRepr f) 'TFail where
  knownRepr :: RegexRepr f 'TFail
knownRepr = RegexRepr f 'TFail
forall k (f :: k -> *). RegexRepr f 'TFail
Fail

instance KnownRepr f t => KnownRepr (RegexRepr f) ('TLit t) where
  knownRepr :: RegexRepr f ('TLit t)
knownRepr = f t -> RegexRepr f ('TLit t)
forall {k} (f :: k -> *) (l :: k). f l -> RegexRepr f ('TLit l)
Lit f t
forall k (f :: k -> *) (ctx :: k). KnownRepr f ctx => f ctx
knownRepr

instance
  ( KnownRepr (RegexRepr f) l
  , KnownRepr (RegexRepr f) r
  ) => KnownRepr (RegexRepr f) ('TOr l r) where
  knownRepr :: RegexRepr f ('TOr l r)
knownRepr = RegexRepr f l -> RegexRepr f r -> RegexRepr f ('TOr l r)
forall {k} (f :: k -> *) (l :: Regex k) (r :: Regex k).
RegexRepr f l -> RegexRepr f r -> RegexRepr f ('TOr l r)
Or RegexRepr f l
forall k (f :: k -> *) (ctx :: k). KnownRepr f ctx => f ctx
knownRepr RegexRepr f r
forall k (f :: k -> *) (ctx :: k). KnownRepr f ctx => f ctx
knownRepr

instance
  ( KnownRepr (RegexRepr f) l
  , KnownRepr (RegexRepr f) r
  ) => KnownRepr (RegexRepr f) ('TThen l r) where
  knownRepr :: RegexRepr f ('TThen l r)
knownRepr = RegexRepr f l -> RegexRepr f r -> RegexRepr f ('TThen l r)
forall {k} (f :: k -> *) (l :: Regex k) (r :: Regex k).
RegexRepr f l -> RegexRepr f r -> RegexRepr f ('TThen l r)
Then RegexRepr f l
forall k (f :: k -> *) (ctx :: k). KnownRepr f ctx => f ctx
knownRepr RegexRepr f r
forall k (f :: k -> *) (ctx :: k). KnownRepr f ctx => f ctx
knownRepr

instance KnownRepr (RegexRepr f) r => KnownRepr (RegexRepr f) ('TStar r) where
  knownRepr :: RegexRepr f ('TStar r)
knownRepr = RegexRepr f r -> RegexRepr f ('TStar r)
forall {k} (f :: k -> *) (l :: Regex k).
RegexRepr f l -> RegexRepr f ('TStar l)
Star RegexRepr f r
forall k (f :: k -> *) (ctx :: k). KnownRepr f ctx => f ctx
knownRepr

instance TFC.FunctorFC RegexRepr where
  fmapFC :: forall (f :: k -> *) (g :: k -> *).
(forall (x :: k). f x -> g x)
-> forall (x :: Regex k). RegexRepr f x -> RegexRepr g x
fmapFC forall (x :: k). f x -> g x
f =
    \case
      RegexRepr f x
Empty -> RegexRepr g x
RegexRepr g 'TEmpty
forall k (f :: k -> *). RegexRepr f 'TEmpty
Empty
      RegexRepr f x
Fail -> RegexRepr g x
RegexRepr g 'TFail
forall k (f :: k -> *). RegexRepr f 'TFail
Fail
      Lit f t
l -> g t -> RegexRepr g ('TLit t)
forall {k} (f :: k -> *) (l :: k). f l -> RegexRepr f ('TLit l)
Lit (f t -> g t
forall (x :: k). f x -> g x
f f t
l)
      Or RegexRepr f l
l RegexRepr f r
r -> RegexRepr g l -> RegexRepr g r -> RegexRepr g ('TOr l r)
forall {k} (f :: k -> *) (l :: Regex k) (r :: Regex k).
RegexRepr f l -> RegexRepr f r -> RegexRepr f ('TOr l r)
Or ((forall (x :: k). f x -> g x)
-> forall (x :: Regex k). RegexRepr f x -> RegexRepr g x
forall k l (t :: (k -> *) -> l -> *) (f :: k -> *) (g :: k -> *).
FunctorFC t =>
(forall (x :: k). f x -> g x) -> forall (x :: l). t f x -> t g x
forall (f :: k -> *) (g :: k -> *).
(forall (x :: k). f x -> g x)
-> forall (x :: Regex k). RegexRepr f x -> RegexRepr g x
TFC.fmapFC f x -> g x
forall (x :: k). f x -> g x
f RegexRepr f l
l) ((forall (x :: k). f x -> g x)
-> forall (x :: Regex k). RegexRepr f x -> RegexRepr g x
forall k l (t :: (k -> *) -> l -> *) (f :: k -> *) (g :: k -> *).
FunctorFC t =>
(forall (x :: k). f x -> g x) -> forall (x :: l). t f x -> t g x
forall (f :: k -> *) (g :: k -> *).
(forall (x :: k). f x -> g x)
-> forall (x :: Regex k). RegexRepr f x -> RegexRepr g x
TFC.fmapFC f x -> g x
forall (x :: k). f x -> g x
f RegexRepr f r
r)
      Star RegexRepr f r
r -> RegexRepr g r -> RegexRepr g ('TStar r)
forall {k} (f :: k -> *) (l :: Regex k).
RegexRepr f l -> RegexRepr f ('TStar l)
Star ((forall (x :: k). f x -> g x)
-> forall (x :: Regex k). RegexRepr f x -> RegexRepr g x
forall k l (t :: (k -> *) -> l -> *) (f :: k -> *) (g :: k -> *).
FunctorFC t =>
(forall (x :: k). f x -> g x) -> forall (x :: l). t f x -> t g x
forall (f :: k -> *) (g :: k -> *).
(forall (x :: k). f x -> g x)
-> forall (x :: Regex k). RegexRepr f x -> RegexRepr g x
TFC.fmapFC f x -> g x
forall (x :: k). f x -> g x
f RegexRepr f r
r)
      Then RegexRepr f l
l RegexRepr f r
r -> RegexRepr g l -> RegexRepr g r -> RegexRepr g ('TThen l r)
forall {k} (f :: k -> *) (l :: Regex k) (r :: Regex k).
RegexRepr f l -> RegexRepr f r -> RegexRepr f ('TThen l r)
Then ((forall (x :: k). f x -> g x)
-> forall (x :: Regex k). RegexRepr f x -> RegexRepr g x
forall k l (t :: (k -> *) -> l -> *) (f :: k -> *) (g :: k -> *).
FunctorFC t =>
(forall (x :: k). f x -> g x) -> forall (x :: l). t f x -> t g x
forall (f :: k -> *) (g :: k -> *).
(forall (x :: k). f x -> g x)
-> forall (x :: Regex k). RegexRepr f x -> RegexRepr g x
TFC.fmapFC f x -> g x
forall (x :: k). f x -> g x
f RegexRepr f l
l) ((forall (x :: k). f x -> g x)
-> forall (x :: Regex k). RegexRepr f x -> RegexRepr g x
forall k l (t :: (k -> *) -> l -> *) (f :: k -> *) (g :: k -> *).
FunctorFC t =>
(forall (x :: k). f x -> g x) -> forall (x :: l). t f x -> t g x
forall (f :: k -> *) (g :: k -> *).
(forall (x :: k). f x -> g x)
-> forall (x :: Regex k). RegexRepr f x -> RegexRepr g x
TFC.fmapFC f x -> g x
forall (x :: k). f x -> g x
f RegexRepr f r
r)

instance TFC.FoldableFC RegexRepr where
  foldMapFC :: forall (f :: k -> *) m.
Monoid m =>
(forall (x :: k). f x -> m)
-> forall (x :: Regex k). RegexRepr f x -> m
foldMapFC forall (x :: k). f x -> m
f =
    \case
      RegexRepr f x
Empty -> m
forall a. Monoid a => a
mempty
      RegexRepr f x
Fail -> m
forall a. Monoid a => a
mempty
      Lit f t
l -> f t -> m
forall (x :: k). f x -> m
f f t
l
      Or RegexRepr f l
l RegexRepr f r
r -> (forall (x :: k). f x -> m)
-> forall (x :: Regex k). RegexRepr f x -> m
forall k l (t :: (k -> *) -> l -> *) (f :: k -> *) m.
(FoldableFC t, Monoid m) =>
(forall (x :: k). f x -> m) -> forall (x :: l). t f x -> m
forall (f :: k -> *) m.
Monoid m =>
(forall (x :: k). f x -> m)
-> forall (x :: Regex k). RegexRepr f x -> m
TFC.foldMapFC f x -> m
forall (x :: k). f x -> m
f RegexRepr f l
l m -> m -> m
forall a. Semigroup a => a -> a -> a
<> (forall (x :: k). f x -> m)
-> forall (x :: Regex k). RegexRepr f x -> m
forall k l (t :: (k -> *) -> l -> *) (f :: k -> *) m.
(FoldableFC t, Monoid m) =>
(forall (x :: k). f x -> m) -> forall (x :: l). t f x -> m
forall (f :: k -> *) m.
Monoid m =>
(forall (x :: k). f x -> m)
-> forall (x :: Regex k). RegexRepr f x -> m
TFC.foldMapFC f x -> m
forall (x :: k). f x -> m
f RegexRepr f r
r
      Star RegexRepr f r
r -> (forall (x :: k). f x -> m)
-> forall (x :: Regex k). RegexRepr f x -> m
forall k l (t :: (k -> *) -> l -> *) (f :: k -> *) m.
(FoldableFC t, Monoid m) =>
(forall (x :: k). f x -> m) -> forall (x :: l). t f x -> m
forall (f :: k -> *) m.
Monoid m =>
(forall (x :: k). f x -> m)
-> forall (x :: Regex k). RegexRepr f x -> m
TFC.foldMapFC f x -> m
forall (x :: k). f x -> m
f RegexRepr f r
r
      Then RegexRepr f l
l RegexRepr f r
r -> (forall (x :: k). f x -> m)
-> forall (x :: Regex k). RegexRepr f x -> m
forall k l (t :: (k -> *) -> l -> *) (f :: k -> *) m.
(FoldableFC t, Monoid m) =>
(forall (x :: k). f x -> m) -> forall (x :: l). t f x -> m
forall (f :: k -> *) m.
Monoid m =>
(forall (x :: k). f x -> m)
-> forall (x :: Regex k). RegexRepr f x -> m
TFC.foldMapFC f x -> m
forall (x :: k). f x -> m
f RegexRepr f l
l m -> m -> m
forall a. Semigroup a => a -> a -> a
<> (forall (x :: k). f x -> m)
-> forall (x :: Regex k). RegexRepr f x -> m
forall k l (t :: (k -> *) -> l -> *) (f :: k -> *) m.
(FoldableFC t, Monoid m) =>
(forall (x :: k). f x -> m) -> forall (x :: l). t f x -> m
forall (f :: k -> *) m.
Monoid m =>
(forall (x :: k). f x -> m)
-> forall (x :: Regex k). RegexRepr f x -> m
TFC.foldMapFC f x -> m
forall (x :: k). f x -> m
f RegexRepr f r
r

instance TFC.TraversableFC RegexRepr where
  traverseFC :: forall (f :: k -> *) (g :: k -> *) (m :: * -> *).
Applicative m =>
(forall (x :: k). f x -> m (g x))
-> forall (x :: Regex k). RegexRepr f x -> m (RegexRepr g x)
traverseFC forall (x :: k). f x -> m (g x)
f =
    \case
      RegexRepr f x
Empty -> RegexRepr g x -> m (RegexRepr g x)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RegexRepr g x
RegexRepr g 'TEmpty
forall k (f :: k -> *). RegexRepr f 'TEmpty
Empty
      RegexRepr f x
Fail -> RegexRepr g x -> m (RegexRepr g x)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RegexRepr g x
RegexRepr g 'TFail
forall k (f :: k -> *). RegexRepr f 'TFail
Fail
      Lit f t
l -> g t -> RegexRepr g x
g t -> RegexRepr g ('TLit t)
forall {k} (f :: k -> *) (l :: k). f l -> RegexRepr f ('TLit l)
Lit (g t -> RegexRepr g x) -> m (g t) -> m (RegexRepr g x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f t -> m (g t)
forall (x :: k). f x -> m (g x)
f f t
l
      Or RegexRepr f l
l RegexRepr f r
r -> RegexRepr g l -> RegexRepr g r -> RegexRepr g x
RegexRepr g l -> RegexRepr g r -> RegexRepr g ('TOr l r)
forall {k} (f :: k -> *) (l :: Regex k) (r :: Regex k).
RegexRepr f l -> RegexRepr f r -> RegexRepr f ('TOr l r)
Or (RegexRepr g l -> RegexRepr g r -> RegexRepr g x)
-> m (RegexRepr g l) -> m (RegexRepr g r -> RegexRepr g x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (x :: k). f x -> m (g x))
-> forall (x :: Regex k). RegexRepr f x -> m (RegexRepr g x)
forall k l (t :: (k -> *) -> l -> *) (f :: k -> *) (g :: k -> *)
       (m :: * -> *).
(TraversableFC t, Applicative m) =>
(forall (x :: k). f x -> m (g x))
-> forall (x :: l). t f x -> m (t g x)
forall (f :: k -> *) (g :: k -> *) (m :: * -> *).
Applicative m =>
(forall (x :: k). f x -> m (g x))
-> forall (x :: Regex k). RegexRepr f x -> m (RegexRepr g x)
TFC.traverseFC f x -> m (g x)
forall (x :: k). f x -> m (g x)
f RegexRepr f l
l m (RegexRepr g r -> RegexRepr g x)
-> m (RegexRepr g r) -> m (RegexRepr g x)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall (x :: k). f x -> m (g x))
-> forall (x :: Regex k). RegexRepr f x -> m (RegexRepr g x)
forall k l (t :: (k -> *) -> l -> *) (f :: k -> *) (g :: k -> *)
       (m :: * -> *).
(TraversableFC t, Applicative m) =>
(forall (x :: k). f x -> m (g x))
-> forall (x :: l). t f x -> m (t g x)
forall (f :: k -> *) (g :: k -> *) (m :: * -> *).
Applicative m =>
(forall (x :: k). f x -> m (g x))
-> forall (x :: Regex k). RegexRepr f x -> m (RegexRepr g x)
TFC.traverseFC f x -> m (g x)
forall (x :: k). f x -> m (g x)
f RegexRepr f r
r
      Star RegexRepr f r
r -> RegexRepr g r -> RegexRepr g x
RegexRepr g r -> RegexRepr g ('TStar r)
forall {k} (f :: k -> *) (l :: Regex k).
RegexRepr f l -> RegexRepr f ('TStar l)
Star (RegexRepr g r -> RegexRepr g x)
-> m (RegexRepr g r) -> m (RegexRepr g x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (x :: k). f x -> m (g x))
-> forall (x :: Regex k). RegexRepr f x -> m (RegexRepr g x)
forall k l (t :: (k -> *) -> l -> *) (f :: k -> *) (g :: k -> *)
       (m :: * -> *).
(TraversableFC t, Applicative m) =>
(forall (x :: k). f x -> m (g x))
-> forall (x :: l). t f x -> m (t g x)
forall (f :: k -> *) (g :: k -> *) (m :: * -> *).
Applicative m =>
(forall (x :: k). f x -> m (g x))
-> forall (x :: Regex k). RegexRepr f x -> m (RegexRepr g x)
TFC.traverseFC f x -> m (g x)
forall (x :: k). f x -> m (g x)
f RegexRepr f r
r
      Then RegexRepr f l
l RegexRepr f r
r -> RegexRepr g l -> RegexRepr g r -> RegexRepr g x
RegexRepr g l -> RegexRepr g r -> RegexRepr g ('TThen l r)
forall {k} (f :: k -> *) (l :: Regex k) (r :: Regex k).
RegexRepr f l -> RegexRepr f r -> RegexRepr f ('TThen l r)
Then (RegexRepr g l -> RegexRepr g r -> RegexRepr g x)
-> m (RegexRepr g l) -> m (RegexRepr g r -> RegexRepr g x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (x :: k). f x -> m (g x))
-> forall (x :: Regex k). RegexRepr f x -> m (RegexRepr g x)
forall k l (t :: (k -> *) -> l -> *) (f :: k -> *) (g :: k -> *)
       (m :: * -> *).
(TraversableFC t, Applicative m) =>
(forall (x :: k). f x -> m (g x))
-> forall (x :: l). t f x -> m (t g x)
forall (f :: k -> *) (g :: k -> *) (m :: * -> *).
Applicative m =>
(forall (x :: k). f x -> m (g x))
-> forall (x :: Regex k). RegexRepr f x -> m (RegexRepr g x)
TFC.traverseFC f x -> m (g x)
forall (x :: k). f x -> m (g x)
f RegexRepr f l
l m (RegexRepr g r -> RegexRepr g x)
-> m (RegexRepr g r) -> m (RegexRepr g x)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall (x :: k). f x -> m (g x))
-> forall (x :: Regex k). RegexRepr f x -> m (RegexRepr g x)
forall k l (t :: (k -> *) -> l -> *) (f :: k -> *) (g :: k -> *)
       (m :: * -> *).
(TraversableFC t, Applicative m) =>
(forall (x :: k). f x -> m (g x))
-> forall (x :: l). t f x -> m (t g x)
forall (f :: k -> *) (g :: k -> *) (m :: * -> *).
Applicative m =>
(forall (x :: k). f x -> m (g x))
-> forall (x :: Regex k). RegexRepr f x -> m (RegexRepr g x)
TFC.traverseFC f x -> m (g x)
forall (x :: k). f x -> m (g x)
f RegexRepr f r
r

type AcceptsEmpty :: Regex k -> Bool
type family AcceptsEmpty r where
  AcceptsEmpty 'TFail = 'False
  AcceptsEmpty 'TEmpty  = 'True
  AcceptsEmpty ('TLit _) = 'False
  AcceptsEmpty ('TOr l r) = AcceptsEmpty l || AcceptsEmpty r
  AcceptsEmpty ('TThen l r) = AcceptsEmpty l && AcceptsEmpty r
  AcceptsEmpty ('TStar r) = 'True

acceptsEmpty :: RegexRepr f r -> BoolRepr (AcceptsEmpty r)
acceptsEmpty :: forall {k} (f :: k -> *) (r :: Regex k).
RegexRepr f r -> BoolRepr (AcceptsEmpty r)
acceptsEmpty =
  \case
    RegexRepr f r
Empty -> BoolRepr 'True
BoolRepr (AcceptsEmpty r)
TrueRepr
    RegexRepr f r
Fail -> BoolRepr 'False
BoolRepr (AcceptsEmpty r)
FalseRepr
    Lit {} -> BoolRepr 'False
BoolRepr (AcceptsEmpty r)
FalseRepr
    Or RegexRepr f l
l RegexRepr f r
r -> RegexRepr f l -> BoolRepr (AcceptsEmpty l)
forall {k} (f :: k -> *) (r :: Regex k).
RegexRepr f r -> BoolRepr (AcceptsEmpty r)
acceptsEmpty RegexRepr f l
l BoolRepr (AcceptsEmpty l)
-> BoolRepr (AcceptsEmpty r)
-> BoolRepr (AcceptsEmpty l || AcceptsEmpty r)
forall (a :: Bool) (b :: Bool).
BoolRepr a -> BoolRepr b -> BoolRepr (a || b)
%|| RegexRepr f r -> BoolRepr (AcceptsEmpty r)
forall {k} (f :: k -> *) (r :: Regex k).
RegexRepr f r -> BoolRepr (AcceptsEmpty r)
acceptsEmpty RegexRepr f r
r
    Star RegexRepr f r
_ -> BoolRepr 'True
BoolRepr (AcceptsEmpty r)
TrueRepr
    Then RegexRepr f l
l RegexRepr f r
r -> RegexRepr f l -> BoolRepr (AcceptsEmpty l)
forall {k} (f :: k -> *) (r :: Regex k).
RegexRepr f r -> BoolRepr (AcceptsEmpty r)
acceptsEmpty RegexRepr f l
l BoolRepr (AcceptsEmpty l)
-> BoolRepr (AcceptsEmpty r)
-> BoolRepr (AcceptsEmpty l && AcceptsEmpty r)
forall (a :: Bool) (b :: Bool).
BoolRepr a -> BoolRepr b -> BoolRepr (a && b)
%&& RegexRepr f r -> BoolRepr (AcceptsEmpty r)
forall {k} (f :: k -> *) (r :: Regex k).
RegexRepr f r -> BoolRepr (AcceptsEmpty r)
acceptsEmpty RegexRepr f r
r

-- | Type-level version of 'nu'.
--
-- See Wikipedia on "Brzozowski derivative"
type Nu :: Regex k -> Regex k
type family Nu r where
  Nu 'TFail = 'TFail
  Nu 'TEmpty  = 'TEmpty
  Nu ('TLit _) = 'TFail
  Nu ('TOr l r) = 'TOr (Nu l) (Nu r)
  Nu ('TThen l r) = 'TThen (Nu l) (Nu r)
  Nu ('TStar r) = 'TEmpty

-- | Auxiliary function for 'derivative'.
--
-- Value-level version of 'Nu'.
--
-- See Wikipedia on "Brzozowski derivative"
nu :: RegexRepr f r -> RegexRepr f (Nu r)
nu :: forall {k} (f :: k -> *) (r :: Regex k).
RegexRepr f r -> RegexRepr f (Nu r)
nu =
  \case
    RegexRepr f r
Empty -> RegexRepr f (Nu r)
RegexRepr f 'TEmpty
forall k (f :: k -> *). RegexRepr f 'TEmpty
Empty
    RegexRepr f r
Fail -> RegexRepr f (Nu r)
RegexRepr f 'TFail
forall k (f :: k -> *). RegexRepr f 'TFail
Fail
    Lit {} -> RegexRepr f (Nu r)
RegexRepr f 'TFail
forall k (f :: k -> *). RegexRepr f 'TFail
Fail
    Or RegexRepr f l
l RegexRepr f r
r -> RegexRepr f (Nu l)
-> RegexRepr f (Nu r) -> RegexRepr f ('TOr (Nu l) (Nu r))
forall {k} (f :: k -> *) (l :: Regex k) (r :: Regex k).
RegexRepr f l -> RegexRepr f r -> RegexRepr f ('TOr l r)
Or (RegexRepr f l -> RegexRepr f (Nu l)
forall {k} (f :: k -> *) (r :: Regex k).
RegexRepr f r -> RegexRepr f (Nu r)
nu RegexRepr f l
l) (RegexRepr f r -> RegexRepr f (Nu r)
forall {k} (f :: k -> *) (r :: Regex k).
RegexRepr f r -> RegexRepr f (Nu r)
nu RegexRepr f r
r)
    Star RegexRepr f r
_ -> RegexRepr f (Nu r)
RegexRepr f 'TEmpty
forall k (f :: k -> *). RegexRepr f 'TEmpty
Empty
    Then RegexRepr f l
l RegexRepr f r
r -> RegexRepr f (Nu l)
-> RegexRepr f (Nu r) -> RegexRepr f ('TThen (Nu l) (Nu r))
forall {k} (f :: k -> *) (l :: Regex k) (r :: Regex k).
RegexRepr f l -> RegexRepr f r -> RegexRepr f ('TThen l r)
Then (RegexRepr f l -> RegexRepr f (Nu l)
forall {k} (f :: k -> *) (r :: Regex k).
RegexRepr f r -> RegexRepr f (Nu r)
nu RegexRepr f l
l) (RegexRepr f r -> RegexRepr f (Nu r)
forall {k} (f :: k -> *) (r :: Regex k).
RegexRepr f r -> RegexRepr f (Nu r)
nu RegexRepr f r
r)

-- | The result of 'derivative'
data DerivativeResult f g
  = DerivativeResult
    { -- | The remaining regex after matching that token
      forall {k} {k} (f :: k -> *) (g :: k -> *).
DerivativeResult f g -> Some (RegexRepr f)
derivativeRegex :: Some (RegexRepr f)
      -- | All the literals the token was matched at
    , forall {k} {k} (f :: k -> *) (g :: k -> *).
DerivativeResult f g -> Seq (Some g)
derivativeMatched :: Seq (Some g)
    }

-- | See Wikipedia on "Brzozowski derivative"
derivative ::
  (forall t. f t -> TokenParser tok e g t) ->
  tok ->
  RegexRepr f r ->
  DerivativeResult f g
derivative :: forall {k} (f :: k -> *) tok e (g :: k -> *) (r :: Regex k).
(forall (t :: k). f t -> TokenParser tok e g t)
-> tok -> RegexRepr f r -> DerivativeResult f g
derivative forall (t :: k). f t -> TokenParser tok e g t
getParser tok
tok =
  let noMatch :: Some (RegexRepr f) -> DerivativeResult f g
noMatch Some (RegexRepr f)
r = Some (RegexRepr f) -> Seq (Some g) -> DerivativeResult f g
forall {k} {k} (f :: k -> *) (g :: k -> *).
Some (RegexRepr f) -> Seq (Some g) -> DerivativeResult f g
DerivativeResult Some (RegexRepr f)
r Seq (Some g)
forall a. Seq a
Seq.empty in
  let doFail :: DerivativeResult f g
doFail = Some (RegexRepr f) -> DerivativeResult f g
forall {k} {k} {f :: k -> *} {g :: k -> *}.
Some (RegexRepr f) -> DerivativeResult f g
noMatch (RegexRepr f 'TFail -> Some (RegexRepr f)
forall k (f :: k -> *) (x :: k). f x -> Some f
Some RegexRepr f 'TFail
forall k (f :: k -> *). RegexRepr f 'TFail
Fail) in
  \case
    RegexRepr f r
Empty -> DerivativeResult f g
forall {k} {k} {f :: k -> *} {g :: k -> *}. DerivativeResult f g
doFail
    RegexRepr f r
Fail -> DerivativeResult f g
forall {k} {k} {f :: k -> *} {g :: k -> *}. DerivativeResult f g
doFail
    Lit f t
f ->
      case TokenParser tok e g t -> tok -> Either e (g t)
forall k tok e (f :: k -> *) (t :: k).
TokenParser tok e f t -> tok -> Either e (f t)
runTokenParser (f t -> TokenParser tok e g t
forall (t :: k). f t -> TokenParser tok e g t
getParser f t
f) tok
tok of
        Left e
_ -> DerivativeResult f g
forall {k} {k} {f :: k -> *} {g :: k -> *}. DerivativeResult f g
doFail
        Right g t
m -> Some (RegexRepr f) -> Seq (Some g) -> DerivativeResult f g
forall {k} {k} (f :: k -> *) (g :: k -> *).
Some (RegexRepr f) -> Seq (Some g) -> DerivativeResult f g
DerivativeResult (RegexRepr f 'TEmpty -> Some (RegexRepr f)
forall k (f :: k -> *) (x :: k). f x -> Some f
Some RegexRepr f 'TEmpty
forall k (f :: k -> *). RegexRepr f 'TEmpty
Empty) (Some g -> Seq (Some g)
forall a. a -> Seq a
Seq.singleton (g t -> Some g
forall k (f :: k -> *) (x :: k). f x -> Some f
Some g t
m))
    Or RegexRepr f l
l RegexRepr f r
r ->
      case ((forall (t :: k). f t -> TokenParser tok e g t)
-> tok -> RegexRepr f l -> DerivativeResult f g
forall {k} (f :: k -> *) tok e (g :: k -> *) (r :: Regex k).
(forall (t :: k). f t -> TokenParser tok e g t)
-> tok -> RegexRepr f r -> DerivativeResult f g
derivative f t -> TokenParser tok e g t
forall (t :: k). f t -> TokenParser tok e g t
getParser tok
tok RegexRepr f l
l, (forall (t :: k). f t -> TokenParser tok e g t)
-> tok -> RegexRepr f r -> DerivativeResult f g
forall {k} (f :: k -> *) tok e (g :: k -> *) (r :: Regex k).
(forall (t :: k). f t -> TokenParser tok e g t)
-> tok -> RegexRepr f r -> DerivativeResult f g
derivative f t -> TokenParser tok e g t
forall (t :: k). f t -> TokenParser tok e g t
getParser tok
tok RegexRepr f r
r) of
        (DerivativeResult (Some RegexRepr f x
Fail) Seq (Some g)
_, DerivativeResult f g
r') -> DerivativeResult f g
r'
        (DerivativeResult f g
l', DerivativeResult (Some RegexRepr f x
Fail) Seq (Some g)
_) -> DerivativeResult f g
l'
        (DerivativeResult (Some RegexRepr f x
l') Seq (Some g)
ms, DerivativeResult (Some RegexRepr f x
r') Seq (Some g)
ms') ->
          Some (RegexRepr f) -> Seq (Some g) -> DerivativeResult f g
forall {k} {k} (f :: k -> *) (g :: k -> *).
Some (RegexRepr f) -> Seq (Some g) -> DerivativeResult f g
DerivativeResult (RegexRepr f ('TOr x x) -> Some (RegexRepr f)
forall k (f :: k -> *) (x :: k). f x -> Some f
Some (RegexRepr f x -> RegexRepr f x -> RegexRepr f ('TOr x x)
forall {k} (f :: k -> *) (l :: Regex k) (r :: Regex k).
RegexRepr f l -> RegexRepr f r -> RegexRepr f ('TOr l r)
Or RegexRepr f x
l' RegexRepr f x
r')) (Seq (Some g)
ms Seq (Some g) -> Seq (Some g) -> Seq (Some g)
forall a. Semigroup a => a -> a -> a
<> Seq (Some g)
ms')
    Star RegexRepr f r
f ->
      case (forall (t :: k). f t -> TokenParser tok e g t)
-> tok -> RegexRepr f r -> DerivativeResult f g
forall {k} (f :: k -> *) tok e (g :: k -> *) (r :: Regex k).
(forall (t :: k). f t -> TokenParser tok e g t)
-> tok -> RegexRepr f r -> DerivativeResult f g
derivative f t -> TokenParser tok e g t
forall (t :: k). f t -> TokenParser tok e g t
getParser tok
tok RegexRepr f r
f of
        DerivativeResult (Some RegexRepr f x
f') Seq (Some g)
ms ->
          Some (RegexRepr f) -> Seq (Some g) -> DerivativeResult f g
forall {k} {k} (f :: k -> *) (g :: k -> *).
Some (RegexRepr f) -> Seq (Some g) -> DerivativeResult f g
DerivativeResult (RegexRepr f ('TThen x ('TStar r)) -> Some (RegexRepr f)
forall k (f :: k -> *) (x :: k). f x -> Some f
Some (RegexRepr f x
-> RegexRepr f ('TStar r) -> RegexRepr f ('TThen x ('TStar r))
forall {k} (f :: k -> *) (l :: Regex k) (r :: Regex k).
RegexRepr f l -> RegexRepr f r -> RegexRepr f ('TThen l r)
Then RegexRepr f x
f' (RegexRepr f r -> RegexRepr f ('TStar r)
forall {k} (f :: k -> *) (l :: Regex k).
RegexRepr f l -> RegexRepr f ('TStar l)
Star RegexRepr f r
f))) Seq (Some g)
ms
    Then RegexRepr f l
l RegexRepr f r
r ->
      case ((forall (t :: k). f t -> TokenParser tok e g t)
-> tok -> RegexRepr f l -> DerivativeResult f g
forall {k} (f :: k -> *) tok e (g :: k -> *) (r :: Regex k).
(forall (t :: k). f t -> TokenParser tok e g t)
-> tok -> RegexRepr f r -> DerivativeResult f g
derivative f t -> TokenParser tok e g t
forall (t :: k). f t -> TokenParser tok e g t
getParser tok
tok RegexRepr f l
l, (forall (t :: k). f t -> TokenParser tok e g t)
-> tok -> RegexRepr f r -> DerivativeResult f g
forall {k} (f :: k -> *) tok e (g :: k -> *) (r :: Regex k).
(forall (t :: k). f t -> TokenParser tok e g t)
-> tok -> RegexRepr f r -> DerivativeResult f g
derivative f t -> TokenParser tok e g t
forall (t :: k). f t -> TokenParser tok e g t
getParser tok
tok RegexRepr f r
r) of
        (DerivativeResult (Some  RegexRepr f x
l') Seq (Some g)
ms, DerivativeResult (Some RegexRepr f x
r') Seq (Some g)
ms') ->
          Some (RegexRepr f) -> Seq (Some g) -> DerivativeResult f g
forall {k} {k} (f :: k -> *) (g :: k -> *).
Some (RegexRepr f) -> Seq (Some g) -> DerivativeResult f g
DerivativeResult (RegexRepr f ('TOr ('TThen x r) ('TThen (Nu l) x))
-> Some (RegexRepr f)
forall k (f :: k -> *) (x :: k). f x -> Some f
Some (RegexRepr f ('TThen x r)
-> RegexRepr f ('TThen (Nu l) x)
-> RegexRepr f ('TOr ('TThen x r) ('TThen (Nu l) x))
forall {k} (f :: k -> *) (l :: Regex k) (r :: Regex k).
RegexRepr f l -> RegexRepr f r -> RegexRepr f ('TOr l r)
Or (RegexRepr f x -> RegexRepr f r -> RegexRepr f ('TThen x r)
forall {k} (f :: k -> *) (l :: Regex k) (r :: Regex k).
RegexRepr f l -> RegexRepr f r -> RegexRepr f ('TThen l r)
Then RegexRepr f x
l' RegexRepr f r
r) (RegexRepr f (Nu l)
-> RegexRepr f x -> RegexRepr f ('TThen (Nu l) x)
forall {k} (f :: k -> *) (l :: Regex k) (r :: Regex k).
RegexRepr f l -> RegexRepr f r -> RegexRepr f ('TThen l r)
Then (RegexRepr f l -> RegexRepr f (Nu l)
forall {k} (f :: k -> *) (r :: Regex k).
RegexRepr f r -> RegexRepr f (Nu r)
nu RegexRepr f l
l) RegexRepr f x
r'))) (Seq (Some g)
ms Seq (Some g) -> Seq (Some g) -> Seq (Some g)
forall a. Semigroup a => a -> a -> a
<> Seq (Some g)
ms')

-- | The result of 'match', in case of success
type Match :: (k -> Type) -> Regex k -> Type
data Match k r where
  MEmpty :: Match f 'TEmpty
  MLit :: f t -> Match f ('TLit t)
  MLeft :: Match f l -> Match f ('TOr l r)
  MRight :: Match f r -> Match f ('TOr l r)
  MThen :: Match f l -> Match f r -> Match f ('TThen l r)
  MStar :: [Match f r] -> Match f ('TStar r)

-- | Failures that may arise during 'match'
data MatchError tok e
  = EFail
  | Eof
  | EOr (MatchError tok e) (MatchError tok e)
  | NotEmpty [tok]
  | Token e
  deriving Int -> MatchError tok e -> ShowS
[MatchError tok e] -> ShowS
MatchError tok e -> String
(Int -> MatchError tok e -> ShowS)
-> (MatchError tok e -> String)
-> ([MatchError tok e] -> ShowS)
-> Show (MatchError tok e)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall tok e.
(Show tok, Show e) =>
Int -> MatchError tok e -> ShowS
forall tok e. (Show tok, Show e) => [MatchError tok e] -> ShowS
forall tok e. (Show tok, Show e) => MatchError tok e -> String
$cshowsPrec :: forall tok e.
(Show tok, Show e) =>
Int -> MatchError tok e -> ShowS
showsPrec :: Int -> MatchError tok e -> ShowS
$cshow :: forall tok e. (Show tok, Show e) => MatchError tok e -> String
show :: MatchError tok e -> String
$cshowList :: forall tok e. (Show tok, Show e) => [MatchError tok e] -> ShowS
showList :: [MatchError tok e] -> ShowS
Show

instance (PP.Pretty e, PP.Pretty tok) => PP.Pretty (MatchError tok e) where
  pretty :: forall ann. MatchError tok e -> Doc ann
pretty =
    \case
      MatchError tok e
EFail -> Doc ann
"This regular expression never matches"
      MatchError tok e
Eof -> Doc ann
"Unexpected end of input"
      EOr MatchError tok e
l MatchError tok e
r ->
        [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
PP.vcat
        [ Doc ann
"Both branches failed to match:"
        , Doc ann
"-" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
PP.<+> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
PP.align (MatchError tok e -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. MatchError tok e -> Doc ann
PP.pretty MatchError tok e
l)
        , Doc ann
"-" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
PP.<+> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
PP.align (MatchError tok e -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. MatchError tok e -> Doc ann
PP.pretty MatchError tok e
r)
        ]
      NotEmpty [tok]
toks ->
        Doc ann
"Expected end of input, but found:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
PP.<+> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
PP.hsep ((tok -> Doc ann) -> [tok] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map tok -> Doc ann
forall ann. tok -> Doc ann
forall a ann. Pretty a => a -> Doc ann
PP.pretty [tok]
toks)
      Token e
e -> e -> Doc ann
forall ann. e -> Doc ann
forall a ann. Pretty a => a -> Doc ann
PP.pretty e
e

type TokenParser :: Type -> Type -> (k -> Type) -> k -> Type
newtype TokenParser tok e f t
  = TokenParser { forall k tok e (f :: k -> *) (t :: k).
TokenParser tok e f t -> tok -> Either e (f t)
runTokenParser :: tok -> Either e (f t) }

-- | Match a regular expression against a token stream
match ::
  -- | Regex
  RegexRepr (TokenParser tok e g) r ->
  -- | Token stream
  [tok] ->
  -- | Either a 'MatchError', or a 'Match' plus the unconsumed tokens
  Either (MatchError tok e) (Match g r, [tok])
match :: forall {k} tok e (g :: k -> *) (r :: Regex k).
RegexRepr (TokenParser tok e g) r
-> [tok] -> Either (MatchError tok e) (Match g r, [tok])
match RegexRepr (TokenParser tok e g) r
rgx [tok]
toks =
  case (RegexRepr (TokenParser tok e g) r
rgx, [tok]
toks) of
    (RegexRepr (TokenParser tok e g) r
Fail, [tok]
_) -> MatchError tok e -> Either (MatchError tok e) (Match g r, [tok])
forall a b. a -> Either a b
Left MatchError tok e
forall tok e. MatchError tok e
EFail
    (RegexRepr (TokenParser tok e g) r
Empty, []) -> (Match g r, [tok]) -> Either (MatchError tok e) (Match g r, [tok])
forall a b. b -> Either a b
Right (Match g r
Match g 'TEmpty
forall {k} (f :: k -> *). Match f 'TEmpty
MEmpty, [tok]
toks)
    (RegexRepr (TokenParser tok e g) r
Empty, [tok]
_) -> MatchError tok e -> Either (MatchError tok e) (Match g r, [tok])
forall a b. a -> Either a b
Left ([tok] -> MatchError tok e
forall tok e. [tok] -> MatchError tok e
NotEmpty [tok]
toks)
    (Lit TokenParser tok e g t
_, []) -> MatchError tok e -> Either (MatchError tok e) (Match g r, [tok])
forall a b. a -> Either a b
Left MatchError tok e
forall tok e. MatchError tok e
Eof
    (Lit TokenParser tok e g t
ft, tok
t : [tok]
ts) -> do
      g t
m <- (e -> MatchError tok e)
-> Either e (g t) -> Either (MatchError tok e) (g t)
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first e -> MatchError tok e
forall tok e. e -> MatchError tok e
Token (TokenParser tok e g t -> tok -> Either e (g t)
forall k tok e (f :: k -> *) (t :: k).
TokenParser tok e f t -> tok -> Either e (f t)
runTokenParser TokenParser tok e g t
ft tok
t)
      (Match g r, [tok]) -> Either (MatchError tok e) (Match g r, [tok])
forall a. a -> Either (MatchError tok e) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (g t -> Match g ('TLit t)
forall {k} (f :: k -> *) (l :: k). f l -> Match f ('TLit l)
MLit g t
m, [tok]
ts)
    (Then RegexRepr (TokenParser tok e g) l
l RegexRepr (TokenParser tok e g) r
r, [tok]
ts) -> do
      (Match g l
ml, [tok]
ts') <- RegexRepr (TokenParser tok e g) l
-> [tok] -> Either (MatchError tok e) (Match g l, [tok])
forall {k} tok e (g :: k -> *) (r :: Regex k).
RegexRepr (TokenParser tok e g) r
-> [tok] -> Either (MatchError tok e) (Match g r, [tok])
match RegexRepr (TokenParser tok e g) l
l [tok]
ts
      (Match g r
mr, [tok]
ts'') <- RegexRepr (TokenParser tok e g) r
-> [tok] -> Either (MatchError tok e) (Match g r, [tok])
forall {k} tok e (g :: k -> *) (r :: Regex k).
RegexRepr (TokenParser tok e g) r
-> [tok] -> Either (MatchError tok e) (Match g r, [tok])
match RegexRepr (TokenParser tok e g) r
r [tok]
ts'
      (Match g r, [tok]) -> Either (MatchError tok e) (Match g r, [tok])
forall a. a -> Either (MatchError tok e) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Match g l -> Match g r -> Match g ('TThen l r)
forall {k} (f :: k -> *) (l :: Regex k) (r :: Regex k).
Match f l -> Match f r -> Match f ('TThen l r)
MThen Match g l
ml Match g r
mr, [tok]
ts'')
    (Or RegexRepr (TokenParser tok e g) l
l RegexRepr (TokenParser tok e g) r
r, [tok]
ts) ->
      case RegexRepr (TokenParser tok e g) l
-> [tok] -> Either (MatchError tok e) (Match g l, [tok])
forall {k} tok e (g :: k -> *) (r :: Regex k).
RegexRepr (TokenParser tok e g) r
-> [tok] -> Either (MatchError tok e) (Match g r, [tok])
match RegexRepr (TokenParser tok e g) l
l [tok]
ts of
        Right (Match g l
m, [tok]
ts') -> (Match g r, [tok]) -> Either (MatchError tok e) (Match g r, [tok])
forall a b. b -> Either a b
Right (Match g l -> Match g ('TOr l r)
forall {k} (f :: k -> *) (l :: Regex k) (r :: Regex k).
Match f l -> Match f ('TOr l r)
MLeft Match g l
m, [tok]
ts')
        Left MatchError tok e
ef ->
          case RegexRepr (TokenParser tok e g) r
-> [tok] -> Either (MatchError tok e) (Match g r, [tok])
forall {k} tok e (g :: k -> *) (r :: Regex k).
RegexRepr (TokenParser tok e g) r
-> [tok] -> Either (MatchError tok e) (Match g r, [tok])
match RegexRepr (TokenParser tok e g) r
r [tok]
ts of
            Right (Match g r
m, [tok]
ts') -> (Match g r, [tok]) -> Either (MatchError tok e) (Match g r, [tok])
forall a. a -> Either (MatchError tok e) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Match g r -> Match g ('TOr l r)
forall {k} (f :: k -> *) (l :: Regex k) (r :: Regex k).
Match f l -> Match f ('TOr r l)
MRight Match g r
m, [tok]
ts')
            Left MatchError tok e
eg -> MatchError tok e -> Either (MatchError tok e) (Match g r, [tok])
forall a b. a -> Either a b
Left (MatchError tok e -> MatchError tok e -> MatchError tok e
forall tok e.
MatchError tok e -> MatchError tok e -> MatchError tok e
EOr MatchError tok e
ef MatchError tok e
eg)
    (Star RegexRepr (TokenParser tok e g) r
f, [tok]
ts) ->
      case RegexRepr (TokenParser tok e g) r
-> [tok] -> Either (MatchError tok e) (Match g r, [tok])
forall {k} tok e (g :: k -> *) (r :: Regex k).
RegexRepr (TokenParser tok e g) r
-> [tok] -> Either (MatchError tok e) (Match g r, [tok])
match RegexRepr (TokenParser tok e g) r
f [tok]
ts of
        Left MatchError tok e
_ -> (Match g r, [tok]) -> Either (MatchError tok e) (Match g r, [tok])
forall a b. b -> Either a b
Right ([Match g r] -> Match g ('TStar r)
forall {k} (f :: k -> *) (l :: Regex k).
[Match f l] -> Match f ('TStar l)
MStar [], [tok]
ts)
        Right (Match g r
m, [tok]
ts') ->
          (Match g ('TStar r) -> Match g r)
-> (Match g ('TStar r), [tok]) -> (Match g r, [tok])
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (\(MStar [Match g r]
ms) -> [Match g r] -> Match g ('TStar r)
forall {k} (f :: k -> *) (l :: Regex k).
[Match f l] -> Match f ('TStar l)
MStar (Match g r
m Match g r -> [Match g r] -> [Match g r]
forall a. a -> [a] -> [a]
: [Match g r]
[Match g r]
ms)) ((Match g ('TStar r), [tok]) -> (Match g r, [tok]))
-> Either (MatchError tok e) (Match g ('TStar r), [tok])
-> Either (MatchError tok e) (Match g r, [tok])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RegexRepr (TokenParser tok e g) ('TStar r)
-> [tok] -> Either (MatchError tok e) (Match g ('TStar r), [tok])
forall {k} tok e (g :: k -> *) (r :: Regex k).
RegexRepr (TokenParser tok e g) r
-> [tok] -> Either (MatchError tok e) (Match g r, [tok])
match (RegexRepr (TokenParser tok e g) r
-> RegexRepr (TokenParser tok e g) ('TStar r)
forall {k} (f :: k -> *) (l :: Regex k).
RegexRepr f l -> RegexRepr f ('TStar l)
Star RegexRepr (TokenParser tok e g) r
f) [tok]
ts'

-- | List the literals that could be matched next
nextLits :: RegexRepr f r -> Seq (Some f)
nextLits :: forall {k} (f :: k -> *) (r :: Regex k).
RegexRepr f r -> Seq (Some f)
nextLits =
  \case
    RegexRepr f r
Empty -> Seq (Some f)
forall a. Seq a
Seq.empty
    RegexRepr f r
Fail -> Seq (Some f)
forall a. Seq a
Seq.empty
    Lit f t
x -> Some f -> Seq (Some f)
forall a. a -> Seq a
Seq.singleton (f t -> Some f
forall k (f :: k -> *) (x :: k). f x -> Some f
Some f t
x)
    Or RegexRepr f l
l RegexRepr f r
r -> RegexRepr f l -> Seq (Some f)
forall {k} (f :: k -> *) (r :: Regex k).
RegexRepr f r -> Seq (Some f)
nextLits RegexRepr f l
l Seq (Some f) -> Seq (Some f) -> Seq (Some f)
forall a. Semigroup a => a -> a -> a
<> RegexRepr f r -> Seq (Some f)
forall {k} (f :: k -> *) (r :: Regex k).
RegexRepr f r -> Seq (Some f)
nextLits RegexRepr f r
r
    Star RegexRepr f r
r -> RegexRepr f r -> Seq (Some f)
forall {k} (f :: k -> *) (r :: Regex k).
RegexRepr f r -> Seq (Some f)
nextLits RegexRepr f r
r
    Then RegexRepr f l
l RegexRepr f r
r ->
      case RegexRepr f l -> BoolRepr (AcceptsEmpty l)
forall {k} (f :: k -> *) (r :: Regex k).
RegexRepr f r -> BoolRepr (AcceptsEmpty r)
acceptsEmpty RegexRepr f l
l of
        BoolRepr (AcceptsEmpty l)
TrueRepr -> RegexRepr f l -> Seq (Some f)
forall {k} (f :: k -> *) (r :: Regex k).
RegexRepr f r -> Seq (Some f)
nextLits RegexRepr f l
l Seq (Some f) -> Seq (Some f) -> Seq (Some f)
forall a. Semigroup a => a -> a -> a
<> RegexRepr f r -> Seq (Some f)
forall {k} (f :: k -> *) (r :: Regex k).
RegexRepr f r -> Seq (Some f)
nextLits RegexRepr f r
r
        BoolRepr (AcceptsEmpty l)
FalseRepr -> RegexRepr f l -> Seq (Some f)
forall {k} (f :: k -> *) (r :: Regex k).
RegexRepr f r -> Seq (Some f)
nextLits RegexRepr f l
l

-- | Syntactic sugar for displaying 'RegexRepr's, especially for quantification
type Sugar :: (k -> Type) -> Regex k -> Type
data Sugar f r where
  SEmpty :: Sugar f 'TEmpty
  SFail :: Sugar f 'TFail
  SLit :: f t -> Sugar f ('TLit t)
  SOptL :: Sugar f l -> Sugar f ('TOr l Empty)
  SOptR :: Sugar f r -> Sugar f ('TOr Empty r)
  SOr :: Sugar f l -> Sugar f r -> Sugar f ('TOr l r)
  SSomeL :: Sugar f l -> Sugar f ('TOr ('TStar r) r)
  SSomeR :: Sugar f r -> Sugar f ('TOr r ('TStar r))
  SStar :: Sugar f r -> Sugar f ('TStar r)
  SThen :: Sugar f l -> Sugar f r -> Sugar f ('TThen l r)

sugar :: TestEquality f => RegexRepr f r -> Sugar f r
sugar :: forall {k} (f :: k -> *) (r :: Regex k).
TestEquality f =>
RegexRepr f r -> Sugar f r
sugar =
  \case
    RegexRepr f r
Empty -> Sugar f r
Sugar f 'TEmpty
forall {k} (f :: k -> *). Sugar f 'TEmpty
SEmpty
    RegexRepr f r
Fail -> Sugar f r
Sugar f 'TFail
forall {k} (f :: k -> *). Sugar f 'TFail
SFail
    Lit f t
l -> f t -> Sugar f ('TLit t)
forall {k} (f :: k -> *) (l :: k). f l -> Sugar f ('TLit l)
SLit f t
l
    Or RegexRepr f l
l RegexRepr f r
Empty -> Sugar f l -> Sugar f ('TOr l 'TEmpty)
forall {k} (f :: k -> *) (l :: Regex k).
Sugar f l -> Sugar f ('TOr l Empty)
SOptL (RegexRepr f l -> Sugar f l
forall {k} (f :: k -> *) (r :: Regex k).
TestEquality f =>
RegexRepr f r -> Sugar f r
sugar RegexRepr f l
l)
    Or RegexRepr f l
Empty RegexRepr f r
r -> Sugar f r -> Sugar f ('TOr 'TEmpty r)
forall {k} (f :: k -> *) (l :: Regex k).
Sugar f l -> Sugar f ('TOr Empty l)
SOptR (RegexRepr f r -> Sugar f r
forall {k} (f :: k -> *) (r :: Regex k).
TestEquality f =>
RegexRepr f r -> Sugar f r
sugar RegexRepr f r
r)
    Or (Star RegexRepr f r
l) RegexRepr f r
r | Just r :~: r
Refl <- RegexRepr f r -> RegexRepr f r -> Maybe (r :~: r)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
forall (a :: Regex k) (b :: Regex k).
RegexRepr f a -> RegexRepr f b -> Maybe (a :~: b)
testEquality RegexRepr f r
l RegexRepr f r
r -> Sugar f r -> Sugar f ('TOr ('TStar r) r)
forall {k} (f :: k -> *) (l :: Regex k) (r :: Regex k).
Sugar f l -> Sugar f ('TOr ('TStar r) r)
SSomeL (RegexRepr f r -> Sugar f r
forall {k} (f :: k -> *) (r :: Regex k).
TestEquality f =>
RegexRepr f r -> Sugar f r
sugar RegexRepr f r
l)
    Or RegexRepr f l
l (Star RegexRepr f r
r) | Just l :~: r
Refl <- RegexRepr f l -> RegexRepr f r -> Maybe (l :~: r)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
forall (a :: Regex k) (b :: Regex k).
RegexRepr f a -> RegexRepr f b -> Maybe (a :~: b)
testEquality RegexRepr f l
l RegexRepr f r
r -> Sugar f l -> Sugar f ('TOr l ('TStar l))
forall {k} (f :: k -> *) (l :: Regex k).
Sugar f l -> Sugar f ('TOr l ('TStar l))
SSomeR (RegexRepr f l -> Sugar f l
forall {k} (f :: k -> *) (r :: Regex k).
TestEquality f =>
RegexRepr f r -> Sugar f r
sugar RegexRepr f l
l)
    Or RegexRepr f l
l RegexRepr f r
r -> Sugar f l -> Sugar f r -> Sugar f ('TOr l r)
forall {k} (f :: k -> *) (l :: Regex k) (r :: Regex k).
Sugar f l -> Sugar f r -> Sugar f ('TOr l r)
SOr (RegexRepr f l -> Sugar f l
forall {k} (f :: k -> *) (r :: Regex k).
TestEquality f =>
RegexRepr f r -> Sugar f r
sugar RegexRepr f l
l) (RegexRepr f r -> Sugar f r
forall {k} (f :: k -> *) (r :: Regex k).
TestEquality f =>
RegexRepr f r -> Sugar f r
sugar RegexRepr f r
r)
    Star RegexRepr f r
r -> Sugar f r -> Sugar f ('TStar r)
forall {k} (f :: k -> *) (l :: Regex k).
Sugar f l -> Sugar f ('TStar l)
SStar (RegexRepr f r -> Sugar f r
forall {k} (f :: k -> *) (r :: Regex k).
TestEquality f =>
RegexRepr f r -> Sugar f r
sugar RegexRepr f r
r)
    Then RegexRepr f l
l RegexRepr f r
r -> Sugar f l -> Sugar f r -> Sugar f ('TThen l r)
forall {k} (f :: k -> *) (l :: Regex k) (r :: Regex k).
Sugar f l -> Sugar f r -> Sugar f ('TThen l r)
SThen (RegexRepr f l -> Sugar f l
forall {k} (f :: k -> *) (r :: Regex k).
TestEquality f =>
RegexRepr f r -> Sugar f r
sugar RegexRepr f l
l) (RegexRepr f r -> Sugar f r
forall {k} (f :: k -> *) (r :: Regex k).
TestEquality f =>
RegexRepr f r -> Sugar f r
sugar RegexRepr f r
r)

-- | Lift top-level 'Or's (i.e., those not under quantifiers)
liftOrs :: Sugar f r -> Seq (Some (Sugar f))
liftOrs :: forall {k} (f :: k -> *) (r :: Regex k).
Sugar f r -> Seq (Some (Sugar f))
liftOrs =
  \case
    Sugar f r
SEmpty -> Some (Sugar f) -> Seq (Some (Sugar f))
forall a. a -> Seq a
Seq.singleton (Sugar f 'TEmpty -> Some (Sugar f)
forall k (f :: k -> *) (x :: k). f x -> Some f
Some Sugar f 'TEmpty
forall {k} (f :: k -> *). Sugar f 'TEmpty
SEmpty)
    Sugar f r
SFail -> Seq (Some (Sugar f))
forall a. Seq a
Seq.empty
    SLit f t
x -> Some (Sugar f) -> Seq (Some (Sugar f))
forall a. a -> Seq a
Seq.singleton (Sugar f ('TLit t) -> Some (Sugar f)
forall k (f :: k -> *) (x :: k). f x -> Some f
Some (f t -> Sugar f ('TLit t)
forall {k} (f :: k -> *) (l :: k). f l -> Sugar f ('TLit l)
SLit f t
x))
    r :: Sugar f r
r@(SOptL {}) -> Some (Sugar f) -> Seq (Some (Sugar f))
forall a. a -> Seq a
Seq.singleton (Sugar f r -> Some (Sugar f)
forall k (f :: k -> *) (x :: k). f x -> Some f
Some Sugar f r
r)
    r :: Sugar f r
r@(SOptR {}) -> Some (Sugar f) -> Seq (Some (Sugar f))
forall a. a -> Seq a
Seq.singleton (Sugar f r -> Some (Sugar f)
forall k (f :: k -> *) (x :: k). f x -> Some f
Some Sugar f r
r)
    SOr Sugar f l
l Sugar f r
r -> Sugar f l -> Seq (Some (Sugar f))
forall {k} (f :: k -> *) (r :: Regex k).
Sugar f r -> Seq (Some (Sugar f))
liftOrs Sugar f l
l Seq (Some (Sugar f))
-> Seq (Some (Sugar f)) -> Seq (Some (Sugar f))
forall a. Semigroup a => a -> a -> a
<> Sugar f r -> Seq (Some (Sugar f))
forall {k} (f :: k -> *) (r :: Regex k).
Sugar f r -> Seq (Some (Sugar f))
liftOrs Sugar f r
r
    r :: Sugar f r
r@(SSomeL {}) -> Some (Sugar f) -> Seq (Some (Sugar f))
forall a. a -> Seq a
Seq.singleton (Sugar f r -> Some (Sugar f)
forall k (f :: k -> *) (x :: k). f x -> Some f
Some Sugar f r
r)
    r :: Sugar f r
r@(SSomeR {}) -> Some (Sugar f) -> Seq (Some (Sugar f))
forall a. a -> Seq a
Seq.singleton (Sugar f r -> Some (Sugar f)
forall k (f :: k -> *) (x :: k). f x -> Some f
Some Sugar f r
r)
    SThen Sugar f l
l Sugar f r
r ->
      [Some (Sugar f)] -> Seq (Some (Sugar f))
forall a. [a] -> Seq a
Seq.fromList
        [ Sugar f ('TThen x x) -> Some (Sugar f)
forall k (f :: k -> *) (x :: k). f x -> Some f
Some (Sugar f x -> Sugar f x -> Sugar f ('TThen x x)
forall {k} (f :: k -> *) (l :: Regex k) (r :: Regex k).
Sugar f l -> Sugar f r -> Sugar f ('TThen l r)
SThen Sugar f x
x Sugar f x
y)
        | Some Sugar f x
x <- Seq (Some (Sugar f)) -> [Some (Sugar f)]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList (Sugar f l -> Seq (Some (Sugar f))
forall {k} (f :: k -> *) (r :: Regex k).
Sugar f r -> Seq (Some (Sugar f))
liftOrs Sugar f l
l)
        , Some Sugar f x
y <- Seq (Some (Sugar f)) -> [Some (Sugar f)]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList (Sugar f r -> Seq (Some (Sugar f))
forall {k} (f :: k -> *) (r :: Regex k).
Sugar f r -> Seq (Some (Sugar f))
liftOrs Sugar f r
r)
        ]
    SStar Sugar f r
r -> Some (Sugar f) -> Seq (Some (Sugar f))
forall a. a -> Seq a
Seq.singleton (Sugar f ('TStar r) -> Some (Sugar f)
forall k (f :: k -> *) (x :: k). f x -> Some f
Some (Sugar f r -> Sugar f ('TStar r)
forall {k} (f :: k -> *) (l :: Regex k).
Sugar f l -> Sugar f ('TStar l)
SStar Sugar f r
r))

prettySugar ::
  -- | Separator for 'SThen'
  PP.Doc ann ->
  (forall t. f t -> PP.Doc ann) ->
  Sugar f r ->
  PP.Doc ann
prettySugar :: forall {k} ann (f :: k -> *) (r :: Regex k).
Doc ann
-> (forall (t :: k). f t -> Doc ann) -> Sugar f r -> Doc ann
prettySugar Doc ann
sep forall (t :: k). f t -> Doc ann
f =
  \case
    Sugar f r
SEmpty -> Doc ann
""
    Sugar f r
SFail -> Doc ann
"∅"
    SLit f t
l -> f t -> Doc ann
forall (t :: k). f t -> Doc ann
f f t
l
    SOptL (SLit f t
l) -> f t -> Doc ann
forall (t :: k). f t -> Doc ann
f f t
l Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
PP.<> Doc ann
"?"
    SOptL Sugar f l
l -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
PP.parens (Doc ann
-> (forall (t :: k). f t -> Doc ann) -> Sugar f l -> Doc ann
forall {k} ann (f :: k -> *) (r :: Regex k).
Doc ann
-> (forall (t :: k). f t -> Doc ann) -> Sugar f r -> Doc ann
prettySugar Doc ann
sep f t -> Doc ann
forall (t :: k). f t -> Doc ann
f Sugar f l
l) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
PP.<> Doc ann
"?"
    SOptR (SLit f t
r) -> f t -> Doc ann
forall (t :: k). f t -> Doc ann
f f t
r Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
PP.<> Doc ann
"?"
    SOptR Sugar f r
r -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
PP.parens (Doc ann
-> (forall (t :: k). f t -> Doc ann) -> Sugar f r -> Doc ann
forall {k} ann (f :: k -> *) (r :: Regex k).
Doc ann
-> (forall (t :: k). f t -> Doc ann) -> Sugar f r -> Doc ann
prettySugar Doc ann
sep f t -> Doc ann
forall (t :: k). f t -> Doc ann
f Sugar f r
r) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
PP.<> Doc ann
"?"
    SOr Sugar f l
l Sugar f r
r -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
PP.parens (Doc ann
-> (forall (t :: k). f t -> Doc ann) -> Sugar f l -> Doc ann
forall {k} ann (f :: k -> *) (r :: Regex k).
Doc ann
-> (forall (t :: k). f t -> Doc ann) -> Sugar f r -> Doc ann
prettySugar Doc ann
sep f t -> Doc ann
forall (t :: k). f t -> Doc ann
f Sugar f l
l Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
PP.<> Doc ann
"|" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
PP.<> Doc ann
-> (forall (t :: k). f t -> Doc ann) -> Sugar f r -> Doc ann
forall {k} ann (f :: k -> *) (r :: Regex k).
Doc ann
-> (forall (t :: k). f t -> Doc ann) -> Sugar f r -> Doc ann
prettySugar Doc ann
sep f t -> Doc ann
forall (t :: k). f t -> Doc ann
f Sugar f r
r)
    SSomeL (SLit f t
l) -> f t -> Doc ann
forall (t :: k). f t -> Doc ann
f f t
l Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
PP.<> Doc ann
"+"
    SSomeL Sugar f l
l -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
PP.parens (Doc ann
-> (forall (t :: k). f t -> Doc ann) -> Sugar f l -> Doc ann
forall {k} ann (f :: k -> *) (r :: Regex k).
Doc ann
-> (forall (t :: k). f t -> Doc ann) -> Sugar f r -> Doc ann
prettySugar Doc ann
sep f t -> Doc ann
forall (t :: k). f t -> Doc ann
f Sugar f l
l) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
PP.<> Doc ann
"+"
    SSomeR (SLit f t
r) -> f t -> Doc ann
forall (t :: k). f t -> Doc ann
f f t
r Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
PP.<> Doc ann
"+"
    SSomeR Sugar f r
r -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
PP.parens (Doc ann
-> (forall (t :: k). f t -> Doc ann) -> Sugar f r -> Doc ann
forall {k} ann (f :: k -> *) (r :: Regex k).
Doc ann
-> (forall (t :: k). f t -> Doc ann) -> Sugar f r -> Doc ann
prettySugar Doc ann
sep f t -> Doc ann
forall (t :: k). f t -> Doc ann
f Sugar f r
r) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
PP.<> Doc ann
"+"
    SStar (SLit f t
l) -> f t -> Doc ann
forall (t :: k). f t -> Doc ann
f f t
l Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
PP.<> Doc ann
"*"
    SStar Sugar f r
r -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
PP.parens (Doc ann
-> (forall (t :: k). f t -> Doc ann) -> Sugar f r -> Doc ann
forall {k} ann (f :: k -> *) (r :: Regex k).
Doc ann
-> (forall (t :: k). f t -> Doc ann) -> Sugar f r -> Doc ann
prettySugar Doc ann
sep f t -> Doc ann
forall (t :: k). f t -> Doc ann
f Sugar f r
r) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
PP.<> Doc ann
"*"
    SThen Sugar f l
l Sugar f r
r -> Doc ann
-> (forall (t :: k). f t -> Doc ann) -> Sugar f l -> Doc ann
forall {k} ann (f :: k -> *) (r :: Regex k).
Doc ann
-> (forall (t :: k). f t -> Doc ann) -> Sugar f r -> Doc ann
prettySugar Doc ann
sep f t -> Doc ann
forall (t :: k). f t -> Doc ann
f Sugar f l
l Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
PP.<> Doc ann
sep Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
PP.<> Doc ann
-> (forall (t :: k). f t -> Doc ann) -> Sugar f r -> Doc ann
forall {k} ann (f :: k -> *) (r :: Regex k).
Doc ann
-> (forall (t :: k). f t -> Doc ann) -> Sugar f r -> Doc ann
prettySugar Doc ann
sep f t -> Doc ann
forall (t :: k). f t -> Doc ann
f Sugar f r
r