| Safe Haskell | None |
|---|---|
| Language | Haskell2010 |
Prelude.Spiros.Pretty
Description
Pretty-printing and Parsing, with standard casing/capitalization.
TODO separate packages?
simple-print-parse re-exports these packages:
simple-print;simple-parse, which has more dependencies (like on theexceptionspackage).
Description
Provides utilities (and aliases) for defining simple ad-hoc parsers and (pretty-)printers for types (especially sum types).
Motivation
Useful when:
- you want your program to print out a human-friendly representations of haskell types, or to be able to consume them in either a consistent format or a versatile format;
- but, you don't want to be burdened by a dependency on some parser package.
(i.e. by "human-friendly", I mean "more pleasantly readable and writable than with Show / Read").
uses of Print include:
- error messages.
uses of Parse include:
- command-line options.
Features
Such "formats" include:
- several "casing formats", like
ClassCaseorCamelCase; - several "separator formats", like
UnderscoreCaseorHyphenCase; - plus, variations of the above.
i.e. the user can define custom capitalization (via WordCasing) or a custom separator (via WordSeparator).
by default, each format's utility functions assume that:
- constructors are written in (the conventional) class-case (i.e.
ClassCase); and - the types are finite (satisfying
EnumorGEnum).
but, each format's module also provides (more general) versions, which can be given:
- some list of values; or,
- even manually tokenized strings.
Examples
to print out a constructor, the default toPrinter function does the following:
showit;- break up the string shown in its words and/or subwords;
- merge that list of strings (back into a single string) via some
TokenStyle(by default,HyphenCase).
HyphenCase being the most readable, imo. it's most common token style for: command line options, URLs, and so on.
Naming
NOTE In this package, the word "print" means "convert to a human-friendly string", not "write to stdout".
Synopsis
- type Print a = a -> String
- type Parse a = forall m. MonadThrow m => ParseM m a
- type ParseM m a = String -> m a
- newtype SimpleParserM (m :: * -> *) (a :: *) = SimpleParserM {
- getSimpleParserM :: String -> m a
- data TokenStyle = TokenStyle {}
- newtype WordSeparator = WordSeparator (Maybe Char)
- data WordCasing = WordCasing {}
- data SubwordCasing
- data KnownTokenStyle
- pattern SnakeCase :: KnownTokenStyle
- pattern KebabCase :: KnownTokenStyle
- pattern BashCase :: KnownTokenStyle
- pattern PythonCase :: KnownTokenStyle
- pattern LispCase :: KnownTokenStyle
- pattern HaskellCase :: KnownTokenStyle
- pattern ModuleCase :: KnownTokenStyle
- pattern PackageCase :: KnownTokenStyle
- pattern FilepathCase :: KnownTokenStyle
- type ShowPrinter t a = (Enum a, Show a, IsString t)
- type ReadParser t a = (Read a, String ~ t)
- data PrintConfig t a = PrintConfig {
- style :: TokenStyle
- showHaskell :: a -> t
- defaultPrintConfig :: ShowPrinter t a => PrintConfig t a
- data ParseConfig t a = ParseConfig {
- styles :: [TokenStyle]
- readHaskell :: t -> Maybe a
- defaultParseConfig :: ReadParser t a => ParseConfig t a
- printer :: ShowPrinter String a => Print a
- printerWith :: PrintConfig String a -> Print a
- parser :: ReadParser String a => Parse a
- parserWith :: ParseConfig String a -> Parse a
- newtype Tokens = Tokens (NonEmpty Token)
- unsafeTokensFromList :: [Token] -> Tokens
- data Token
- toSubwordToken :: String -> Token
- toAcronymToken :: String -> Token
- newtype Subword = Subword String
- safeSubword :: String -> Maybe Subword
- unsafeSubword :: String -> Subword
- data AcronymStyle
- defaultAcronymStyle :: AcronymStyle
- data TokenizationConfig = TokenizationConfig {}
- data PrintTokenConfig = PrintTokenConfig {}
- data ParseTokenConfig = ParseTokenConfig {}
- restyleString :: TokenizationConfig -> String -> String
- restyleClassCasedToHyphenated :: String -> String
- printTokens :: PrintTokenConfig -> Tokens -> String
- intersperseBySeparator :: WordSeparator -> NonEmpty String -> NonEmpty String
- capitalizeByCasing :: WordCasing -> NonEmpty String -> NonEmpty String
- capitalizeBy :: SubwordCasing -> String -> String
- lowercaseString :: String -> String
- titlecaseString :: String -> String
- uppercaseString :: String -> String
- printToken :: PrintTokenConfig -> Token -> String
- parseTokens :: ParseTokenConfig -> String -> Tokens
- parseToken :: ParseTokenConfig -> String -> Token
- fromKnownTokenStyle :: KnownTokenStyle -> TokenStyle
- separatorTokenStyle :: Char -> TokenStyle
- emptyTokenStyle :: TokenStyle
- uniformWordCasing :: SubwordCasing -> WordCasing
- noSeparator :: WordSeparator
- charSeparator :: Char -> WordSeparator
Documentation
type Print a = a -> String Source #
Simple printer.
Usage:
Here is an example printer,
printVerbosity :: Parse Verbosity
printVerbosity = case
Concise -> "concise"
Verbose -> "verbose"
for this type
data Verbosity = Concise | Verbose
type Parse a = forall m. MonadThrow m => ParseM m a Source #
Simple parser.
Expansions.
Parsea ≡ (MonadThrowm) =>ParseMm a ≡ (MonadThrowm) => (String -> m a)
Specializations.
Specializations include:
Parsea ≡ (String ->Maybea)Parsea ≡ (String -> [a])Parsea ≡ (String ->EitherSomeExceptiona)Parsea ≡ (String ->IOa)
Usage:
Here is an example parser,
parseVerbosity ::ParseVerbosity parseVerbosity s = go s where go = case "concise" -> return Concise "verbose" -> return Verbose "Concise" -> return Concise "Verbose" -> return Verbose "default" -> return def _ -> throwString s parseVerbosity_Maybe ::ParseMMaybeVerbosity parseVerbosity_Maybe = parseVerbosity
given
data Verbosity = Concise | Verbose instance Default Verbosity where def = Concise
Also see ParseM.
type ParseM m a = String -> m a Source #
Simple parser.
Usage:
Here is an example parser,
parseVerbosity :: (MonadThrowm) =>Parsem Verbosity parseVerbosity s = go s where go = case "concise" -> return Concise "verbose" -> return Verbose "Concise" -> return Concise "Verbose" -> return Verbose "default" -> return def _ -> throwString s parseVerbosity_Maybe ::ParseMaybeVerbosity parseVerbosity_Maybe = parseVerbosity
given
data Verbosity = Concise | Verbose instance Default Verbosity where def = Concise
newtype SimpleParserM (m :: * -> *) (a :: *) Source #
Constructors
| SimpleParserM | |
Fields
| |
Instances
| Functor m => Functor (SimpleParserM m) Source # | |
Defined in Prelude.Spiros.Pretty Methods fmap :: (a -> b) -> SimpleParserM m a -> SimpleParserM m b # (<$) :: a -> SimpleParserM m b -> SimpleParserM m a # | |
| Generic (SimpleParserM m a) Source # | |
Defined in Prelude.Spiros.Pretty Associated Types type Rep (SimpleParserM m a) :: Type -> Type # Methods from :: SimpleParserM m a -> Rep (SimpleParserM m a) x # to :: Rep (SimpleParserM m a) x -> SimpleParserM m a # | |
| type Rep (SimpleParserM m a) Source # | |
Defined in Prelude.Spiros.Pretty type Rep (SimpleParserM m a) = D1 (MetaData "SimpleParserM" "Prelude.Spiros.Pretty" "spiros-0.4.2-AXTfsSIxN6qJkldZU4Dlmr" True) (C1 (MetaCons "SimpleParserM" PrefixI True) (S1 (MetaSel (Just "getSimpleParserM") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (String -> m a)))) | |
data TokenStyle Source #
Constructors
| TokenStyle | |
Fields | |
Instances
newtype WordSeparator Source #
Constructors
| WordSeparator (Maybe Char) |
Instances
data WordCasing Source #
Constructors
| WordCasing | |
Fields | |
Instances
data SubwordCasing Source #
Constructors
| LowerCased | e.g. |
| TitleCased | e.g. |
| UpperCased | e.g. |
Instances
data KnownTokenStyle Source #
Constructors
| CamelCase | e.g. |
| ClassCase | e.g. |
| ConstCase | e.g. |
| PascalCase | e.g. |
| SqueezeCase | e.g. |
| UnderscoreCase | e.g. |
| HyphenCase | e.g. |
| SlashCase | e.g. |
| DotCase | e.g. |
Instances
pattern SnakeCase :: KnownTokenStyle Source #
pattern KebabCase :: KnownTokenStyle Source #
pattern BashCase :: KnownTokenStyle Source #
pattern PythonCase :: KnownTokenStyle Source #
pattern LispCase :: KnownTokenStyle Source #
pattern HaskellCase :: KnownTokenStyle Source #
pattern ModuleCase :: KnownTokenStyle Source #
pattern PackageCase :: KnownTokenStyle Source #
pattern FilepathCase :: KnownTokenStyle Source #
type ReadParser t a = (Read a, String ~ t) Source #
data PrintConfig t a Source #
Constructors
| PrintConfig | |
Fields
| |
Instances
| Generic (PrintConfig t a) Source # | |
Defined in Prelude.Spiros.Pretty Associated Types type Rep (PrintConfig t a) :: Type -> Type # Methods from :: PrintConfig t a -> Rep (PrintConfig t a) x # to :: Rep (PrintConfig t a) x -> PrintConfig t a # | |
| ShowPrinter t a => Default (PrintConfig t a) Source # | = |
Defined in Prelude.Spiros.Pretty Methods def :: PrintConfig t a # | |
| NFData (PrintConfig t a) Source # | |
Defined in Prelude.Spiros.Pretty Methods rnf :: PrintConfig t a -> () # | |
| type Rep (PrintConfig t a) Source # | |
Defined in Prelude.Spiros.Pretty type Rep (PrintConfig t a) = D1 (MetaData "PrintConfig" "Prelude.Spiros.Pretty" "spiros-0.4.2-AXTfsSIxN6qJkldZU4Dlmr" False) (C1 (MetaCons "PrintConfig" PrefixI True) (S1 (MetaSel (Just "style") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 TokenStyle) :*: S1 (MetaSel (Just "showHaskell") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (a -> t)))) | |
defaultPrintConfig :: ShowPrinter t a => PrintConfig t a Source #
data ParseConfig t a Source #
Constructors
| ParseConfig | |
Fields
| |
Instances
| Generic (ParseConfig t a) Source # | |
Defined in Prelude.Spiros.Pretty Associated Types type Rep (ParseConfig t a) :: Type -> Type # Methods from :: ParseConfig t a -> Rep (ParseConfig t a) x # to :: Rep (ParseConfig t a) x -> ParseConfig t a # | |
| ReadParser t a => Default (ParseConfig t a) Source # | = |
Defined in Prelude.Spiros.Pretty Methods def :: ParseConfig t a # | |
| NFData (ParseConfig t a) Source # | |
Defined in Prelude.Spiros.Pretty Methods rnf :: ParseConfig t a -> () # | |
| type Rep (ParseConfig t a) Source # | |
Defined in Prelude.Spiros.Pretty type Rep (ParseConfig t a) = D1 (MetaData "ParseConfig" "Prelude.Spiros.Pretty" "spiros-0.4.2-AXTfsSIxN6qJkldZU4Dlmr" False) (C1 (MetaCons "ParseConfig" PrefixI True) (S1 (MetaSel (Just "styles") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 [TokenStyle]) :*: S1 (MetaSel (Just "readHaskell") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (t -> Maybe a)))) | |
defaultParseConfig :: ReadParser t a => ParseConfig t a Source #
printerWith :: PrintConfig String a -> Print a Source #
parserWith :: ParseConfig String a -> Parse a Source #
Under tokenization (i.e. parsing into tokens), some information about capitalization must be preserved.
For example, this "word":
GHCVersion
is represented as (and should be parsed into):
[toAcronymToken"GHC" ,toSubwordToken"Version" ] ::Tokens
which is equivalent to (i.e. lower-cased and without the smart-constructors):
[AcronymToken"ghc" ,SubwordToken"version" ] ::Tokens
Instances
| IsList Tokens Source # |
NOTE |
| Eq Tokens Source # | |
| Ord Tokens Source # | |
| Read Tokens Source # | |
| Show Tokens Source # | |
| IsString Tokens Source # | ≡ ((i.e. a singleton token.) |
Defined in Prelude.Spiros.Pretty Methods fromString :: String -> Tokens # | |
| Generic Tokens Source # | |
| Semigroup Tokens Source # | |
| NFData Tokens Source # | |
Defined in Prelude.Spiros.Pretty | |
| Hashable Tokens Source # | |
Defined in Prelude.Spiros.Pretty | |
| type Rep Tokens Source # | |
| type Item Tokens Source # | |
Defined in Prelude.Spiros.Pretty | |
unsafeTokensFromList :: [Token] -> Tokens Source #
Dumb constructor.
NOTE fromList is partial, crashing on an empty list literal.
Constructors
| SubwordToken Subword | |
| AcronymToken [Char] | |
| EmptyToken |
Instances
| Eq Token Source # | |
| Ord Token Source # | |
| Read Token Source # | |
| Show Token Source # | |
| IsString Token Source # | = With case-folding via |
Defined in Prelude.Spiros.Pretty Methods fromString :: String -> Token # | |
| Generic Token Source # | |
| FoldCase Token Source # | |
Defined in Prelude.Spiros.Pretty | |
| NFData Token Source # | |
Defined in Prelude.Spiros.Pretty | |
| Hashable Token Source # | |
Defined in Prelude.Spiros.Pretty | |
| type Rep Token Source # | |
Defined in Prelude.Spiros.Pretty type Rep Token = D1 (MetaData "Token" "Prelude.Spiros.Pretty" "spiros-0.4.2-AXTfsSIxN6qJkldZU4Dlmr" False) (C1 (MetaCons "SubwordToken" PrefixI False) (S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Subword)) :+: (C1 (MetaCons "AcronymToken" PrefixI False) (S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 [Char])) :+: C1 (MetaCons "EmptyToken" PrefixI False) (U1 :: Type -> Type))) | |
toSubwordToken :: String -> Token Source #
Smart constructor for SubwordToken.
Calls foldCase for case-insensitivity.
toAcronymToken :: String -> Token Source #
Smart constructor for AcronymToken.
Calls foldCase for case-insensitivity.
Represents one part of word being tokenized.
A valid Subword, like a valid Token, MUST be:
- case-insensitive (i.e.
foldCase); - non-empty (i.e. not
"").
NOTE Subword is a Semigroup but not a Monoid.
Conceptually, it's one-or-more case-folded characters:
NonEmpty(CIChar)
Instances
| Eq Subword Source # | |
| Ord Subword Source # | |
Defined in Prelude.Spiros.Pretty | |
| Read Subword Source # | |
| Show Subword Source # | |
| IsString Subword Source # | ≡ NOTE |
Defined in Prelude.Spiros.Pretty Methods fromString :: String -> Subword # | |
| Generic Subword Source # | |
| Semigroup Subword Source # | |
| Lift Subword Source # | |
| NFData Subword Source # | |
Defined in Prelude.Spiros.Pretty | |
| Hashable Subword Source # | |
Defined in Prelude.Spiros.Pretty | |
| type Rep Subword Source # | |
Defined in Prelude.Spiros.Pretty | |
unsafeSubword :: String -> Subword Source #
Dumb constructor, for Subword.
See safeSubword (which this wraps).
data AcronymStyle Source #
Constructors
| UpperCasedAcronym | |
| TitleCasedAcronym |
Instances
data TokenizationConfig Source #
Constructors
| TokenizationConfig | |
Fields | |
Instances
data PrintTokenConfig Source #
Constructors
| PrintTokenConfig | |
Fields | |
Instances
data ParseTokenConfig Source #
Constructors
| ParseTokenConfig | |
Fields | |
Instances
restyleString :: TokenizationConfig -> String -> String Source #
- Example
- We have an
Enumwhose constructors' names:
- are class-cased (the conventional styling);
- are suffixed by the name of their type;
- and may have acronyms (i.e. an alpha-numeric sequence, with all letters being upper-case).
e.g.:
data Query = WindowIdQuery | WMClassQuery deriving (Enum,Bounded,Show,Read)
- We want to render its constructors' names, as the valid values of a command-line option
i.e.:
printQueryForCmdLn :: Print Query printQueryForCmdLn WindowIdQuery = "window-id printQueryForCmdLn WMClassQuery = "wm-class
NOTE the acronym WM is (correctly) grouped into a single Token; c.f. the (incorrectly) un-grouped "w-m-class", which is less legible.
- We can also print it as an idiomatic command-line option, by (type) name.
i.e.:
printQueryAsLongOptionAndShortOption :: (String, Char)
printQueryAsLongOptionAndShortOption = ("query", q)
e.g. (assuming an executable named ./example):
$ ./example --query=window-id $ ./example -q wm-class
restyleClassCasedToHyphenated :: String -> String Source #
Specializes restyleString;
with ClassCase, HyphenCase, and UpperCasedAcronym.
>>>restyleClassCasedToHyphenated "WMClass""wm-class">>>restyleClassCasedToHyphenated "WindowId""window-id"
printTokens :: PrintTokenConfig -> Tokens -> String Source #
intersperseBySeparator :: WordSeparator -> NonEmpty String -> NonEmpty String Source #
>>>:set -XOverloadedStrings>>>:set -XOverloadedLists>>>toList (intersperseBySeparator (WordSeparator (Just '-')) ["cabal","new","build"])["cabal","-","new","-","build"]>>>toList (intersperseBySeparator (WordSeparator Nothing) ["cabal","new","build"])["cabal","new","build"]
capitalizeByCasing :: WordCasing -> NonEmpty String -> NonEmpty String Source #
capitalizeBy :: SubwordCasing -> String -> String Source #
lowercaseString :: String -> String Source #
titlecaseString :: String -> String Source #
uppercaseString :: String -> String Source #
printToken :: PrintTokenConfig -> Token -> String Source #
parseTokens :: ParseTokenConfig -> String -> Tokens Source #
parseToken :: ParseTokenConfig -> String -> Token Source #
separatorTokenStyle :: Char -> TokenStyle Source #
charSeparator :: Char -> WordSeparator Source #
≡ Just