2016-12-21 15:15:47 +03:00
|
|
|
-- |
|
|
|
|
-- Module : Text.Inflections
|
2016-12-28 13:48:06 +03:00
|
|
|
-- Description : Rails-like inflections library for common Text transformations.
|
2016-12-21 15:15:47 +03:00
|
|
|
-- Copyright : (c) Justin Leitgeb
|
|
|
|
-- License : MIT
|
|
|
|
--
|
|
|
|
-- Maintainer : justin@stackbuilders.com
|
|
|
|
-- Stability : unstable
|
|
|
|
-- Portability : portable
|
|
|
|
--
|
2016-12-28 13:48:06 +03:00
|
|
|
-- This module provides methods for common 'Text' transformations, similar
|
2016-12-21 15:15:47 +03:00
|
|
|
-- to the Inflections library found in Rails:
|
|
|
|
--
|
|
|
|
-- <http://api.rubyonrails.org/classes/ActiveSupport/Inflector.html>
|
|
|
|
--
|
|
|
|
-- 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
|
2016-12-28 13:48:06 +03:00
|
|
|
-- output 'Text' that makes sense according to the function that is called.
|
2016-12-21 15:15:47 +03:00
|
|
|
--
|
|
|
|
-- 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"
|
|
|
|
--
|
2016-12-28 13:48:06 +03:00
|
|
|
-- The output isn't underscored — it contains a space! It turns out that
|
2016-12-21 15:15:47 +03:00
|
|
|
-- 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.
|
|
|
|
--
|
2016-12-28 13:48:06 +03:00
|
|
|
-- First, we tokenize an underscored 'Text' using 'parseSnakeCase':
|
2016-12-21 15:15:47 +03:00
|
|
|
--
|
|
|
|
-- >>> parseSnakeCase [] "foo_bar"
|
|
|
|
-- Right [Word "foo",Word "bar"]
|
|
|
|
--
|
|
|
|
-- We can chain together the tokenization of the input String and the
|
2016-12-21 15:54:27 +03:00
|
|
|
-- transformation to CamelCase by using 'fmap':
|
2016-12-21 15:15:47 +03:00
|
|
|
--
|
2016-12-21 15:54:27 +03:00
|
|
|
-- >>> camelize <$> parseSnakeCase [] "foo_bar"
|
2016-12-21 15:15:47 +03:00
|
|
|
-- 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 @'Word'
|
|
|
|
-- 'Normal'@, while acronyms have the type @'Word' 'Acronym'@. If you need
|
|
|
|
-- to have several words\/acronyms in a single list, use the existential
|
|
|
|
-- wrapper '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>
|
|
|
|
|
|
|
|
{-# LANGUAGE CPP #-}
|
2014-03-08 04:55:09 +04:00
|
|
|
|
2014-02-23 17:34:46 +04:00
|
|
|
module Text.Inflections
|
2016-12-28 13:48:06 +03:00
|
|
|
( -- * Types and helpers
|
|
|
|
Word
|
|
|
|
, WordType (..)
|
|
|
|
, mkWord
|
|
|
|
, mkAcronym
|
|
|
|
, unWord
|
|
|
|
, SomeWord (..)
|
|
|
|
, unSomeWord
|
|
|
|
, InflectionException (..)
|
|
|
|
-- * Parsing
|
|
|
|
, parseSnakeCase
|
2016-12-21 15:15:47 +03:00
|
|
|
, parseCamelCase
|
|
|
|
-- * Rendering
|
|
|
|
, camelize
|
2016-12-16 20:12:09 +03:00
|
|
|
, camelizeCustom
|
|
|
|
, dasherize
|
|
|
|
, humanize
|
2017-07-22 18:22:13 +03:00
|
|
|
, humanizeCustom
|
2016-12-16 20:12:09 +03:00
|
|
|
, underscore
|
|
|
|
, titleize
|
|
|
|
, Transliterations
|
2016-12-21 15:15:47 +03:00
|
|
|
, defaultTransliterations
|
2016-12-16 20:12:09 +03:00
|
|
|
, parameterize
|
|
|
|
, parameterizeCustom
|
|
|
|
, transliterate
|
|
|
|
, transliterateCustom
|
|
|
|
, ordinalize
|
2016-12-21 15:15:47 +03:00
|
|
|
, ordinal
|
2015-01-23 01:31:20 +03:00
|
|
|
-- * Often used combinators
|
2016-12-16 20:12:09 +03:00
|
|
|
, toUnderscore
|
|
|
|
, toDashed
|
2016-12-21 15:54:27 +03:00
|
|
|
, toCamelCased
|
2017-07-22 18:49:03 +03:00
|
|
|
, toHumanized
|
2016-12-21 15:54:27 +03:00
|
|
|
, betterThrow )
|
2014-02-28 01:44:08 +04:00
|
|
|
where
|
2014-02-25 22:39:24 +04:00
|
|
|
|
2016-07-01 20:17:03 +03:00
|
|
|
import Control.Monad.Catch (MonadThrow (..))
|
|
|
|
import Data.Text (Text)
|
2017-08-04 00:39:00 +03:00
|
|
|
import Data.Void (Void)
|
2016-07-01 20:17:03 +03:00
|
|
|
import Text.Inflections.Camelize (camelize, camelizeCustom)
|
|
|
|
import Text.Inflections.Dasherize (dasherize)
|
2016-12-21 15:15:47 +03:00
|
|
|
import Text.Inflections.Data (Transliterations, defaultTransliterations)
|
2017-07-22 18:22:13 +03:00
|
|
|
import Text.Inflections.Humanize (humanize, humanizeCustom)
|
2016-07-01 20:17:03 +03:00
|
|
|
import Text.Inflections.Ordinal (ordinal, ordinalize)
|
|
|
|
import Text.Inflections.Parameterize (parameterize, parameterizeCustom)
|
|
|
|
import Text.Inflections.Parse.CamelCase (parseCamelCase)
|
|
|
|
import Text.Inflections.Parse.SnakeCase (parseSnakeCase)
|
|
|
|
import Text.Inflections.Titleize (titleize)
|
|
|
|
import Text.Inflections.Transliterate (transliterate, transliterateCustom)
|
2016-12-16 20:12:09 +03:00
|
|
|
import Text.Inflections.Types
|
2016-07-01 20:17:03 +03:00
|
|
|
import Text.Inflections.Underscore (underscore)
|
|
|
|
import Text.Megaparsec
|
|
|
|
|
2016-12-21 15:15:20 +03:00
|
|
|
#if MIN_VERSION_base(4,8,0)
|
|
|
|
import Prelude hiding (Word)
|
|
|
|
#endif
|
|
|
|
|
2016-12-21 15:54:27 +03:00
|
|
|
-- | Transforms CamelCasedString to snake_cased_string_with_underscores.
|
|
|
|
--
|
|
|
|
-- > toUnderscore = fmap underscore . parseCamelCase []
|
2016-06-23 11:27:05 +03:00
|
|
|
--
|
|
|
|
-- >>> toUnderscore "FooBarBazz"
|
|
|
|
-- "foo_bar_bazz"
|
2018-10-10 21:50:47 +03:00
|
|
|
toUnderscore :: Text -> Either (ParseErrorBundle Text Void) Text
|
2016-12-21 15:54:27 +03:00
|
|
|
toUnderscore = fmap underscore . parseCamelCase []
|
2016-07-01 20:17:03 +03:00
|
|
|
|
2016-12-21 15:54:27 +03:00
|
|
|
-- | Transforms CamelCasedString to snake-cased-string-with-dashes.
|
|
|
|
--
|
|
|
|
-- > toDashed = fmap dasherize . parseCamelCase []
|
2016-06-23 11:27:05 +03:00
|
|
|
--
|
|
|
|
-- >>> toDashed "FooBarBazz"
|
|
|
|
-- "foo-bar-bazz"
|
2018-10-10 21:50:47 +03:00
|
|
|
toDashed :: Text -> Either (ParseErrorBundle Text Void) Text
|
2016-12-21 15:54:27 +03:00
|
|
|
toDashed = fmap dasherize . parseCamelCase []
|
2015-01-23 01:31:20 +03:00
|
|
|
|
|
|
|
-- | Transforms underscored_text to CamelCasedText. If first argument is
|
2017-07-22 18:49:03 +03:00
|
|
|
-- '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.
|
2016-12-21 15:54:27 +03:00
|
|
|
--
|
2017-07-22 18:49:03 +03:00
|
|
|
-- > toCamelCased c = fmap (camelizeCustom c) . parseSnakeCase []
|
2016-06-23 11:27:05 +03:00
|
|
|
--
|
|
|
|
-- >>> toCamelCased True "foo_bar_bazz"
|
|
|
|
-- "FooBarBazz"
|
|
|
|
-- >>> toCamelCased False "foo_bar_bazz"
|
|
|
|
-- "fooBarBazz"
|
2016-12-21 15:54:27 +03:00
|
|
|
toCamelCased
|
2017-07-22 18:49:03 +03:00
|
|
|
:: Bool -- ^ Capitalize the first character
|
|
|
|
-> Text -- ^ Input
|
2018-10-10 21:50:47 +03:00
|
|
|
-> Either (ParseErrorBundle Text Void) Text -- ^ Output
|
2017-07-22 18:49:03 +03:00
|
|
|
toCamelCased c = fmap (camelizeCustom c) . parseSnakeCase []
|
|
|
|
|
|
|
|
-- | 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/
|
|
|
|
toHumanized
|
|
|
|
:: Bool -- ^ Capitalize the first character
|
|
|
|
-> Text -- ^ Input
|
2018-10-10 21:50:47 +03:00
|
|
|
-> Either (ParseErrorBundle Text Void) Text -- ^ Output
|
2017-07-22 18:49:03 +03:00
|
|
|
toHumanized c = fmap (humanizeCustom c) . parseSnakeCase []
|
2016-12-21 15:54:27 +03:00
|
|
|
|
2017-08-04 00:39:00 +03:00
|
|
|
-- | Lift something of type @'Either' ('ParseError' 'Char' 'Void') a@ to
|
2016-12-21 15:54:27 +03:00
|
|
|
-- an instance of 'MonadThrow'. 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/
|
2016-07-01 20:17:03 +03:00
|
|
|
|
2018-10-10 21:50:47 +03:00
|
|
|
betterThrow :: MonadThrow m => Either (ParseErrorBundle Text Void) a -> m a
|
2016-12-21 15:54:27 +03:00
|
|
|
betterThrow (Left err) = throwM (InflectionParsingFailed err)
|
|
|
|
betterThrow (Right x) = return x
|