| Safe Haskell | None |
|---|---|
| Language | Haskell2010 |
Exon
Synopsis
- exon :: QuasiQuoter
- 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
- data ExonDefault
- intercalate :: Monoid a => Foldable t => a -> t a -> a
- data Segment a
- = String String
- | Whitespace String
- | Expression a
- data Result a
Documentation
This Haskell library provides quasiquote string interpolation with customizable concatenation for arbitrary types.
The default case uses Monoid and IsString:
import Exon (exon) import Data.Text (toUpper) newtype Name = Name Text deriving newtype (Show, Monoid, IsString) instance Semigroup Name where Name l <> Name r = Name (l <> " | " <> r) lastName :: Name lastName = Fry up :: Name -> Name up (Name name) = Name (toUpper name) >>> [exon|Philip J. #{up lastName}|] Name "Philip | J. | FRY"
Individual segments are tokenized at whitespace boundaries, expressions between `#{` and `}` are inserted verbatim.
The default implementation ignores whitespace when concatenating, while it is preserved for String, Text etc.
exon :: QuasiQuoter Source #
A quasiquoter that allows interpolation, concatenating the resulting segments monoidally.
>>>[exon|write #{show @Text (5 :: Int)} lines of code|] :: Text"write 5 lines of code"
The default implementation for any non-stringly type uses IsString to construct the literal segments and mappend
to combine them, ignoring whitespace segments.
>>>newtype Part = Part Text deriving newtype (Show, Semigroup, Monoid, IsString)
>>>[exon|x #{Part "y"}z|] :: PartPart "xyz"
This behavior can be customized by writing an instance of Exon.
Customizing Concatenation
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.
Instances
data ExonDefault Source #
Instances
Combinators
intercalate :: Monoid a => Foldable t => a -> t a -> a Source #
Monoidally combine all elements in the list, appending the separator between each pair of elements.
Data Types
The parts of an interpolation quasiquote.
Text is split at each whitespace and interpolation splice marked by #{ and }.
Constructors
| String String | |
| Whitespace String | |
| Expression a |
The combined segments, either empty or a value.
Instances
| Foldable Result Source # | |
Defined in Exon.Data.Result Methods fold :: Monoid m => Result m -> m # foldMap :: Monoid m => (a -> m) -> Result a -> m # foldMap' :: Monoid m => (a -> m) -> Result a -> m # foldr :: (a -> b -> b) -> b -> Result a -> b # foldr' :: (a -> b -> b) -> b -> Result a -> b # foldl :: (b -> a -> b) -> b -> Result a -> b # foldl' :: (b -> a -> b) -> b -> Result a -> b # foldr1 :: (a -> a -> a) -> Result a -> a # foldl1 :: (a -> a -> a) -> Result a -> a # elem :: Eq a => a -> Result a -> Bool # maximum :: Ord a => Result a -> a # minimum :: Ord a => Result a -> a # | |
| Eq a => Eq (Result a) Source # | |
| Show a => Show (Result a) Source # | |
| Semigroup a => Semigroup (Result a) Source # | |
| Monoid a => Monoid (Result a) Source # | |