Copyright | (c) Justin Leitgeb |
---|---|
License | MIT |
Maintainer | [email protected] |
Stability | unstable |
Portability | portable |
Safe Haskell | Safe-Inferred |
Language | Haskell2010 |
Text.Inflections
Description
This module provides methods for common Text
transformations, similar
to the Inflections library found in Rails:
While many of the functions in this library are the same as in
implementations in Rails' ActiveSupport, the philosophy of this library
is fundamentally different. Where Rails tries to be as permissive as
possible, and return a String when given any input, this library tries to
output Text
that makes sense according to the function that is called.
When you look closely at many of the functions in Rails' inflections
library, you will notice that many of them are partial. That is, they
only have well-defined output for some of the possible inputs to the
function allowed by the type system. As an example, let's take the
underscore
function. In Rails, it works like this:
>>>
"fooBar".underscore
"foo_bar"
Looks OK so far. However, it's also easy to produce less expected results:
>>>
"foo bar".underscore
"foo bar"
The output isn't underscored — it contains a space! It turns out that some of the functions from Inflections in ActiveSupport are partial. I.e., the outputs are really only specified for a certain range of the inputs allowed by the String type.
In the Haskell inflections library, we aim to deliver more predictable results by separating the parsing of strings into tokens from the application of transformations. Let's see an example.
First, we tokenize an underscored Text
using parseSnakeCase
:
>>>
parseSnakeCase [] "foo_bar"
Right [Word "foo",Word "bar"]
We can chain together the tokenization of the input String and the
transformation to CamelCase by using fmap
:
>>>
camelize <$> parseSnakeCase [] "foo_bar"
Right "FooBar"
By separating out the tokenization from the application of inflections, we also end up with useful libraries for validating input which can be used independently:
>>>
parseSnakeCase [] "fooBar"
1:4: unexpected 'B' expecting '_', end of input, or lowercase letter
As of version 0.3.0.0, we don't permit creation of invalid Word
s by
using of the smart constructors mkWord
and mkAcronym
. This is done
because not every Text
value is a valid Word
, as it should not
contain whitespace, for example. Normal words have the type
, while acronyms have the type Word
Normal
. If you need
to have several words/acronyms in a single list, use the existential
wrapper Word
Acronym
SomeWord
. Parsing functions now produce SomeWord
s.
This library is still a work-in-progress, and contributions are welcome for missing pieces and to fix bugs. Please see the Github page to contribute with code or bug reports:
https://github.com/stackbuilders/inflections-hs
Synopsis
- data Word (t :: WordType)
- data WordType
- mkWord :: MonadThrow m => Text -> m (Word 'Normal)
- mkAcronym :: MonadThrow m => Text -> m (Word 'Acronym)
- unWord :: Word t -> Text
- data SomeWord where
- unSomeWord :: (Text -> Text) -> SomeWord -> Text
- data InflectionException
- parseSnakeCase :: (Foldable f, Functor f) => f (Word 'Acronym) -> Text -> Either (ParseErrorBundle Text Void) [SomeWord]
- parseCamelCase :: (Foldable f, Functor f) => f (Word 'Acronym) -> Text -> Either (ParseErrorBundle Text Void) [SomeWord]
- camelize :: [SomeWord] -> Text
- camelizeCustom :: Bool -> [SomeWord] -> Text
- dasherize :: [SomeWord] -> Text
- humanize :: [SomeWord] -> Text
- humanizeCustom :: Bool -> [SomeWord] -> Text
- underscore :: [SomeWord] -> Text
- titleize :: [SomeWord] -> Text
- type Transliterations = HashMap Char String
- defaultTransliterations :: Transliterations
- parameterize :: Text -> Text
- parameterizeCustom :: Transliterations -> Text -> Text
- transliterate :: Text -> Text
- transliterateCustom :: String -> Transliterations -> Text -> Text
- ordinalize :: (Integral a, Show a) => a -> Text
- ordinal :: Integral a => a -> Text
- toUnderscore :: Text -> Either (ParseErrorBundle Text Void) Text
- toDashed :: Text -> Either (ParseErrorBundle Text Void) Text
- toCamelCased :: Bool -> Text -> Either (ParseErrorBundle Text Void) Text
- toHumanized :: Bool -> Text -> Either (ParseErrorBundle Text Void) Text
- betterThrow :: MonadThrow m => Either (ParseErrorBundle Text Void) a -> m a
Types and helpers
data Word (t :: WordType) Source #
A Text
value that should be kept whole through applied inflections.
mkWord :: MonadThrow m => Text -> m (Word 'Normal) Source #
Create a word from given Text
. The input should consist of only
alpha-numeric characters (no white spaces or punctuation)
InflectionInvalidWord
will be thrown.
since 0.3.0.0
mkAcronym :: MonadThrow m => Text -> m (Word 'Acronym) Source #
Create an acronym from given Text
. The input should consist of only
alpha-numeric characters InflectionInvalidAcronym
will be thrown.
Acronym is different from normal word by that it may not be transformed
by inflections (also see unSomeWord
).
since 0.3.0.0
An existential wrapper that allows to keep words and acronyms in single
list for example. The only thing that receiver of SomeWord
can do is to
apply unWord
on it, of course. This is faciliated by unSomeWord
.
since 0.3.0.0
data InflectionException Source #
The exceptions that is thrown when parsing of input fails.
since 0.3.0.0
Constructors
InflectionParsingFailed (ParseErrorBundle Text Void) | |
InflectionInvalidWord Text | |
InflectionInvalidAcronym Text |
Instances
Parsing
Arguments
:: (Foldable f, Functor f) | |
=> f (Word 'Acronym) | Collection of acronyms |
-> Text | Input |
-> Either (ParseErrorBundle Text Void) [SomeWord] | Result of parsing |
Parse a snake_case string.
>>>
bar <- mkAcronym "bar"
>>>
parseSnakeCase [bar] "foo_bar_bazz"
Right [Word "foo",Acronym "bar",Word "bazz"]
>>>
parseSnakeCase [] "fooBarBazz"
1:4: unexpected 'B' expecting '_', end of input, or lowercase letter
Arguments
:: (Foldable f, Functor f) | |
=> f (Word 'Acronym) | Collection of acronyms |
-> Text | Input |
-> Either (ParseErrorBundle Text Void) [SomeWord] | Result of parsing |
Parse a CamelCase string.
>>>
bar <- mkAcronym "bar"
>>>
parseCamelCase [bar] "FooBarBazz"
Right [Word "Foo",Acronym "Bar",Word "Bazz"]
>>>
parseCamelCase [] "foo_bar_bazz"
1:4: unexpected '_' expecting end of input, lowercase letter, or uppercase letter
Rendering
Turn an input word list in into CamelCase.
>>>
foo <- SomeWord <$> mkWord "foo"
>>>
bar <- SomeWord <$> mkAcronym "bar"
>>>
bazz <- SomeWord <$> mkWord "bazz"
>>>
camelize [foo,bar,bazz]
"FoobarBazz"
Arguments
:: Bool | Whether to capitalize the first character in the output String |
-> [SomeWord] | The input Words |
-> Text | The camelized |
Turn an input word list into a CamelCase String.
>>>
foo <- SomeWord <$> mkWord "foo"
>>>
bar <- SomeWord <$> mkAcronym "bar"
>>>
bazz <- SomeWord <$> mkWord "bazz"
>>>
camelizeCustom False [foo,bar,bazz]
"foobarBazz"
Produce a string with words separated by dashes (hyphens).
>>>
foo <- SomeWord <$> mkWord "foo"
>>>
bar <- SomeWord <$> mkAcronym "bar"
>>>
bazz <- SomeWord <$> mkWord "bazz"
>>>
dasherize [foo,bar,bazz]
"foo-bar-bazz"
Capitalize the first word and separate words with spaces. Like
titleize
, this is meant for creating pretty
output.
>>>
foo <- SomeWord <$> mkWord "foo"
>>>
bar <- SomeWord <$> mkAcronym "bar"
>>>
bazz <- SomeWord <$> mkWord "bazz"
>>>
humanize [foo,bar,bazz]
"Foo bar bazz"
Arguments
:: Bool | Whether to capitalize the first character in the output String |
-> [SomeWord] | List of words, first of which will be capitalized |
-> Text | The humanized output |
Separate words with spaces, optionally capitalizing the first word. Like
titleize
, this is meant for creating pretty
output.
>>>
foo <- SomeWord <$> mkWord "foo"
>>>
bar <- SomeWord <$> mkAcronym "bar"
>>>
bazz <- SomeWord <$> mkWord "bazz"
>>>
humanizeCustom True [foo,bar,bazz]
"Foo bar bazz">>>
humanizeCustom False [foo,bar,bazz]
"foo bar bazz"
since 0.3.0.0
Separate given words by underscores.
>>>
foo <- SomeWord <$> mkWord "foo"
>>>
bar <- SomeWord <$> mkAcronym "bar"
>>>
bazz <- SomeWord <$> mkWord "bazz"
>>>
underscore [foo,bar,bazz]
"foo_bar_bazz"
Arguments
:: [SomeWord] | List of words, of which all |
-> Text | The titleized |
Capitalize all the SomeWord
words in the input list.
>>>
foo <- SomeWord <$> mkWord "foo"
>>>
bar <- SomeWord <$> mkAcronym "bar"
>>>
bazz <- SomeWord <$> mkWord "bazz"
>>>
titleize [foo,bar,bazz]
"Foo bar Bazz"
type Transliterations = HashMap Char String Source #
A HashMap
containing mappings from international characters to
sequences approximating these characters within the ASCII range.
defaultTransliterations :: Transliterations Source #
These default transliterations are stolen from the Ruby i18n library - see https://github.com/svenfuchs/i18n/blob/master/lib/i18n/backend/transliterator.rb#L41:L69.
NOTE: before version 0.3.0.0 this was called defaultMap
.
parameterize :: Text -> Text Source #
Replace special characters in a string so that it may be used as part
of a pretty
URL. Uses the defaultTransliterations
.
parameterizeCustom :: Transliterations -> Text -> Text Source #
Transliterate Text
with a custom transliteration table.
transliterate :: Text -> Text Source #
Returns a Text
after default approximations for changing Unicode
characters to a valid ASCII range are applied. If you want to supplement
the default approximations with your own, you should use the
transliterateCustom
function instead of transliterate
.
Arguments
:: String | The default replacement |
-> Transliterations | The table of transliterations |
-> Text | The input |
-> Text | The output |
Returns a Text
after default approximations for changing Unicode
characters to a valid ASCII range are applied.
ordinalize :: (Integral a, Show a) => a -> Text Source #
Turns a number into an ordinal string used to denote the position in an ordered sequence such as 1st, 2nd, 3rd, 4th.
>>>
ordinalize 1
"1st">>>
ordinalize 2
"2nd">>>
ordinalize 10
"10th"
ordinal :: Integral a => a -> Text Source #
Returns the suffix that should be added to a number to denote the position in an ordered sequence such as 1st, 2nd, 3rd, 4th.
>>>
ordinal 1
"st">>>
ordinal 2
"nd">>>
ordinal 10
"th"
Often used combinators
toUnderscore :: Text -> Either (ParseErrorBundle Text Void) Text Source #
Transforms CamelCasedString to snake_cased_string_with_underscores.
toUnderscore = fmap underscore . parseCamelCase []
>>>
toUnderscore "FooBarBazz"
"foo_bar_bazz"
toDashed :: Text -> Either (ParseErrorBundle Text Void) Text Source #
Transforms CamelCasedString to snake-cased-string-with-dashes.
toDashed = fmap dasherize . parseCamelCase []
>>>
toDashed "FooBarBazz"
"foo-bar-bazz"
Arguments
:: Bool | Capitalize the first character |
-> Text | Input |
-> Either (ParseErrorBundle Text Void) Text | Output |
Transforms underscored_text to CamelCasedText. If first argument is
True
then the first character in the result string will be in upper case. If
False
then the first character will be in lower case.
toCamelCased c = fmap (camelizeCustom c) . parseSnakeCase []
>>>
toCamelCased True "foo_bar_bazz"
"FooBarBazz">>>
toCamelCased False "foo_bar_bazz"
"fooBarBazz"
Arguments
:: Bool | Capitalize the first character |
-> Text | Input |
-> Either (ParseErrorBundle Text Void) Text | Output |
Transforms underscored_text to space-separated human-readable text.
If first argument is True
then the first character in the result
string will be in upper case. If False
then the first character will be
in lower case.
toHumanized c = fmap (humanizeCustom c) . parseSnakeCase []
>>>
toHumanized True "foo_bar_bazz"
"Foo bar bazz">>>
toHumanized False "foo_bar_bazz"
"foo bar bazz"
since 0.3.0.0
betterThrow :: MonadThrow m => Either (ParseErrorBundle Text Void) a -> m a Source #
Lift something of type
to
an instance of Either
(ParseError
Char
Void
) aMonadThrow
. Useful when you want to shortcut on parsing
failures and you're in an instance of MonadThrow
.
This throws InflectionParsingFailed
if given value is inside Left
.
since 0.3.0.0