module Exon.Class.Exon where
import qualified Data.ByteString.Builder as ByteString
import Data.ByteString.Builder (toLazyByteString)
import qualified Data.Text.Lazy.Builder as Text
import Data.Text.Lazy.Builder (toLazyText)
import Text.Show (showString)
import Exon.Class.Newtype (OverNewtypes, overNewtypes)
import Exon.Data.Result (Result (Empty, Result))
import qualified Exon.Data.Segment as Segment
import Exon.Data.Segment (Segment)
newtype ExonUse a =
ExonUse { forall a. ExonUse a -> a
exonUse :: a }
deriving stock (ExonUse a -> ExonUse a -> Bool
(ExonUse a -> ExonUse a -> Bool)
-> (ExonUse a -> ExonUse a -> Bool) -> Eq (ExonUse a)
forall a. Eq a => ExonUse a -> ExonUse a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExonUse a -> ExonUse a -> Bool
$c/= :: forall a. Eq a => ExonUse a -> ExonUse a -> Bool
== :: ExonUse a -> ExonUse a -> Bool
$c== :: forall a. Eq a => ExonUse a -> ExonUse a -> Bool
Eq, Int -> ExonUse a -> String -> String
[ExonUse a] -> String -> String
ExonUse a -> String
(Int -> ExonUse a -> String -> String)
-> (ExonUse a -> String)
-> ([ExonUse a] -> String -> String)
-> Show (ExonUse a)
forall a. Show a => Int -> ExonUse a -> String -> String
forall a. Show a => [ExonUse a] -> String -> String
forall a. Show a => ExonUse a -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [ExonUse a] -> String -> String
$cshowList :: forall a. Show a => [ExonUse a] -> String -> String
show :: ExonUse a -> String
$cshow :: forall a. Show a => ExonUse a -> String
showsPrec :: Int -> ExonUse a -> String -> String
$cshowsPrec :: forall a. Show a => Int -> ExonUse a -> String -> String
Show)
deriving newtype (String -> ExonUse a
(String -> ExonUse a) -> IsString (ExonUse a)
forall a. IsString a => String -> ExonUse a
forall a. (String -> a) -> IsString a
fromString :: String -> ExonUse a
$cfromString :: forall a. IsString a => String -> ExonUse a
IsString)
class ExonBuilder (inner :: Type) (builder :: Type) | inner -> builder where
exonBuilder :: inner -> builder
default exonBuilder :: inner ~ builder => inner -> builder
exonBuilder =
inner -> builder
forall a. a -> a
id
{-# inline exonBuilder #-}
:: Result builder -> inner
default ::
Monoid builder =>
inner ~ builder =>
Result builder ->
inner
exonBuilderExtract =
Result builder -> inner
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
{-# inline exonBuilderExtract #-}
instance {-# overlappable #-} (
Monoid builder,
inner ~ builder
) => ExonBuilder inner builder where
instance (
ExonBuilder a builder
) => ExonBuilder (ExonUse a) builder where
exonBuilder :: ExonUse a -> builder
exonBuilder =
forall inner builder. ExonBuilder inner builder => inner -> builder
exonBuilder @a (a -> builder) -> (ExonUse a -> a) -> ExonUse a -> builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExonUse a -> a
forall a. ExonUse a -> a
exonUse
exonBuilderExtract :: Result builder -> ExonUse a
exonBuilderExtract =
a -> ExonUse a
forall a. a -> ExonUse a
ExonUse (a -> ExonUse a)
-> (Result builder -> a) -> Result builder -> ExonUse a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Result builder -> a
forall inner builder.
ExonBuilder inner builder =>
Result builder -> inner
exonBuilderExtract
instance ExonBuilder Text Text.Builder where
exonBuilder :: Text -> Builder
exonBuilder =
Text -> Builder
Text.fromText
{-# inline exonBuilder #-}
exonBuilderExtract :: Result Builder -> Text
exonBuilderExtract =
(Builder -> Text) -> Result Builder -> Text
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Text -> Text
forall l s. LazyStrict l s => l -> s
toStrict (Text -> Text) -> (Builder -> Text) -> Builder -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
toLazyText)
{-# inline exonBuilderExtract #-}
instance ExonBuilder LText Text.Builder where
exonBuilder :: Text -> Builder
exonBuilder =
Text -> Builder
Text.fromLazyText
{-# inline exonBuilder #-}
exonBuilderExtract :: Result Builder -> Text
exonBuilderExtract =
(Builder -> Text) -> Result Builder -> Text
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Builder -> Text
toLazyText
{-# inline exonBuilderExtract #-}
instance ExonBuilder ByteString ByteString.Builder where
exonBuilder :: ByteString -> Builder
exonBuilder =
ByteString -> Builder
ByteString.byteString
{-# inline exonBuilder #-}
exonBuilderExtract :: Result Builder -> ByteString
exonBuilderExtract =
(Builder -> ByteString) -> Result Builder -> ByteString
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (ByteString -> ByteString
forall l s. LazyStrict l s => l -> s
toStrict (ByteString -> ByteString)
-> (Builder -> ByteString) -> Builder -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
toLazyByteString)
{-# inline exonBuilderExtract #-}
instance ExonBuilder LByteString ByteString.Builder where
exonBuilder :: ByteString -> Builder
exonBuilder =
ByteString -> Builder
ByteString.lazyByteString
{-# inline exonBuilder #-}
exonBuilderExtract :: Result Builder -> ByteString
exonBuilderExtract =
(Builder -> ByteString) -> Result Builder -> ByteString
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Builder -> ByteString
toLazyByteString
{-# inline exonBuilderExtract #-}
class ExonString (result :: Type) (builder :: Type) where
exonString :: String -> Result builder
default exonString :: IsString builder => String -> Result builder
exonString =
builder -> Result builder
forall a. a -> Result a
Result (builder -> Result builder)
-> (String -> builder) -> String -> Result builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> builder
forall a. IsString a => String -> a
fromString
{-# inline exonString #-}
exonWhitespace :: String -> Result builder
default exonWhitespace :: String -> Result builder
exonWhitespace =
forall result builder.
ExonString result builder =>
String -> Result builder
exonString @result @builder
{-# inline exonWhitespace #-}
instance {-# overlappable #-} IsString a => ExonString result a where
instance ExonString result (String -> String) where
exonString :: String -> Result (String -> String)
exonString =
(String -> String) -> Result (String -> String)
forall a. a -> Result a
Result ((String -> String) -> Result (String -> String))
-> (String -> String -> String)
-> String
-> Result (String -> String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
showString
{-# inline exonString #-}
class ExonExpression (result :: Type) (inner :: Type) (builder :: Type) where
exonExpression :: (inner -> builder) -> inner -> Result builder
exonExpression inner -> builder
builder =
builder -> Result builder
forall a. a -> Result a
Result (builder -> Result builder)
-> (inner -> builder) -> inner -> Result builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. inner -> builder
builder
{-# inline exonExpression #-}
instance {-# overlappable #-} ExonExpression result inner builder where
class ExonSegment (result :: Type) (inner :: Type) (builder :: Type) where
exonSegment :: (inner -> builder) -> Segment inner -> Result builder
instance {-# overlappable #-} (
ExonString result builder,
ExonExpression result inner builder
) => ExonSegment result inner builder where
exonSegment :: (inner -> builder) -> Segment inner -> Result builder
exonSegment inner -> builder
builder = \case
Segment.String String
a ->
forall result builder.
ExonString result builder =>
String -> Result builder
exonString @result String
a
Segment.Expression inner
a ->
forall result inner builder.
ExonExpression result inner builder =>
(inner -> builder) -> inner -> Result builder
exonExpression @result inner -> builder
builder inner
a
Segment.Whitespace String
a ->
forall result builder.
ExonString result builder =>
String -> Result builder
exonWhitespace @result String
a
{-# inline exonSegment #-}
class ExonAppend (result :: Type) (builder :: Type) where
exonAppend :: builder -> builder -> Result builder
default exonAppend :: Semigroup builder => builder -> builder -> Result builder
exonAppend builder
z builder
a =
builder -> Result builder
forall a. a -> Result a
Result (builder
z builder -> builder -> builder
forall a. Semigroup a => a -> a -> a
<> builder
a)
{-# inline exonAppend #-}
exonConcat :: NonEmpty (Result builder) -> Result builder
exonConcat =
(Result builder -> Result builder -> Result builder)
-> NonEmpty (Result builder) -> Result builder
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 \case
Result builder
Empty -> Result builder -> Result builder
forall a. a -> a
id
Result builder
z -> \case
Result builder
Empty -> builder -> Result builder
forall a. a -> Result a
Result builder
z
Result builder
a -> forall result builder.
ExonAppend result builder =>
builder -> builder -> Result builder
exonAppend @result @builder builder
z builder
a
{-# inline exonConcat #-}
instance {-# overlappable #-} (
Semigroup builder
) => ExonAppend result builder where
instance ExonAppend result (String -> String) where
exonAppend :: (String -> String)
-> (String -> String) -> Result (String -> String)
exonAppend String -> String
z String -> String
a =
(String -> String) -> Result (String -> String)
forall a. a -> Result a
Result (String -> String
z (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
a)
{-# inline exonAppend #-}
class ExonBuild (result :: Type) (inner :: Type) where
exonBuild :: NonEmpty (Segment inner) -> inner
instance {-# overlappable #-} (
ExonAppend result builder,
ExonSegment result inner builder,
ExonBuilder inner builder
) => ExonBuild result inner where
exonBuild :: NonEmpty (Segment inner) -> inner
exonBuild =
Result builder -> inner
forall inner builder.
ExonBuilder inner builder =>
Result builder -> inner
exonBuilderExtract (Result builder -> inner)
-> (NonEmpty (Segment inner) -> Result builder)
-> NonEmpty (Segment inner)
-> inner
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall result builder.
ExonAppend result builder =>
NonEmpty (Result builder) -> Result builder
exonConcat @result (NonEmpty (Result builder) -> Result builder)
-> (NonEmpty (Segment inner) -> NonEmpty (Result builder))
-> NonEmpty (Segment inner)
-> Result builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(Segment inner -> Result builder)
-> NonEmpty (Segment inner) -> NonEmpty (Result builder)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall result inner builder.
ExonSegment result inner builder =>
(inner -> builder) -> Segment inner -> Result builder
exonSegment @result inner -> builder
forall inner builder. ExonBuilder inner builder => inner -> builder
exonBuilder)
{-# inline exonBuild #-}
class Exon (result :: Type) where
exonProcess :: NonEmpty (Segment result) -> result
instance {-# overlappable #-} (
OverNewtypes result inner,
ExonBuild result inner
) => Exon result where
exonProcess :: NonEmpty (Segment result) -> result
exonProcess =
forall result inner.
OverNewtypes result inner =>
(NonEmpty (Segment inner) -> inner)
-> NonEmpty (Segment result) -> result
overNewtypes @result (forall result inner.
ExonBuild result inner =>
NonEmpty (Segment inner) -> inner
exonBuild @result)
{-# inline exonProcess #-}
exonProcessWith ::
∀ wrapped result .
Exon wrapped =>
(result -> wrapped) ->
(wrapped -> result) ->
NonEmpty (Segment result) ->
result
exonProcessWith :: forall wrapped result.
Exon wrapped =>
(result -> wrapped)
-> (wrapped -> result) -> NonEmpty (Segment result) -> result
exonProcessWith result -> wrapped
unwrap wrapped -> result
wrap =
wrapped -> result
wrap (wrapped -> result)
-> (NonEmpty (Segment result) -> wrapped)
-> NonEmpty (Segment result)
-> result
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall result. Exon result => NonEmpty (Segment result) -> result
exonProcess @wrapped (NonEmpty (Segment wrapped) -> wrapped)
-> (NonEmpty (Segment result) -> NonEmpty (Segment wrapped))
-> NonEmpty (Segment result)
-> wrapped
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Segment result -> Segment wrapped)
-> NonEmpty (Segment result) -> NonEmpty (Segment wrapped)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((result -> wrapped) -> Segment result -> Segment wrapped
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap result -> wrapped
unwrap)
{-# inline exonProcessWith #-}