exon-0.1.0.0: Monoidal Quasiquote Interpolation
Safe HaskellNone
LanguageHaskell2010

Exon

Synopsis

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|] :: Part
Part "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

isEmpty :: a -> Bool Source #

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.

default convertSegment :: IsString a => Segment a -> Result a Source #

appendSegment :: Result a -> Segment a -> Result a Source #

Append a Segment to a Result. The default implementation uses (<>).

default appendSegment :: Semigroup a => 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.

default insertWhitespace :: Result a -> String -> Segment a -> Result a Source #

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.

default concatSegments :: Monoid a => NonEmpty (Segment a) -> a Source #

Instances

Instances details
(Monoid a, IsString a) => Exon ExonDefault a Source # 
Instance details

Defined in Exon.Class.Exon

Exon ExonDefault String Source # 
Instance details

Defined in Exon.Class.Exon

Exon ExonDefault ByteString Source # 
Instance details

Defined in Exon.Class.Exon

Exon ExonDefault Text Source # 
Instance details

Defined in Exon.Class.Exon

Exon ExonDefault LByteString Source # 
Instance details

Defined in Exon.Class.Exon

Exon ExonDefault LText Source # 
Instance details

Defined in Exon.Class.Exon

data ExonDefault Source #

Instances

Instances details
(Monoid a, IsString a) => Exon ExonDefault a Source # 
Instance details

Defined in Exon.Class.Exon

Exon ExonDefault String Source # 
Instance details

Defined in Exon.Class.Exon

Exon ExonDefault ByteString Source # 
Instance details

Defined in Exon.Class.Exon

Exon ExonDefault Text Source # 
Instance details

Defined in Exon.Class.Exon

Exon ExonDefault LByteString Source # 
Instance details

Defined in Exon.Class.Exon

Exon ExonDefault LText Source # 
Instance details

Defined in Exon.Class.Exon

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

data Segment a Source #

The parts of an interpolation quasiquote. Text is split at each whitespace and interpolation splice marked by #{ and }.

Instances

Instances details
Eq a => Eq (Segment a) Source # 
Instance details

Defined in Exon.Data.Segment

Methods

(==) :: Segment a -> Segment a -> Bool #

(/=) :: Segment a -> Segment a -> Bool #

Show a => Show (Segment a) Source # 
Instance details

Defined in Exon.Data.Segment

Methods

showsPrec :: Int -> Segment a -> ShowS #

show :: Segment a -> String #

showList :: [Segment a] -> ShowS #

data Result a Source #

The combined segments, either empty or a value.

Constructors

Empty 
Result a 

Instances

Instances details
Foldable Result Source # 
Instance details

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 #

toList :: Result a -> [a] #

null :: Result a -> Bool #

length :: Result a -> Int #

elem :: Eq a => a -> Result a -> Bool #

maximum :: Ord a => Result a -> a #

minimum :: Ord a => Result a -> a #

sum :: Num a => Result a -> a #

product :: Num a => Result a -> a #

Eq a => Eq (Result a) Source # 
Instance details

Defined in Exon.Data.Result

Methods

(==) :: Result a -> Result a -> Bool #

(/=) :: Result a -> Result a -> Bool #

Show a => Show (Result a) Source # 
Instance details

Defined in Exon.Data.Result

Methods

showsPrec :: Int -> Result a -> ShowS #

show :: Result a -> String #

showList :: [Result a] -> ShowS #

Semigroup a => Semigroup (Result a) Source # 
Instance details

Defined in Exon.Data.Result

Methods

(<>) :: Result a -> Result a -> Result a #

sconcat :: NonEmpty (Result a) -> Result a #

stimes :: Integral b => b -> Result a -> Result a #

Monoid a => Monoid (Result a) Source # 
Instance details

Defined in Exon.Data.Result

Methods

mempty :: Result a #

mappend :: Result a -> Result a -> Result a #

mconcat :: [Result a] -> Result a #