| Safe Haskell | None |
|---|---|
| Language | Haskell2010 |
Exon.Class.Exon
Description
Synopsis
- data ExonDefault
- data KeepWhitespace
- class Exon (tag :: Type) (a :: Type) where
- isEmpty :: a -> Bool
- convertSegment :: Segment a -> Result a
- appendSegment :: Result a -> Segment a -> Result a
- insertWhitespace :: Result a -> String -> Segment a -> Result a
- concatSegments :: NonEmpty (Segment a) -> a
- convertKeepWs :: IsString a => Segment a -> Result a
- concatKeepWs :: forall tag a. Monoid a => Exon tag a => NonEmpty (Segment a) -> a
Documentation
data ExonDefault Source #
Instances
data KeepWhitespace Source #
class Exon (tag :: Type) (a :: Type) where Source #
This class is responsible for combining segments of an interpolated string, allowing users to define their own rules
for how the result is constructed.
The default implementation converts each literal part with IsString and uses the result type's Monoid to
concatenate them.
The raw parts are encoded as Segment, getting combined into a Result.
The default for convertSegment skips whitespace by encoding it into the Result constructor Empty, which is a
unit object.
To change this behavior, it can be easily overridden:
newtype Thing = Thing String deriving newtype (IsString, Semigroup, Monoid, Show)
instance Exon ExonDefault Thing where
convertSegment = case
Segment.String s -> Result (Thing s)
Segment.Expression thing -> Result thing
Segment.Whitespace _ -> Result (Thing " >>> ")
insertWhitespace s1 ws s2 =
appendSegment ExonDefault (appendSegment ExonDefault s1 (Segment.Whitespace ws)) s2
Minimal complete definition
Nothing
Methods
This check is used to allow empty expression segments to be skipped when they are empty. The default is to never skip expressions.
convertSegment :: Segment a -> Result a Source #
Convert a Segment to a Result.
The default implementation uses IsString and ignores whitespace, returning Empty.
appendSegment :: Result a -> Segment a -> Result a Source #
insertWhitespace :: Result a -> String -> Segment a -> Result a Source #
Append whitespace and a Segment to a Result, i.e. joining two parts of the interpolation by whitespace.
The default implementation ignores the whitespace, calling appendSegment with the second argument.
concatSegments :: NonEmpty (Segment a) -> a Source #
The entry point for concatenation, taking a list of segments parsed from the interpolation.
The default implementation skips leading whitespace and calls appendSegment and insertWhitespace to
concatenate.