ttc (empty) → 0.1.0.0

raw patch · 18 files changed

+2916/−0 lines, 18 filesdep +basedep +bytestringdep +tastysetup-changed

Dependencies added: base, bytestring, tasty, tasty-hunit, template-haskell, text, time, ttc

Files

• CHANGELOG.md +58/−0
• LICENSE +21/−0
• README.md +241/−0
• Setup.hs +2/−0
• examples/CreditCard.hs +230/−0
• examples/Duration.hs +127/−0
• examples/Username.hs +43/−0
• examples/invalid.hs +37/−0
• examples/mkvalid.hs +33/−0
• examples/prompt.hs +87/−0
• examples/uname.hs +22/−0
• examples/valid.hs +37/−0
• src/Data/TTC.hs +641/−0
• src/Data/TTC/Instances.hs +194/−0
• test/Data/TTC/Instances/Test.hs +336/−0
• test/Data/TTC/Test.hs +623/−0
• test/Spec.hs +16/−0
• ttc.cabal +168/−0

@@ -0,0 +1,58 @@+# `ttc-haskell` Changelog++This project follows the [Haskell package versioning policy][PVP], with+versions in `A.B.C.D` format.  `A` may be incremented arbitrarily for+non-technical reasons, but [semantic versioning][SemVer] is otherwise+followed, where `A.B` is the major version, `C` is the minor version, and `D`+is the patch version.  Initial development uses versions `0.0.0.D`, for which+every version is considered breaking.++[PVP]: <https://pvp.haskell.org/>+[SemVer]: <https://semver.org/>++The format of this changelog is based on [Keep a Changelog][KaC], with the+following conventions:++* Level-two heading `Unreleased` is used to track changes that have not been+  released.+* Other level-two headings specify the release in `A.B.C.D (YYYY-MM-DD)`+  format, with newer versions above older versions.+* Level-three headings are used to categorize changes as follows:+    1. Breaking+    2. Non-Breaking+* Changes are listed in arbitrary order and present tense.++[KaC]: <https://keepachangelog.com/en/1.0.0/>++## 0.1.0.0 (2019-12-01)++### Non-Breaking++* Update Cabal file in preparation for release to Hackage++## 0.0.0.4 (2019-11-30)++### Non-Breaking++* Update Cabal file in preparation for release to Hackage+* Update documentation+* Add examples++## 0.0.0.3 (2019-11-28)++### Non-Breaking++* Add continuous integration support++## 0.0.0.2 (2019-11-28)++### Non-Breaking++* Update Cabal metadata+* Update README++## 0.0.0.1 (2019-11-23)++### Breaking++* Initial public release

@@ -0,0 +1,21 @@+The MIT License++Copyright (c) 2019 Travis Cardwell++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in+all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.

@@ -0,0 +1,241 @@+# TTC: Textual Type Classes++[![Build Status](https://travis-ci.com/ExtremaIS/ttc-haskell.svg?branch=master)](https://travis-ci.com/ExtremaIS/ttc-haskell)+[![Hackage](https://img.shields.io/hackage/v/ttc.svg)](https://hackage.haskell.org/package/ttc)+[![Stackage LTS](https://stackage.org/package/ttc/badge/lts)](https://stackage.org/package/ttc)+[![Stackage Nightly](https://stackage.org/package/ttc/badge/nightly)](https://stackage.org/nightly/package/ttc)++* [Overview](#overview)+    * [`Render`](#render)+    * [`Parse`](#parse)+    * [`Textual`](#textual)+* [Related Work](#related-work)+    * [Rendering and Parsing](#rendering-and-parsing)+    * [Constant Validation](#constant-validation)+    * [String Type Conversion](#string-type-conversion)+* [Project](#project)+    * [Links](#links)+    * [Dependencies](#dependencies)+    * [Contribution](#contribution)+    * [License](#license)++## Overview++TTC, an initialism of _Textual Type Classes_, is a library that provides+`Render` and `Parse` type classes for conversion between data types and+textual data types (strings).  Use the `Show` and `Read` type classes for+debugging/development, and use the `Render` and `Parse` type classes for your+own purposes.++The following is a brief overview of the type classes provided by this+library.  See the+[API documentation on Hackage](https://hackage.haskell.org/package/ttc#modules)+for details and the [`examples` directory](examples) for usage examples.++### `Render`++The `Render` type class renders a data type as a [`Textual`](#textual) data+type:++```haskell+class Render a where+  render :: Textual t => a -> t+```++It is analogous to the `Show` type class, which can be reserved for+debugging/development.++The `render` function returns any of the supported textual data types.  Use+the textual data type that is most natural in the implementation of `render`+instances, and return values are converted to other textual data types when+necessary.  The `Show` and `IsString` type classes are not used, so use of the+`String` type is not required.++As a simple example, consider a `Username` type that is implemented as a+`newtype` over `Text`:++```haskell+module Username (Username) where++import Control.Monad (unless, when)+import Data.Char (isAsciiLower)+import qualified Data.Text as T+import Data.Text (Text)+import qualified Data.TTC as TTC++newtype Username = Username Text+  deriving (Eq, Ord, Show)++instance TTC.Render Username where+  render (Username t) = TTC.convert t+```++If a username needs to be included in a `String` error message, conversion is+automatic:++```haskell+putStrLn $ "user not found: " ++ TTC.render uname+```++### `Parse`++The `Parse` type class parses a data type from a [`Textual`](#textual) data+type:++```haskell+class Parse a where+  parse :: Textual t => t -> Either String a+```++It is analogous to the `Read` type class, which can be reserved for+debugging/development.++The `parse` function takes any of the supported textual data types as an+argument.  Use the textual data type that is most natural in the+implementation of `parse` instances, and arguments are converted from other+textual data types when necessary.  The `IsString` type class is not used, so+use of the `String` type is not required.++Here is an example instance for `Username`, implementing some restrictions:++```haskell+instance TTC.Parse Username where+  parse = TTC.asT $ \t-> do+    unless (T.all isAsciiLower t) $ Left "username has invalid characters"+    let len = T.length t+    when (len < 3) $ Left "username has fewer than 3 characters"+    when (len > 12) $ Left "username has more than 12 characters"+    pure $ Username t+```++If a username needs to be parsed from a `String`, conversion is automatic:++```haskell+case TTC.parse "tcard" :: Either String Username of+  Right uname -> putStrLn $ "valid username: " ++ TTC.render uname+  Left err -> putStrLn $ "invalid username: " ++ err+```++It is common to create data types that have "smart constructors" to ensure+that all constructed values are valid.  If the `Username` constructor were+exported, it would be possible to create values with arbitrary `Text`, such+as `Username T.empty`, which is not a valid `Username`.  Smart constructors+can be inconvenient when constructing constants, however, as neither runtime+error handling nor failure are desired.  This library provides Template+Haskell functions that use `Parse` instances to validate such constants at+compile-time.++### `Textual`++The `Textual` type class is used to convert between the following textual data+types:++* `String`+* Strict `Text`+* Lazy `Text`+* Strict `ByteString`+* Lazy `ByteString`++Conversion between any of these types is direct; it is not done through a+fixed textual data type (such as `String` or `Text`).  The key feature of this+type class is that it has a single type variable, making it easy to write+functions that accept arguments and/or returns values that may be any of the+supported textual data types.++Functions are provided to convert to/from the following other textual data+types:++* `Text` `Builder`+* `ByteString` `Builder`+* `ShortByteString`++## Related Work++### Rendering and Parsing++The [relude](https://hackage.haskell.org/package/relude) library has+polymorphic versions of `show` and `readEither` in `Relude.String.Conversion`,+as well as various type classes for converting between string types.  This+does not encourage using `Show` and `Read` instances with syntactically valid+Haskell syntax, and it encourages the using of the `String` data type.++The [rio](https://hackage.haskell.org/package/rio) library has a `Display`+type class with a similar goal as `TTC.Render`.  Since the library encourages+a uniform usage of textual data types, `Display` only provides functions for+rendering to `Text` and a builder format.  It does not have a type class+similar to `TTC.Parse`.++Harry Garrood has an interesting series of blog posts about type classes and+`Show`:++* [Down with Show! Part 1: Rules of thumb for when to use a type class](https://harry.garrood.me/blog/down-with-show-part-1/)+* [Down with Show! Part 2: What's wrong with the Show type class](https://harry.garrood.me/blog/down-with-show-part-2/)+* [Down with Show! Part 3: A replacement for Show](https://harry.garrood.me/blog/down-with-show-part-3/)++### Constant Validation++The+[validated-literals](https://hackage.haskell.org/package/validated-literals)+library has a `Validate` type class that is similar to `TTC.Parse` but+supports conversion between arbitrary types, not just from textual data types.+Template Haskell functions are provided to perform validation at compile-time.+Result types must either have `Lift` instances or equivalent implementations.++Chris Done posted+[a gist](https://gist.github.com/chrisdone/809296b769ee36d352ae4f8dbe89a364)+about implementing statically checked overloaded strings.++### String Type Conversion++There are a number of libraries that simplify conversion between string types.++The+[string-conversions](https://hackage.haskell.org/package/string-conversions)+and [string-conv](https://hackage.haskell.org/package/string-conv) libraries+have type classes with two type variables.  The primary benefit of this+approach is that one can add support for any string type.++The [text-conversions](https://hackage.haskell.org/package/text-conversions)+library converts between string types via the `Text` type, using `FromText`+and `ToText` type classes.  This works well in most cases, but it not optimal+when converting between `ByteString` types.++The [textual](https://hackage.haskell.org/package/textual) library+(deprecated) converts between string types via the `String` type, using a+`Textual` type class (which provides a `toString` function) as well as the+standard `IsString` type class (which provides the `fromString` function).++## Project++### Links++* Hackage: <https://hackage.haskell.org/package/ttc>+* Stackage: <https://stackage.org/package/ttc>+* GitHub: <https://github.com/ExtremaIS/ttc-haskell>+* Travis CI: <https://travis-ci.com/ExtremaIS/ttc-haskell>++### Dependencies++Dependency version bounds are strictly specified according to what versions+have been tested.  If upper bounds need to be bumped when a new package is+released or the package has been tested with earlier versions, feel free to+submit an issue.++### Releases++All releases are tagged in the `master` branch.  Release tags are signed using+the+[`security@extrema.is` GPG key](http://keys.gnupg.net/pks/lookup?op=vindex&fingerprint=on&search=0x1D484E4B4705FADF).++### Contribution++Issues and feature requests are tracked on GitHub:+<https://github.com/ExtremaIS/ttc-haskell/issues>++Issues may also be submitted via email to <bugs@extrema.is>.++### License++This project is released under the+[MIT License](https://opensource.org/licenses/MIT) as specified in the+[`LICENSE`](LICENSE) file.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,230 @@+------------------------------------------------------------------------------+-- |+-- Module      : CreditCard+-- Description : credit card data types+-- Copyright   : Copyright (c) 2019 Travis Cardwell+-- License     : MIT+--+-- This module defines the data types for a credit card, with 'TTC.Render' and+-- 'TTC.Parse' instances, as an example of TTC usage.+--+-- The data types in this module all have 'THS.Lift' instances, to demonstrate+-- how to use 'TTC.valid' in `examples/valid.hs`.  All of the 'THS.Lift'+-- instances are derived, using the `DeriveLift` extension.+--+-- The constructors and accessors of composite data types 'CreditCard' and+-- 'ExpirationDate' are exported, but the constructors for 'Name', 'Number',+-- 'Year', 'Month', and 'SecurityCode' are not.  The 'TTC.Parse' instances+-- serve as "smart constructors," ensuring that all values are valid.+------------------------------------------------------------------------------++{-# LANGUAGE DeriveLift #-}++module CreditCard+  ( -- * CreditCard+    CreditCard(..)+    -- ** Name+  , Name+    -- ** Number+  , Number+    -- ** ExpirationDate+  , ExpirationDate(..)+  , toDay+  , Year+  , Month+    -- ** SecurityCode+  , SecurityCode+  ) where++-- http://hackage.haskell.org/package/base+import Control.Monad (unless, when)+import Data.Char (digitToInt, isDigit, isSpace, toUpper)+import Data.List (dropWhileEnd, intersperse)+import Text.Read (readMaybe)++-- https://hackage.haskell.org/package/template-haskell+import qualified Language.Haskell.TH.Syntax as THS++-- http://hackage.haskell.org/package/time+import qualified Data.Time.Calendar as Calendar++-- (ttc)+import qualified Data.TTC as TTC++------------------------------------------------------------------------------++-- | A credit card has a name, number, expiration date, and security code.+data CreditCard+  = CreditCard+    { name           :: !Name+    , number         :: !Number+    , expirationDate :: !ExpirationDate+    , securityCode   :: !SecurityCode+    }+  deriving Show++------------------------------------------------------------------------------++-- | After any leading and trailing whitespace is stripped and all lowercase+-- characters are converted to uppercase, a name must meet the following+-- constraints:+--+-- * Only characters between `0x20` (space) and `0x5F` (underscore) are+--   allowed.+-- * The name must be between 1 and 26 characters in length.+--+-- Reference:+--+-- * https://stackoverflow.com/questions/2004532+newtype Name = Name String+  deriving (Eq, Ord, Show, THS.Lift)++instance TTC.Parse Name where+  parse = TTC.asS $ \s -> do+    let name' = map toUpper $ strip s+        invChars = filter ((||) <$> (< ' ') <*> (> '_')) name'+    unless (null invChars) . Left $+      "name has invalid character(s): " <> intersperse ',' invChars+    when (null name') $ Left "name is empty"+    when (length name' > 26) $ Left "name has more than 26 characters"+    pure $ Name name'++instance TTC.Render Name where+  render (Name name') = TTC.convert name'++------------------------------------------------------------------------------++-- | After any space and dash characters are removed, a number must meet the+-- following constraints:+--+-- * Only ASCII digits are allowed.+-- * The number must be between 8 and 19 characters in length.+-- * The number must have a valid checksum.+--+-- Reference:+--+-- * https://en.wikipedia.org/wiki/Payment_card_number+-- * https://en.wikipedia.org/wiki/Luhn_algorithm+-- * http://rosettacode.org/wiki/Luhn_test_of_credit_card_numbers#Haskell+newtype Number = Number String+  deriving (Eq, Ord, Show, THS.Lift)++instance TTC.Parse Number where+  parse = TTC.asS $ \s -> do+    let number' = filter ((&&) <$> (/= ' ') <*> (/= '-')) s+        invChars = filter (not . isDigit) number'+        len = length number'+    unless (null invChars) . Left $+      "number has invalid character(s): " <> intersperse ',' invChars+    unless (len >= 8) $ Left "number has fewer than 8 characters"+    unless (len <= 19) $ Left "number has more than 19 characters"+    unless (luhn number') $ Left "number checksum is invalid"+    pure $ Number number'++instance TTC.Render Number where+  render (Number number') = TTC.convert number'++luhn :: String -> Bool+luhn+    = (== 0)+    . (`mod` 10)+    . sum+    . map (uncurry (+) . (`divMod` 10))+    . zipWith (*) (cycle [1, 2])+    . map digitToInt+    . reverse++------------------------------------------------------------------------------++-- | When parsed from a single string, an expiration date must be in `YYYY-MM`+-- format.+data ExpirationDate+  = ExpirationDate+    { year  :: !Year+    , month :: !Month+    }+  deriving (Eq, Ord, Show, THS.Lift)++instance TTC.Parse ExpirationDate where+  parse = TTC.asS $ \s -> case break (== '-') (strip s) of+    (year', '-':month') ->+      ExpirationDate <$> TTC.parse year' <*> TTC.parse month'+    _ -> Left "expiration date not in YYYY-MM format"++instance TTC.Render ExpirationDate where+  render (ExpirationDate year' month') =+    TTC.fromS $ TTC.render year' <> "-" <> TTC.render month'++toDay+  :: ExpirationDate+  -> Calendar.Day+toDay (ExpirationDate (Year year') (Month month')) =+    let yearZ = fromIntegral year'+        day = Calendar.gregorianMonthLength yearZ month'+    in Calendar.fromGregorian yearZ month' day++------------------------------------------------------------------------------++-- | A year must be in `YYYY` format, between 1900 and 9999.+newtype Year = Year Int+  deriving (Eq, Ord, Show, THS.Lift)++instance TTC.Parse Year where+  parse = TTC.asS $ \s -> do+    year' <- maybe (Left "year is not in YYYY format") pure $ readMaybe s+    unless (year' >= 1900) $ Left "year is before 1900"+    unless (year' <= 9999) $ Left "year is after 9999"+    pure $ Year year'++instance TTC.Render Year where+  render (Year year') = TTC.convert $ show year'++------------------------------------------------------------------------------++-- | A month must be in `MM` format, between 1 (January) and 12 (December).+newtype Month = Month Int+  deriving (Eq, Ord, Show, THS.Lift)++instance TTC.Parse Month where+  parse = TTC.asS $ \s -> do+    month' <- maybe (Left "month is not in MM format") pure $ readMaybe s+    unless (month' >= 1 && month' <= 12) $ Left "month is not in 1-12 range"+    pure $ Month month'++instance TTC.Render Month where+  render (Month month')+    | month' < 10 = TTC.convert $ '0' : show month'+    | otherwise   = TTC.convert $ show month'++------------------------------------------------------------------------------++-- | After any leading and trailing whitespace is stripped, a security code+-- must meet the following constraints:+--+-- * Only ASCII digits are allowed.+-- * The number must be 3 or 4 characters in length.+--+-- Reference:+--+-- * https://en.wikipedia.org/wiki/Card_security_code+newtype SecurityCode = SecurityCode String+  deriving (Eq, Ord, Show, THS.Lift)++instance TTC.Parse SecurityCode where+  parse = TTC.asS $ \s -> do+    let securityCode' = strip s+        invChars = filter (not . isDigit) securityCode'+        len = length securityCode'+    unless (null invChars) . Left $+      "security code has invalid character(s): " <> intersperse ',' invChars+    unless (len >= 3) $ Left "security code has fewer than 3 characters"+    unless (len <= 4) $ Left "security code has more than 4 characters"+    pure $ SecurityCode securityCode'++instance TTC.Render SecurityCode where+  render (SecurityCode securityCode') = TTC.convert securityCode'++------------------------------------------------------------------------------++strip :: String -> String+strip = dropWhile isSpace . dropWhileEnd isSpace

@@ -0,0 +1,127 @@+------------------------------------------------------------------------------+-- |+-- Module      : Duration+-- Description : duration data type+-- Copyright   : Copyright (c) 2019 Travis Cardwell+-- License     : MIT+--+-- This module defines a duration data type, with 'TTC.Render' and 'TTC.Parse'+-- instances, as an example of TTC usage.+--+-- The constructor for 'Duration' is not exported.  The 'TTC.Parse' instance+-- serves as a "smart constructor," ensuring that all values are valid.+------------------------------------------------------------------------------++{-# LANGUAGE TemplateHaskell #-}++module Duration+  ( -- * Type+    Duration+    -- * API+  , fromDouble+  , fromFloat+  , fromInt+  , fromMicro+  , fromNominalDiffTime+  , fromReal+  , toDouble+  , toFloat+  , toInt+  , toIntegral+  , toMicro+  , toNominalDiffTime+  , valid+  ) where++-- https://hackage.haskell.org/package/base+import Data.List (dropWhileEnd)+import Text.Read (readMaybe)++-- https://hackage.haskell.org/package/time+import Data.Time.Clock (NominalDiffTime)++-- ttc+import qualified Data.TTC as TTC++------------------------------------------------------------------------------+-- $Type++-- | A 'Duration' is a measure of seconds.  It is fractional and must be zero+-- or greater.+--+-- The underlying type is 'NominalDiffTime', which may be negative.  The+-- constructor is not exported, and all functions that create a value ensure+-- that the constraint holds.+newtype Duration = Duration NominalDiffTime+  deriving Show++instance TTC.Parse Duration where+  parse = TTC.asS $ \s ->+    maybe (Left $ "invalid Duration: " <> s) fromDouble $ readMaybe s++instance TTC.Render Duration where+  render (Duration t) = TTC.fromS . dropWhileEnd (== 's') $ show t++------------------------------------------------------------------------------+-- $API++-- | Construct a 'Duration' from a 'Double' (seconds).+fromDouble :: Double -> Either String Duration+fromDouble = fromReal++-- | Construct a 'Duration' from a 'Float' (seconds).+fromFloat :: Float -> Either String Duration+fromFloat = fromReal++-- | Construct a 'Duration' from an 'Int' (seconds).+fromInt :: Int -> Either String Duration+fromInt = fromReal++-- | Construct a 'Duration' from an 'Int' (microseconds).+fromMicro :: Int -> Either String Duration+fromMicro us = fromDouble $ fromIntegral us / 1000000.0++-- | Construct a 'Duration' from a 'NominalDiffTime'.+fromNominalDiffTime :: NominalDiffTime -> Either String Duration+fromNominalDiffTime t+    | t >= 0.0 = Right $ Duration t+    | otherwise = Left $ "Duration less than zero: " ++ show t++-- | Construct a 'Duration' from a 'Real' (seconds).+fromReal :: (Real a, Show a) => a -> Either String Duration+fromReal x+    | x >= 0 = Right . Duration $ realToFrac x+    | otherwise = Left $ "Duration less than zero: " ++ show x++-- | Convert a 'Duration' to a 'Double' (seconds).+toDouble :: Duration -> Double+toDouble = toFractional++-- | Convert a 'Duration' to a 'Float' (seconds).+toFloat :: Duration -> Float+toFloat = toFractional++-- | Convert a 'Duration' to a 'Fractional' (seconds).+toFractional :: Fractional a => Duration -> a+toFractional (Duration t) = realToFrac t++-- | Convert a 'Duration' to an 'Int' (seconds).+toInt :: Duration -> Int+toInt = toIntegral++-- | Convert a 'Duration' to an 'Integral' (seconds).+toIntegral :: Integral a => Duration -> a+toIntegral = round . toFloat++-- | Convert a 'Duration' to an 'Int' (microseconds).+toMicro :: Duration -> Int+toMicro (Duration t) = round (realToFrac t * 1000000.0 :: Double)++-- | Convert a 'Duration' to a 'NominalDiffTime'.+toNominalDiffTime :: Duration -> NominalDiffTime+toNominalDiffTime (Duration t) = t++-- | The 'valid' function is created using 'TTC.mkValid' via Template Haskell.+-- Note that 'Duration' does not have a 'Language.Haskell.TH.Syntax.Lift'+-- instance.+$(TTC.mkValid "valid" ''Duration)

@@ -0,0 +1,43 @@+------------------------------------------------------------------------------+-- |+-- Module      : Username+-- Description : username data type+-- Copyright   : Copyright (c) 2019 Travis Cardwell+-- License     : MIT+--+-- This module defines a username data type, with 'TTC.Render' and 'TTC.Parse'+-- instances, as an example of TTC usage.+--+-- The constructor for 'Username' is not exported.  The 'TTC.Parse' instance+-- serves as a "smart constructor," ensuring that all values are valid.+------------------------------------------------------------------------------++module Username (Username) where++-- https://hackage.haskell.org/package/base+import Control.Monad (unless, when)+import Data.Char (isAsciiLower)++-- https://hackage.haskell.org/package/text+import qualified Data.Text as T+import Data.Text (Text)++-- ttc+import qualified Data.TTC as TTC++------------------------------------------------------------------------------++-- | A 'Username' must consist of 3 to 12 lowercase ASCII letters.+newtype Username = Username Text+  deriving (Eq, Ord, Show)++instance TTC.Render Username where+  render (Username t) = TTC.convert t++instance TTC.Parse Username where+  parse = TTC.asT $ \t -> do+    unless (T.all isAsciiLower t) $ Left "username has invalid characters"+    let len = T.length t+    when (len < 3) $ Left "username has fewer than 3 characters"+    when (len > 12) $ Left "username has more than 12 characters"+    pure $ Username t

@@ -0,0 +1,37 @@+------------------------------------------------------------------------------+-- |+-- Module      : Main+-- Description : example of compile-time validation failure+-- Copyright   : Copyright (c) 2019 Travis Cardwell+-- License     : MIT+--+-- 'TTC.valid' is used to create validated constants.  The credit card number+-- has an invalid checksum, triggering a compile-time error.+------------------------------------------------------------------------------++{-# LANGUAGE TemplateHaskell #-}++module Main (main) where++-- (ttc)+import qualified Data.TTC as TTC++-- (ttc:example-invalid)+import CreditCard (CreditCard(CreditCard))++-- HLint does not support typed expression splices+{-# ANN module "HLint: ignore" #-}++------------------------------------------------------------------------------++sample :: CreditCard+sample = CreditCard+    $$(TTC.valid "John Q Doe")+    $$(TTC.valid "1234 5678 9012")+    $$(TTC.valid "2020-06")+    $$(TTC.valid "123")++------------------------------------------------------------------------------++main :: IO ()+main = print sample

@@ -0,0 +1,33 @@+------------------------------------------------------------------------------+-- |+-- Module      : Main+-- Description : example of compile-time validation+-- Copyright   : Copyright (c) 2019 Travis Cardwell+-- License     : MIT+--+-- 'Data.TTC.mkValid' is used to create the 'Duration.valid' function, without+-- the need for a 'Language.Haskell.TH.Syntax.Lift' instance.  In this+-- example, the sample duration is validated at compile-time and parsed again+-- at run-time.+------------------------------------------------------------------------------++{-# LANGUAGE TemplateHaskell #-}++module Main (main) where++-- (ttc:example-mkvalid)+import qualified Duration as Duration+import Duration (Duration)++-- HLint does not support typed expression splices+{-# ANN module "HLint: ignore" #-}++------------------------------------------------------------------------------++sample :: Duration+sample = $$(Duration.valid "123")++------------------------------------------------------------------------------++main :: IO ()+main = print sample

@@ -0,0 +1,87 @@+------------------------------------------------------------------------------+-- |+-- Module      : Main+-- Description : example CLI prompt using TTC+-- Copyright   : Copyright (c) 2019 Travis Cardwell+-- License     : MIT+--+-- 'TTC.Parse' and 'TTC.Render' instances are used to create a CLI prompt,+-- demonstrating TTC usage.+------------------------------------------------------------------------------++module Main (main) where++-- https://hackage.haskell.org/package/base+import qualified System.IO as IO++-- https://hackage.haskell.org/package/time+import qualified Data.Time.Calendar as Calendar+import qualified Data.Time.Clock as Clock++-- (ttc)+import qualified Data.TTC as TTC++-- (ttc:example-prompt)+import qualified CreditCard as CC+import CreditCard (CreditCard(CreditCard), ExpirationDate(ExpirationDate))++------------------------------------------------------------------------------++-- | This function prompts for a value of the desired type.  When input is+-- invalid, it displays the error and tries again.+prompt+  :: TTC.Parse a+  => String  -- ^ prompt string+  -> IO a+prompt promptString = loop+  where+    loop = do+      putStr promptString+      IO.hFlush IO.stdout+      s <- getLine+      case TTC.parse s of+        Right x -> return x+        Left err -> do+          putStrLn $ "  " <> err+          loop++------------------------------------------------------------------------------++-- | This function prompts for credit card details.+promptCC :: IO CreditCard+promptCC = CreditCard+    <$> prompt "Enter the name: "+    <*> prompt "Enter the number: "+    <*>+      ( ExpirationDate+          <$> prompt "Enter the expiration year (YYYY): "+          <*> prompt "Enter the expiration month (MM): "+      )+    <*> prompt "Enter the security code: "++------------------------------------------------------------------------------++-- | The program prompts for credit card details, prints out the normalized+-- values, and shows information about expiration.+main :: IO ()+main = do+    putStrLn "Please enter some fake credit card details."+    cc <- promptCC+    putStrLn $ replicate 78 '-'+    putStrLn $ "Name:            " <> TTC.render (CC.name cc)+    putStrLn $ "Number:          " <> TTC.render (CC.number cc)+    putStrLn $ "Expiration date: " <> TTC.render (CC.expirationDate cc)+    putStrLn $ "Security code:   " <> TTC.render (CC.securityCode cc)+    putStrLn $ replicate 78 '-'+    today <- Clock.utctDay <$> Clock.getCurrentTime+    putStrLn . ("This credit card " <>) . (<> "!") $+      case CC.toDay (CC.expirationDate cc) of+        expiry+          | expiry > today -> "expires in " <> diffDays expiry today+          | expiry < today -> "expired " <> diffDays today expiry <> " ago"+          | otherwise      -> "expires today"+  where+    diffDays :: Calendar.Day -> Calendar.Day -> String+    diffDays day1 day2 = case Calendar.diffDays day1 day2 of+      1 -> "1 day"+      n -> show n <> " days"

@@ -0,0 +1,22 @@+------------------------------------------------------------------------------+-- |+-- Module      : Main+-- Description : minimal example of using Render and Parse instances+-- Copyright   : Copyright (c) 2019 Travis Cardwell+-- License     : MIT+------------------------------------------------------------------------------++module Main (main) where++-- (ttc)+import qualified Data.TTC as TTC++-- (ttc:example-uname)+import Username (Username)++------------------------------------------------------------------------------++main :: IO ()+main = case TTC.parse "tcard" :: Either String Username of+    Right uname -> putStrLn $ "valid username: " ++ TTC.render uname+    Left err -> putStrLn $ "invalid username: " ++ err

@@ -0,0 +1,37 @@+------------------------------------------------------------------------------+-- |+-- Module      : Main+-- Description : example of compile-time validation+-- Copyright   : Copyright (c) 2019 Travis Cardwell+-- License     : MIT+--+-- 'TTC.valid' is used to create validated constants.  The sample credit card+-- is validated at compile-time.+------------------------------------------------------------------------------++{-# LANGUAGE TemplateHaskell #-}++module Main (main) where++-- (ttc)+import qualified Data.TTC as TTC++-- (ttc:example-valid)+import CreditCard (CreditCard(CreditCard))++-- HLint does not support typed expression splices+{-# ANN module "HLint: ignore" #-}++------------------------------------------------------------------------------++sample :: CreditCard+sample = CreditCard+    $$(TTC.valid "John Q Doe")+    $$(TTC.valid "1234 5678 9015")+    $$(TTC.valid "2020-06")+    $$(TTC.valid "123")++------------------------------------------------------------------------------++main :: IO ()+main = print sample

@@ -0,0 +1,641 @@+------------------------------------------------------------------------------+-- |+-- Module      : Data.TTC+-- Description : textual type classes+-- Copyright   : Copyright (c) 2019 Travis Cardwell+-- License     : MIT+--+-- TTC, an initialism of /Textual Type Classes/, is a library that provides+-- type classes for conversion between data types and textual data types+-- (strings).+--+-- This library is meant to be imported qualified, as follows:+--+-- @+-- import qualified Data.TTC as TTC+-- @+------------------------------------------------------------------------------++{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TemplateHaskell #-}++module Data.TTC+  ( -- * Textual+    Textual+  , convert+    -- ** \"To\" Conversions+    -- $TextualTo+  , toS+  , toT+  , toTL+  , toBS+  , toBSL+    -- ** \"From\" Conversions+    -- $TextualFrom+  , fromS+  , fromT+  , fromTL+  , fromBS+  , fromBSL+    -- ** \"As\" Conversions+    -- $TextualAs+  , asS+  , asT+  , asTL+  , asBS+  , asBSL+    -- ** Other Conversions+    -- $TextualOther+  , toTLB+  , fromTLB+  , toBSB+  , fromBSB+  , toSBS+  , fromSBS+    -- * Render+  , Render(..)+    -- ** Rendering Specific Types+    -- $RenderSpecific+  , renderS+  , renderT+  , renderTL+  , renderBS+  , renderBSL+    -- ** Render Utilities+  , renderWithShow+    -- * Parse+  , Parse(..)+    -- ** Parsing From Specific Types+    -- $ParseSpecific+  , parseS+  , parseT+  , parseTL+  , parseBS+  , parseBSL+    -- ** 'Maybe' Parsing+    -- $ParseMaybe+  , parseMaybe+  , parseMaybeS+  , parseMaybeT+  , parseMaybeTL+  , parseMaybeBS+  , parseMaybeBSL+    -- ** Unsafe Parsing+    -- $ParseUnsafe+  , parseUnsafe+  , parseUnsafeS+  , parseUnsafeT+  , parseUnsafeTL+  , parseUnsafeBS+  , parseUnsafeBSL+    -- ** Parse Utilities+  , parseEnum+  , parseEnum'+  , parseWithRead+  , parseWithRead'+  , readsEnum+  , readsWithParse+  , valid+  , validOf+  , mkValid+  ) where++-- https://hackage.haskell.org/package/base+import Data.Proxy (Proxy(Proxy), asProxyTypeOf)+import Text.Read (readMaybe)++-- https://hackage.haskell.org/package/bytestring+import qualified Data.ByteString as BS+import qualified Data.ByteString.Builder as BSB+import qualified Data.ByteString.Lazy as BSL+import qualified Data.ByteString.Short as SBS++-- https://hackage.haskell.org/package/template-haskell+import qualified Language.Haskell.TH as TH+import qualified Language.Haskell.TH.Syntax as THS++-- https://hackage.haskell.org/package/text+import qualified Data.Text as T+import qualified Data.Text.Encoding as TE+import qualified Data.Text.Encoding.Error as TEE+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.Builder as TLB+import qualified Data.Text.Lazy.Encoding as TLE++-- HLint does not support typed expression quotations:+--   https://github.com/ndmitchell/hlint/issues/332+--+-- The following ignore annotation is not working.  It works via the CLI:+--   hlint -i "Parse error"+{-# ANN module "HLint: ignore Parse error" #-}++------------------------------------------------------------------------------+-- $Textual++-- | The 'Textual' type class is used to convert between the following textual+-- data types:+--+-- * 'String' (@S@)+-- * Strict 'T.Text' (@T@)+-- * Lazy 'TL.Text' (@TL@)+-- * Strict 'BS.ByteString' (@BS@)+-- * Lazy 'BSL.ByteString' (@BSL@)+--+-- @ByteString@ values are assumed to be UTF-8 encoded text.  Invalid bytes+-- are replaced with the Unicode replacement character @U+FFFD@.  In cases+-- where different behavior is required, process @ByteString@ values /before/+-- using this class.+--+-- The key feature of this type class is that it has a single type variable,+-- making it easy to write functions that accepts arguments and/or returns+-- values that may be any of the supported textual data types.+--+-- Note that support for additional data types cannot be implemented by+-- writing instances.  Adding support for additional data types would require+-- changing the class definition itself.  This is the price paid for having+-- only one type variable instead of two.+class Textual t where+  -- | Convert to a 'String'+  toS :: t -> String++  -- | Convert to strict 'T.Text'+  toT :: t -> T.Text++  -- | Convert to lazy 'TL.Text'+  toTL :: t -> TL.Text++  -- | Convert to a strict 'BS.ByteString'+  toBS :: t -> BS.ByteString++  -- | Convert to a lazy 'BS.ByteString'+  toBSL :: t -> BSL.ByteString++  -- | Convert between any supported textual data types+  convert :: Textual t' => t' -> t++instance Textual String where+  toS = id+  toT = T.pack+  toTL = TL.pack+  toBS = TE.encodeUtf8 . T.pack+  toBSL = TLE.encodeUtf8 . TL.pack+  convert = toS+  {-# INLINE toS #-}+  {-# INLINE toT #-}+  {-# INLINE toTL #-}+  {-# INLINE toBS #-}+  {-# INLINE toBSL #-}+  {-# INLINE convert #-}++instance Textual T.Text where+  toS = T.unpack+  toT = id+  toTL = TL.fromStrict+  toBS = TE.encodeUtf8+  toBSL = TLE.encodeUtf8 . TL.fromStrict+  convert = toT+  {-# INLINE toS #-}+  {-# INLINE toT #-}+  {-# INLINE toTL #-}+  {-# INLINE toBS #-}+  {-# INLINE toBSL #-}+  {-# INLINE convert #-}++instance Textual TL.Text where+  toS = TL.unpack+  toT = TL.toStrict+  toTL = id+  toBS = BSL.toStrict . TLE.encodeUtf8+  toBSL = TLE.encodeUtf8+  convert = toTL+  {-# INLINE toS #-}+  {-# INLINE toT #-}+  {-# INLINE toTL #-}+  {-# INLINE toBS #-}+  {-# INLINE toBSL #-}+  {-# INLINE convert #-}++instance Textual BS.ByteString where+  toS = T.unpack . TE.decodeUtf8With TEE.lenientDecode+  toT = TE.decodeUtf8With TEE.lenientDecode+  toTL = TLE.decodeUtf8With TEE.lenientDecode . BSL.fromStrict+  toBS = id+  toBSL = BSL.fromStrict+  convert = toBS+  {-# INLINE toS #-}+  {-# INLINE toT #-}+  {-# INLINE toTL #-}+  {-# INLINE toBS #-}+  {-# INLINE toBSL #-}+  {-# INLINE convert #-}++instance Textual BSL.ByteString where+  toS = TL.unpack . TLE.decodeUtf8With TEE.lenientDecode+  toT = TL.toStrict . TLE.decodeUtf8With TEE.lenientDecode+  toTL = TLE.decodeUtf8With TEE.lenientDecode+  toBS = BSL.toStrict+  toBSL = id+  convert = toBSL+  {-# INLINE toS #-}+  {-# INLINE toT #-}+  {-# INLINE toTL #-}+  {-# INLINE toBS #-}+  {-# INLINE toBSL #-}+  {-# INLINE convert #-}++-- $TextualTo+--+-- These functions are equivalent to 'convert', but they specify the type+-- being converted to.  Use them to avoid having to write type annotations in+-- cases where the type is ambiguous.++-- $TextualFrom+--+-- These functions are equivalent to 'convert', but they specify the type+-- being converted from.  Use them to avoid having to write type annotations+-- in cases where the type is ambiguous.++-- | Convert from a 'String'+fromS :: Textual t => String -> t+fromS = convert+{-# INLINE fromS #-}++-- | Convert from strict 'T.Text'+fromT :: Textual t => T.Text -> t+fromT = convert+{-# INLINE fromT #-}++-- | Convert from lazy 'TL.Text'+fromTL :: Textual t => TL.Text -> t+fromTL = convert+{-# INLINE fromTL #-}++-- | Convert from a strict 'BS.ByteString'+fromBS :: Textual t => BS.ByteString -> t+fromBS = convert+{-# INLINE fromBS #-}++-- | Convert from a lazy 'BSL.ByteString'+fromBSL :: Textual t => BSL.ByteString -> t+fromBSL = convert+{-# INLINE fromBSL #-}++-- $TextualAs+--+-- These functions are used to convert a 'Textual' argument of a function to a+-- specific type.  Use them to reduce boilerplate in small function+-- definitions.++-- | Convert an argument to a 'String'+asS :: Textual t => (String -> a) -> t -> a+asS f = f . convert+{-# INLINE asS #-}++-- | Convert an argument to strict 'T.Text'+asT :: Textual t => (T.Text -> a) -> t -> a+asT f = f . convert+{-# INLINE asT #-}++-- | Convert an argument to lazy 'TL.Text'+asTL :: Textual t => (TL.Text -> a) -> t -> a+asTL f = f . convert+{-# INLINE asTL #-}++-- | Convert an argument to a strict 'BS.ByteString'+asBS :: Textual t => (BS.ByteString -> a) -> t -> a+asBS f = f . convert+{-# INLINE asBS #-}++-- | Convert an argument to a lazy 'BSL.ByteString'+asBSL :: Textual t => (BSL.ByteString -> a) -> t -> a+asBSL f = f . convert+{-# INLINE asBSL #-}++-- $TextualOther+--+-- These functions are used to convert to/from the following other textual+-- data types:+--+-- * @Text@ 'TLB.Builder' (@TLB@)+-- * @ByteString@ 'BSB.Builder' (@BSB@)+-- * 'SBS.ShortByteString' (@SBS@)++-- | Convert to a @Text@ 'TLB.Builder'+toTLB :: Textual t => t -> TLB.Builder+toTLB = TLB.fromLazyText . convert++-- | Convert from a @Text@ 'TLB.Builder'+fromTLB :: Textual t => TLB.Builder -> t+fromTLB = convert . TLB.toLazyText++-- | Convert to a @ByteString@ 'BSB.Builder'+toBSB :: Textual t => t -> BSB.Builder+toBSB = BSB.lazyByteString . convert++-- | Convert from a @ByteString@ 'BSB.Builder'+fromBSB :: Textual t => BSB.Builder -> t+fromBSB = convert . BSB.toLazyByteString++-- | Convert to a 'SBS.ShortByteString'+toSBS :: Textual t => t -> SBS.ShortByteString+toSBS = SBS.toShort . convert++-- | Convert from a 'SBS.ShortByteString'+fromSBS :: Textual t => SBS.ShortByteString -> t+fromSBS = convert . SBS.fromShort++------------------------------------------------------------------------------+-- $Render++-- | The 'Render' type class renders a data type as a textual data type.+--+-- There are no default instances for the 'Render' type class, so that all+-- instances can be customized per project when desired.  Instances for some+-- basic data types are available in "Data.TTC.Instances".+class Render a where+  render :: Textual t => a -> t++-- $RenderSpecific+--+-- These functions are equivalent to 'render', but they specify the type being+-- rendered to.  Use them to avoid having to write type annotations in cases+-- where the type is ambiguous.++-- | Render to a 'String'+renderS :: Render a => a -> String+renderS = render+{-# INLINE renderS #-}++-- | Render to strict 'T.Text'+renderT :: Render a => a -> T.Text+renderT = render+{-# INLINE renderT #-}++-- | Render to lazy 'TL.Text'+renderTL :: Render a => a -> TL.Text+renderTL = render+{-# INLINE renderTL #-}++-- | Render to a strict 'BS.ByteString'+renderBS :: Render a => a -> BS.ByteString+renderBS = render+{-# INLINE renderBS #-}++-- | Render to a lazy 'BSL.ByteString'+renderBSL :: Render a => a -> BSL.ByteString+renderBSL = render+{-# INLINE renderBSL #-}++-- $RenderUtils++-- | Render a value to a textual data type using the 'Show' instance+renderWithShow :: (Show a, Textual t) => a -> t+renderWithShow = convert . show+{-# INLINE renderWithShow #-}++------------------------------------------------------------------------------+-- $Parse++-- | The 'Parse' type class parses a data type from a textual data type.+--+-- There are no default instances for the 'Parse' type class, so that all+-- instances can be customized per project when desired.  Instances for some+-- basic data types are available in "Data.TTC.Instances".+class Parse a where+  parse :: Textual t => t -> Either String a++-- $ParseSpecific+--+-- These functions are equivalent to 'parse', but they specify the type being+-- parsed from.  Use them to avoid having to write type annotations in cases+-- where the type is ambiguous.++-- | Parse from a 'String'+parseS :: Parse a => String -> Either String a+parseS = parse+{-# INLINE parseS #-}++-- | Parse from strict 'T.Text'+parseT :: Parse a => T.Text -> Either String a+parseT = parse+{-# INLINE parseT #-}++-- | Parse from lazy 'TL.Text'+parseTL :: Parse a => TL.Text -> Either String a+parseTL = parse+{-# INLINE parseTL #-}++-- | Parse from a strict 'BS.ByteString'+parseBS :: Parse a => BS.ByteString -> Either String a+parseBS = parse+{-# INLINE parseBS #-}++-- | Parse from a lazy 'BSL.ByteString'+parseBSL :: Parse a => BSL.ByteString -> Either String a+parseBSL = parse+{-# INLINE parseBSL #-}++-- $ParseMaybe+--+-- The 'parseMaybe' function parses to a 'Maybe' type instead of an 'Either'+-- type.  The rest of the functions are equivalent to 'parseMaybe', but they+-- specify the type being parsed from.  Use them to avoid having to write type+-- annotations in cases where the type is ambiguous.++-- | Parse to a 'Maybe' type+parseMaybe :: Parse a => Textual t => t -> Maybe a+parseMaybe = either (const Nothing) Just . parse+{-# INLINE parseMaybe #-}++-- | Parse from a 'String' to a 'Maybe' type+parseMaybeS :: Parse a => String -> Maybe a+parseMaybeS = parseMaybe+{-# INLINE parseMaybeS #-}++-- | Parse from strict 'T.Text' to a 'Maybe' type+parseMaybeT :: Parse a => T.Text -> Maybe a+parseMaybeT = parseMaybe+{-# INLINE parseMaybeT #-}++-- | Parse from lazy 'TL.Text' to a 'Maybe' type+parseMaybeTL :: Parse a => TL.Text -> Maybe a+parseMaybeTL = parseMaybe+{-# INLINE parseMaybeTL #-}++-- | Parse from a strict 'BS.ByteString' to a 'Maybe' type+parseMaybeBS :: Parse a => BS.ByteString -> Maybe a+parseMaybeBS = parseMaybe+{-# INLINE parseMaybeBS #-}++-- | Parse from a lazy 'BSL.ByteString' to a 'Maybe' type+parseMaybeBSL :: Parse a => BSL.ByteString -> Maybe a+parseMaybeBSL = parseMaybe+{-# INLINE parseMaybeBSL #-}++-- $ParseUnsafe+--+-- The 'parseUnsafe' function raises an exception on error instead of using an+-- 'Either' type.  It should only be used when an error is not possible.  The+-- rest of the functions are equivalent to 'parseUnsafe', but they specify the+-- type being parsed from.  Use them to avoid having to write type annotations+-- in cases where the type is ambiguous.++-- | Unsafely parse+parseUnsafe :: (Parse a, Textual t) => t -> a+parseUnsafe = either (error . ("parseUnsafe: " ++)) id . parse+{-# INLINE parseUnsafe #-}++-- | Unsafely parse to a 'String'+parseUnsafeS :: Parse a => String -> a+parseUnsafeS = parseUnsafe+{-# INLINE parseUnsafeS #-}++-- | Unsafely parse to strict 'T.Text'+parseUnsafeT :: Parse a => T.Text -> a+parseUnsafeT = parseUnsafe+{-# INLINE parseUnsafeT #-}++-- | Unsafely parse to lazy 'TL.Text'+parseUnsafeTL :: Parse a => TL.Text -> a+parseUnsafeTL = parseUnsafe+{-# INLINE parseUnsafeTL #-}++-- | Unsafely parse to a strict 'BS.ByteString'+parseUnsafeBS :: Parse a => BS.ByteString -> a+parseUnsafeBS = parseUnsafe+{-# INLINE parseUnsafeBS #-}++-- | Unsafely parse to a lazy 'BSL.ByteString'+parseUnsafeBSL :: Parse a => BSL.ByteString -> a+parseUnsafeBSL = parseUnsafe+{-# INLINE parseUnsafeBSL #-}++-- $ParseUtils++-- | Parse a value in an enumeration+parseEnum+  :: (Bounded a, Enum a, Render a, Textual t)+  => Bool        -- ^ case-insensitive when 'True'+  -> Bool        -- ^ accept unique prefixes when 'True'+  -> e           -- ^ invalid input error+  -> e           -- ^ ambiguous input error+  -> t           -- ^ textual input to parse+  -> Either e a  -- ^ error or parsed value+parseEnum allowCI allowPrefix invalidError ambiguousError t =+    let t' = norm $ toT t+    in  case [v | v <- [minBound ..], t' `match` norm (render v)] of+          [v] -> Right v+          []  -> Left invalidError+          _   -> Left ambiguousError+  where+    norm :: T.Text -> T.Text+    norm = if allowCI then T.toLower else id++    match :: T.Text -> T.Text -> Bool+    match = if allowPrefix then T.isPrefixOf else (==)++-- | Parse a value in an enumeration, with 'String' error messages+--+-- The following English error messages are returned:+--+-- * \"invalid {name}\" when there are no matches+-- * \"ambiguous {name}\" when there is more than one match+parseEnum'+  :: (Bounded a, Enum a, Render a, Textual t)+  => String           -- ^ name to include in error messages+  -> Bool             -- ^ case-insensitive when 'True'+  -> Bool             -- ^ accept unique prefixes when 'True'+  -> t                -- ^ textual input to parse+  -> Either String a  -- ^ error or parsed value+parseEnum' name allowCI allowPrefix =+    parseEnum allowCI allowPrefix ("invalid " ++ name) ("ambiguous " ++ name)+{-# INLINEABLE parseEnum' #-}++-- | Parse a value using the 'Read' instance+parseWithRead+  :: (Read a, Textual t)+  => e           -- ^ invalid input error+  -> t           -- ^ textual input to parse+  -> Either e a  -- ^ error or parsed value+parseWithRead invalidError = maybe (Left invalidError) Right . readMaybe . toS+{-# INLINEABLE parseWithRead #-}++-- | Parse a value using the 'Read' instance, with 'String' error messages+--+-- The following English error message is returned:+--+-- * \"invalid {name}\" when the parse fails+parseWithRead'+  :: (Read a, Textual t)+  => String           -- ^ name to include in error messages+  -> t                -- ^ textual input to parse+  -> Either String a  -- ^ error or parsed value+parseWithRead' name = parseWithRead ("invalid " ++ name)+{-# INLINEABLE parseWithRead' #-}++-- | Implement 'ReadS' using 'parseEnum'+--+-- This implementation expects all of the input to be consumed.+readsEnum+  :: (Bounded a, Enum a, Render a)+  => Bool  -- ^ case-insensitive when 'True'+  -> Bool  -- ^ accept unique prefixes when 'True'+  -> ReadS a+readsEnum allowCI allowPrefix s =+    case parseEnum allowCI allowPrefix () () s of+      Right v -> [(v, "")]+      Left{}  -> []+{-# INLINEABLE readsEnum #-}++-- | Implement 'ReadS' using a 'Parse' instance+--+-- This implementation expects all of the input to be consumed.+readsWithParse+  :: Parse a+  => ReadS a+readsWithParse s = case parse s of+    Right v -> [(v, "")]+    Left{}  -> []+{-# INLINEABLE readsWithParse #-}++-- | Validate a constant at compile-time using a 'Parse' instance+--+-- This function parses the 'String' at compile-time in order to validate it.+-- When valid, the result is compiled in, so the result type must have a+-- 'THS.Lift' instance.  Use 'validOf' when this is inconvenient.+valid+  :: (Parse a, THS.Lift a)+  => String+  -> TH.Q (TH.TExp a)+valid s = case parse s of+    Right x -> [|| x ||]+    Left err -> fail $ "Invalid constant: " ++ err++-- | Validate a constant at compile-time using a 'Parse' instance+--+-- This function parses the 'String' at compile-time in order to validate it.+-- When valid, the 'String' is compiled in, to be parsed again at run-time.+-- Since the result is not compiled in, no 'THS.Lift' instance is required.+validOf+  :: Parse a+  => Proxy a+  -> String+  -> TH.Q (TH.TExp a)+validOf proxy s = case (`asProxyTypeOf` proxy) <$> parse s of+    Right{} -> [|| parseUnsafe s ||]+    Left err -> fail $ "Invalid constant: " ++ err++-- | Make a @valid@ function using 'validOf' for the given type+mkValid+  :: String+  -> TH.Name+  -> TH.DecsQ+mkValid funName typeName = do+    let funName' = TH.mkName funName+        resultType = pure $ TH.ConT typeName+    funType <- [t| String -> TH.Q (TH.TExp $resultType) |]+    body <- [| validOf (Proxy :: Proxy $resultType) |]+    return+      [ TH.SigD funName' funType+      , TH.FunD funName' [TH.Clause [] (TH.NormalB body) []]+      ]

@@ -0,0 +1,194 @@+------------------------------------------------------------------------------+-- |+-- Module      : Data.TTC.Instances+-- Description : instances for basic data types+-- Copyright   : Copyright (c) 2019 Travis Cardwell+-- License     : MIT+--+-- This module defines TTC 'TTC.Render' and 'TTC.Parse' instances for some+-- basic data types.  The definitions for the numeric data types are+-- implemented using the 'Show' and 'Read' instances.  The definitions for the+-- character and textual data types are implemented without quoting.+--+-- To use these instances, explicitly import them as follows:+--+-- @+-- import Data.TTC.Instances ()+-- @+------------------------------------------------------------------------------++{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE LambdaCase #-}++{-# OPTIONS_GHC -fno-warn-orphans #-}++module Data.TTC.Instances () where++-- https://hackage.haskell.org/package/base+import Data.Int (Int16, Int32, Int64, Int8)+import Data.Word (Word16, Word32, Word64, Word8)++-- https://hackage.haskell.org/package/bytestring+import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as BSL++-- https://hackage.haskell.org/package/text+import qualified Data.Text as T+import qualified Data.Text.Lazy as TL++-- (ttc)+import qualified Data.TTC as TTC++------------------------------------------------------------------------------++instance TTC.Parse Char where+  parse = TTC.asS $ \case+    [c] -> Right c+    _ -> Left "invalid Char"++instance TTC.Render Char where+  render c = TTC.fromS [c]++------------------------------------------------------------------------------++instance TTC.Parse Double where+  parse = TTC.parseWithRead' "Double"++instance TTC.Render Double where+  render = TTC.renderWithShow++------------------------------------------------------------------------------++instance TTC.Parse Float where+  parse = TTC.parseWithRead' "Float"++instance TTC.Render Float where+  render = TTC.renderWithShow++------------------------------------------------------------------------------++instance TTC.Parse Int where+  parse = TTC.parseWithRead' "Int"++instance TTC.Render Int where+  render = TTC.renderWithShow++------------------------------------------------------------------------------++instance TTC.Parse Int8 where+  parse = TTC.parseWithRead' "Int8"++instance TTC.Render Int8 where+  render = TTC.renderWithShow++------------------------------------------------------------------------------++instance TTC.Parse Int16 where+  parse = TTC.parseWithRead' "Int16"++instance TTC.Render Int16 where+  render = TTC.renderWithShow++------------------------------------------------------------------------------++instance TTC.Parse Int32 where+  parse = TTC.parseWithRead' "Int32"++instance TTC.Render Int32 where+  render = TTC.renderWithShow++------------------------------------------------------------------------------++instance TTC.Parse Int64 where+  parse = TTC.parseWithRead' "Int64"++instance TTC.Render Int64 where+  render = TTC.renderWithShow++------------------------------------------------------------------------------++instance TTC.Parse Integer where+  parse = TTC.parseWithRead' "Integer"++instance TTC.Render Integer where+  render = TTC.renderWithShow++------------------------------------------------------------------------------++instance TTC.Parse Word where+  parse = TTC.parseWithRead' "Word"++instance TTC.Render Word where+  render = TTC.renderWithShow++------------------------------------------------------------------------------++instance TTC.Parse Word8 where+  parse = TTC.parseWithRead' "Word8"++instance TTC.Render Word8 where+  render = TTC.renderWithShow++------------------------------------------------------------------------------++instance TTC.Parse Word16 where+  parse = TTC.parseWithRead' "Word16"++instance TTC.Render Word16 where+  render = TTC.renderWithShow++------------------------------------------------------------------------------++instance TTC.Parse Word32 where+  parse = TTC.parseWithRead' "Word32"++instance TTC.Render Word32 where+  render = TTC.renderWithShow++------------------------------------------------------------------------------++instance TTC.Parse Word64 where+  parse = TTC.parseWithRead' "Word64"++instance TTC.Render Word64 where+  render = TTC.renderWithShow++------------------------------------------------------------------------------++instance TTC.Parse String where+  parse = Right . TTC.toS++instance TTC.Render String where+  render = TTC.fromS++------------------------------------------------------------------------------++instance TTC.Parse BSL.ByteString where+  parse = Right . TTC.toBSL++instance TTC.Render BSL.ByteString where+  render = TTC.fromBSL++------------------------------------------------------------------------------++instance TTC.Parse BS.ByteString where+  parse = Right . TTC.toBS++instance TTC.Render BS.ByteString where+  render = TTC.fromBS++------------------------------------------------------------------------------++instance TTC.Parse TL.Text where+  parse = Right . TTC.toTL++instance TTC.Render TL.Text where+  render = TTC.fromTL++------------------------------------------------------------------------------++instance TTC.Parse T.Text where+  parse = Right . TTC.toT++instance TTC.Render T.Text where+  render = TTC.fromT

@@ -0,0 +1,336 @@+module Data.TTC.Instances.Test (tests) where++-- https://hackage.haskell.org/package/base+import Data.Int (Int16, Int32, Int64, Int8)+import Data.Word (Word16, Word32, Word64, Word8)++-- https://hackage.haskell.org/package/bytestring+import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as BSL++-- https://hackage.haskell.org/package/tasty+import Test.Tasty (TestTree, testGroup)++-- https://hackage.haskell.org/package/tasty-hunit+import Test.Tasty.HUnit ((@=?), testCase)++-- https://hackage.haskell.org/package/text+import qualified Data.Text as T+import qualified Data.Text.Lazy as TL++-- (ttc)+import qualified Data.TTC as TTC+import Data.TTC.Instances ()++{-# ANN module "HLint: ignore Reduce duplication" #-}++------------------------------------------------------------------------------+-- $TestData++xS :: String+xS = "test テスト"++xT :: T.Text+xT = TTC.convert "test テスト"++xTL :: TL.Text+xTL = TTC.convert "test テスト"++xBS :: BS.ByteString+xBS = TTC.convert "test テスト"++xBSL :: BSL.ByteString+xBSL = TTC.convert "test テスト"++------------------------------------------------------------------------------++testChar :: TestTree+testChar = testGroup "Char"+    [ testCase "Render" $ "*" @=? TTC.render '*'+    , testCase "Parse.OK" $ Right '*' @=? TTC.parse "*"+    , testCase "Parse.empty" $ Left "invalid Char" @=?+        (TTC.parse "" :: Either String Char)+    , testCase "Parse.multiple" $ Left "invalid Char" @=?+        (TTC.parse "**" :: Either String Char)+    ]++testDouble :: TestTree+testDouble = testGroup "Double"+    [ testCase "Render" $ s @=? TTC.render x+    , testCase "Parse.OK" $ Right x' @=? TTC.parse s+    , testCase "Parse.invalid" $ Left "invalid Double" @=?+        (TTC.parse "invalid" :: Either String Double)+    ]+  where+    x :: Double+    x = 3.14159++    s :: String+    s = show x++    x' :: Double+    x' = read s++testFloat :: TestTree+testFloat = testGroup "Float"+    [ testCase "Render" $ s @=? TTC.render x+    , testCase "Parse.OK" $ Right x' @=? TTC.parse s+    , testCase "Parse.invalid" $ Left "invalid Float" @=?+        (TTC.parse "invalid" :: Either String Float)+    ]+  where+    x :: Float+    x = 3.14159++    s :: String+    s = show x++    x' :: Float+    x' = read s++testInt :: TestTree+testInt = testGroup "Int"+    [ testCase "Render" $ s @=? TTC.render n+    , testCase "Parse.OK" $ Right n' @=? TTC.parse s+    , testCase "Parse.invalid" $ Left "invalid Int" @=?+        (TTC.parse "invalid" :: Either String Int)+    ]+  where+    n :: Int+    n = 42++    s :: String+    s = show n++    n' :: Int+    n' = read s++testInt8 :: TestTree+testInt8 = testGroup "Int8"+    [ testCase "Render" $ s @=? TTC.render n+    , testCase "Parse.OK" $ Right n' @=? TTC.parse s+    , testCase "Parse.invalid" $ Left "invalid Int8" @=?+        (TTC.parse "invalid" :: Either String Int8)+    ]+  where+    n :: Int8+    n = 42++    s :: String+    s = show n++    n' :: Int8+    n' = read s++testInt16 :: TestTree+testInt16 = testGroup "Int16"+    [ testCase "Render" $ s @=? TTC.render n+    , testCase "Parse.OK" $ Right n' @=? TTC.parse s+    , testCase "Parse.invalid" $ Left "invalid Int16" @=?+        (TTC.parse "invalid" :: Either String Int16)+    ]+  where+    n :: Int16+    n = 42++    s :: String+    s = show n++    n' :: Int16+    n' = read s++testInt32 :: TestTree+testInt32 = testGroup "Int32"+    [ testCase "Render" $ s @=? TTC.render n+    , testCase "Parse.OK" $ Right n' @=? TTC.parse s+    , testCase "Parse.invalid" $ Left "invalid Int32" @=?+        (TTC.parse "invalid" :: Either String Int32)+    ]+  where+    n :: Int32+    n = 42++    s :: String+    s = show n++    n' :: Int32+    n' = read s++testInt64 :: TestTree+testInt64 = testGroup "Int64"+    [ testCase "Render" $ s @=? TTC.render n+    , testCase "Parse.OK" $ Right n' @=? TTC.parse s+    , testCase "Parse.invalid" $ Left "invalid Int64" @=?+        (TTC.parse "invalid" :: Either String Int64)+    ]+  where+    n :: Int64+    n = 42++    s :: String+    s = show n++    n' :: Int64+    n' = read s++testInteger :: TestTree+testInteger = testGroup "Integer"+    [ testCase "Render" $ s @=? TTC.render n+    , testCase "Parse.OK" $ Right n' @=? TTC.parse s+    , testCase "Parse.invalid" $ Left "invalid Integer" @=?+        (TTC.parse "invalid" :: Either String Integer)+    ]+  where+    n :: Integer+    n = 42++    s :: String+    s = show n++    n' :: Integer+    n' = read s++testWord :: TestTree+testWord = testGroup "Word"+    [ testCase "Render" $ s @=? TTC.render n+    , testCase "Parse.OK" $ Right n' @=? TTC.parse s+    , testCase "Parse.invalid" $ Left "invalid Word" @=?+        (TTC.parse "invalid" :: Either String Word)+    ]+  where+    n :: Word+    n = 42++    s :: String+    s = show n++    n' :: Word+    n' = read s++testWord8 :: TestTree+testWord8 = testGroup "Word8"+    [ testCase "Render" $ s @=? TTC.render n+    , testCase "Parse.OK" $ Right n' @=? TTC.parse s+    , testCase "Parse.invalid" $ Left "invalid Word8" @=?+        (TTC.parse "invalid" :: Either String Word8)+    ]+  where+    n :: Word8+    n = 42++    s :: String+    s = show n++    n' :: Word8+    n' = read s++testWord16 :: TestTree+testWord16 = testGroup "Word16"+    [ testCase "Render" $ s @=? TTC.render n+    , testCase "Parse.OK" $ Right n' @=? TTC.parse s+    , testCase "Parse.invalid" $ Left "invalid Word16" @=?+        (TTC.parse "invalid" :: Either String Word16)+    ]+  where+    n :: Word16+    n = 42++    s :: String+    s = show n++    n' :: Word16+    n' = read s++testWord32 :: TestTree+testWord32 = testGroup "Word32"+    [ testCase "Render" $ s @=? TTC.render n+    , testCase "Parse.OK" $ Right n' @=? TTC.parse s+    , testCase "Parse.invalid" $ Left "invalid Word32" @=?+        (TTC.parse "invalid" :: Either String Word32)+    ]+  where+    n :: Word32+    n = 42++    s :: String+    s = show n++    n' :: Word32+    n' = read s++testWord64 :: TestTree+testWord64 = testGroup "Word64"+    [ testCase "Render" $ s @=? TTC.render n+    , testCase "Parse.OK" $ Right n' @=? TTC.parse s+    , testCase "Parse.invalid" $ Left "invalid Word64" @=?+        (TTC.parse "invalid" :: Either String Word64)+    ]+  where+    n :: Word64+    n = 42++    s :: String+    s = show n++    n' :: Word64+    n' = read s++testString :: TestTree+testString = testGroup "String"+    [ testCase "Render" $ xS @=? TTC.render xS+    , testCase "Parse.empty" $ Right "" @=? TTC.parse ""+    , testCase "Parse.nonempty" $ Right xS @=? TTC.parse xS+    ]++testBSL :: TestTree+testBSL = testGroup "BSL.ByteString"+    [ testCase "Render" $ xS @=? TTC.render xBSL+    , testCase "Parse.empty" $ Right BSL.empty @=? TTC.parse ""+    , testCase "Parse.nonempty" $ Right xBSL @=? TTC.parse xS+    ]++testBS :: TestTree+testBS = testGroup "BS.ByteString"+    [ testCase "Render" $ xS @=? TTC.render xBS+    , testCase "Parse.empty" $ Right BS.empty @=? TTC.parse ""+    , testCase "Parse.nonempty" $ Right xBS @=? TTC.parse xS+    ]++testTL :: TestTree+testTL = testGroup "TL.Text"+    [ testCase "Render" $ xS @=? TTC.render xTL+    , testCase "Parse.empty" $ Right TL.empty @=? TTC.parse ""+    , testCase "Parse.nonempty" $ Right xTL @=? TTC.parse xS+    ]++testT :: TestTree+testT = testGroup "T.Text"+    [ testCase "Render" $ xS @=? TTC.render xT+    , testCase "Parse.empty" $ Right T.empty @=? TTC.parse ""+    , testCase "Parse.nonempty" $ Right xT @=? TTC.parse xS+    ]++------------------------------------------------------------------------------++tests :: TestTree+tests = testGroup "Data.TTC.Instances"+    [ testChar+    , testDouble+    , testFloat+    , testInt+    , testInt8+    , testInt16+    , testInt32+    , testInt64+    , testInteger+    , testWord+    , testWord8+    , testWord16+    , testWord32+    , testWord64+    , testString+    , testBSL+    , testBS+    , testTL+    , testT+    ]

@@ -0,0 +1,623 @@+{-# LANGUAGE OverloadedStrings #-}++module Data.TTC.Test (tests) where++-- https://hackage.haskell.org/package/base+import Control.Exception (ErrorCall, Exception, evaluate, handle)+import Data.Proxy (Proxy(Proxy), asProxyTypeOf)+import Text.Read (readMaybe)++-- https://hackage.haskell.org/package/bytestring+import qualified Data.ByteString as BS+import qualified Data.ByteString.Builder as BSB+import qualified Data.ByteString.Lazy as BSL+import qualified Data.ByteString.Short as SBS++-- https://hackage.haskell.org/package/tasty+import Test.Tasty (TestTree, testGroup)++-- https://hackage.haskell.org/package/tasty-hunit+import Test.Tasty.HUnit ((@=?), Assertion, assertFailure, testCase)++-- https://hackage.haskell.org/package/text+import qualified Data.Text as T+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.Builder as TLB++-- (ttc)+import qualified Data.TTC as TTC++------------------------------------------------------------------------------+-- $HelperFunctions++assertRaises+  :: (Exception e, Show a)+  => Proxy e+  -> a+  -> Assertion+assertRaises proxy x =+    handle+      (const (return ()) . (`asProxyTypeOf` proxy))+      (assertFailure . ("expected exception; got: " ++) . show =<< evaluate x)++------------------------------------------------------------------------------+-- $TestData++xS :: String+xS = "test テスト"++xT :: T.Text+xT = "test テスト"++xTL :: TL.Text+xTL = "test テスト"++xBS :: BS.ByteString+xBS = "test \xe3\x83\x86\xe3\x82\xb9\xe3\x83\x88"++xBSL :: BSL.ByteString+xBSL = "test \xe3\x83\x86\xe3\x82\xb9\xe3\x83\x88"++xTLB :: TLB.Builder+xTLB = "test テスト"++xBSB :: BSB.Builder+xBSB = "test テスト"++xSBS :: SBS.ShortByteString+xSBS = "test \xe3\x83\x86\xe3\x82\xb9\xe3\x83\x88"++xiS :: String+xiS = "test \xfffd"++xiT :: T.Text+xiT = "test \xfffd"++xiTL :: TL.Text+xiTL = "test \xfffd"++xiBS :: BS.ByteString+xiBS = "test \xe3"++xiBSL :: BSL.ByteString+xiBSL = "test \xe3"++newtype PosInt = PosInt Int+  deriving Eq++instance Show PosInt where+  show (PosInt i) = "(PosInt " ++ show i ++ ")"++instance TTC.Parse PosInt where+  parse = TTC.asS $ \ s -> case readMaybe s of+    Just i+      | i >= 0 -> Right $ PosInt i+      | otherwise -> Left "not positive"+    Nothing -> Left "not an integer"++instance TTC.Render PosInt where+  render (PosInt i) = TTC.convert $ show i++answer :: PosInt+answer = PosInt 42++answerS :: String+answerS = "42"++answerT :: T.Text+answerT = "42"++answerTL :: TL.Text+answerTL = "42"++answerBS :: BS.ByteString+answerBS = "42"++answerBSL :: BSL.ByteString+answerBSL = "42"++answerZ :: Int+answerZ = 42++data IntError = IntInvalid+  deriving (Eq, Show)++data Color+  = Red+  | Green+  | Blue+  | White+  | Black+  deriving (Bounded, Enum, Eq, Show)++instance Read Color where+  readsPrec _ = TTC.readsEnum True True++instance TTC.Render Color where+  render Red   = TTC.fromT "red"+  render Green = TTC.fromT "green"+  render Blue  = TTC.fromT "blue"+  render White = TTC.fromT "white"+  render Black = TTC.fromT "black"++data ColorError+  = ColorInvalid+  | ColorAmbiguous+  deriving (Eq, Show)++redS :: String+redS = "red"++redT :: T.Text+redT = "red"++redTL :: TL.Text+redTL = "red"++redBS :: BS.ByteString+redBS = "red"++redBSL :: BSL.ByteString+redBSL = "red"++------------------------------------------------------------------------------+-- $Textual++testToS :: TestTree+testToS = testGroup "toS"+    [ testCase "S" $ xS @=? TTC.toS xS+    , testCase "T" $ xS @=? TTC.toS xT+    , testCase "TL" $ xS @=? TTC.toS xTL+    , testCase "BS" $ xS @=? TTC.toS xBS+    , testCase "BS/invalid" $ xiS @=? TTC.toS xiBS+    , testCase "BSL" $ xS @=? TTC.toS xBSL+    , testCase "BSL/invalid" $ xiS @=? TTC.toS xiBSL+    ]++testToT :: TestTree+testToT = testGroup "toT"+    [ testCase "S" $ xT @=? TTC.toT xS+    , testCase "T" $ xT @=? TTC.toT xT+    , testCase "TL" $ xT @=? TTC.toT xTL+    , testCase "BS" $ xT @=? TTC.toT xBS+    , testCase "BS/invalid" $ xiT @=? TTC.toT xiBS+    , testCase "BSL" $ xT @=? TTC.toT xBSL+    , testCase "BSL/invalid" $ xiT @=? TTC.toT xiBSL+    ]++testToTL :: TestTree+testToTL = testGroup "toTL"+    [ testCase "S" $ xTL @=? TTC.toTL xS+    , testCase "T" $ xTL @=? TTC.toTL xT+    , testCase "TL" $ xTL @=? TTC.toTL xTL+    , testCase "BS" $ xTL @=? TTC.toTL xBS+    , testCase "BS/invalid" $ xiTL @=? TTC.toTL xiBS+    , testCase "BSL" $ xTL @=? TTC.toTL xBSL+    , testCase "BSL/invalid" $ xiTL @=? TTC.toTL xiBSL+    ]++testToBS :: TestTree+testToBS = testGroup "toBS"+    [ testCase "S" $ xBS @=? TTC.toBS xS+    , testCase "T" $ xBS @=? TTC.toBS xT+    , testCase "TL" $ xBS @=? TTC.toBS xTL+    , testCase "BS" $ xBS @=? TTC.toBS xBS+    , testCase "BSL" $ xBS @=? TTC.toBS xBSL+    ]++testToBSL :: TestTree+testToBSL = testGroup "toBSL"+    [ testCase "S" $ xBSL @=? TTC.toBSL xS+    , testCase "T" $ xBSL @=? TTC.toBSL xT+    , testCase "TL" $ xBSL @=? TTC.toBSL xTL+    , testCase "BS" $ xBSL @=? TTC.toBSL xBS+    , testCase "BSL" $ xBSL @=? TTC.toBSL xBSL+    ]++testConvert :: TestTree+testConvert = testGroup "convert"+    [ testCase "S->S" $ xS @=? TTC.convert xS+    , testCase "S->T" $ xT @=? TTC.convert xS+    , testCase "S->TL" $ xTL @=? TTC.convert xS+    , testCase "S->BS" $ xBS @=? TTC.convert xS+    , testCase "S->BSL" $ xBSL @=? TTC.convert xS+    , testCase "T->S" $ xS @=? TTC.convert xT+    , testCase "T->T" $ xT @=? TTC.convert xT+    , testCase "T->TL" $ xTL @=? TTC.convert xT+    , testCase "T->BS" $ xBS @=? TTC.convert xT+    , testCase "T->BSL" $ xBSL @=? TTC.convert xT+    , testCase "TL->S" $ xS @=? TTC.convert xTL+    , testCase "TL->T" $ xT @=? TTC.convert xTL+    , testCase "TL->TL" $ xTL @=? TTC.convert xTL+    , testCase "TL->BS" $ xBS @=? TTC.convert xTL+    , testCase "TL->BSL" $ xBSL @=? TTC.convert xTL+    , testCase "BS->S" $ xS @=? TTC.convert xBS+    , testCase "BS->T" $ xT @=? TTC.convert xBS+    , testCase "BS->TL" $ xTL @=? TTC.convert xBS+    , testCase "BS->BS" $ xBS @=? TTC.convert xBS+    , testCase "BS->BSL" $ xBSL @=? TTC.convert xBS+    , testCase "BSL->S" $ xS @=? TTC.convert xBSL+    , testCase "BSL->T" $ xT @=? TTC.convert xBSL+    , testCase "BSL->TL" $ xTL @=? TTC.convert xBSL+    , testCase "BSL->BS" $ xBS @=? TTC.convert xBSL+    , testCase "BSL->BSL" $ xBSL @=? TTC.convert xBSL+    ]++testFromS :: TestTree+testFromS = testGroup "fromS"+    [ testCase "S" $ xS @=? TTC.fromS xS+    , testCase "T" $ xT @=? TTC.fromS xS+    , testCase "TL" $ xTL @=? TTC.fromS xS+    , testCase "BS" $ xBS @=? TTC.fromS xS+    , testCase "BSL" $ xBSL @=? TTC.fromS xS+    ]++testFromT :: TestTree+testFromT = testGroup "fromT"+    [ testCase "S" $ xS @=? TTC.fromT xT+    , testCase "T" $ xT @=? TTC.fromT xT+    , testCase "TL" $ xTL @=? TTC.fromT xT+    , testCase "BS" $ xBS @=? TTC.fromT xT+    , testCase "BSL" $ xBSL @=? TTC.fromT xT+    ]++testFromTL :: TestTree+testFromTL = testGroup "fromTL"+    [ testCase "S" $ xS @=? TTC.fromTL xTL+    , testCase "T" $ xT @=? TTC.fromTL xTL+    , testCase "TL" $ xTL @=? TTC.fromTL xTL+    , testCase "BS" $ xBS @=? TTC.fromTL xTL+    , testCase "BSL" $ xBSL @=? TTC.fromTL xTL+    ]++testFromBS :: TestTree+testFromBS = testGroup "fromBS"+    [ testCase "S" $ xS @=? TTC.fromBS xBS+    , testCase "T" $ xT @=? TTC.fromBS xBS+    , testCase "TL" $ xTL @=? TTC.fromBS xBS+    , testCase "BS" $ xBS @=? TTC.fromBS xBS+    , testCase "BSL" $ xBSL @=? TTC.fromBS xBS+    ]++testFromBSL :: TestTree+testFromBSL = testGroup "fromBSL"+    [ testCase "S" $ xS @=? TTC.fromBSL xBSL+    , testCase "T" $ xT @=? TTC.fromBSL xBSL+    , testCase "TL" $ xTL @=? TTC.fromBSL xBSL+    , testCase "BS" $ xBS @=? TTC.fromBSL xBSL+    , testCase "BSL" $ xBSL @=? TTC.fromBSL xBSL+    ]++testAsS :: TestTree+testAsS = testGroup "asS"+    [ testCase "S" $ xS @=? TTC.asS id xS+    , testCase "T" $ xS @=? TTC.asS id xT+    , testCase "TL" $ xS @=? TTC.asS id xTL+    , testCase "BS" $ xS @=? TTC.asS id xBS+    , testCase "BSL" $ xS @=? TTC.asS id xBSL+    ]++testAsT :: TestTree+testAsT = testGroup "asT"+    [ testCase "S" $ xT @=? TTC.asT id xS+    , testCase "T" $ xT @=? TTC.asT id xT+    , testCase "TL" $ xT @=? TTC.asT id xTL+    , testCase "BS" $ xT @=? TTC.asT id xBS+    , testCase "BSL" $ xT @=? TTC.asT id xBSL+    ]++testAsTL :: TestTree+testAsTL = testGroup "asTL"+    [ testCase "S" $ xTL @=? TTC.asTL id xS+    , testCase "T" $ xTL @=? TTC.asTL id xT+    , testCase "TL" $ xTL @=? TTC.asTL id xTL+    , testCase "BS" $ xTL @=? TTC.asTL id xBS+    , testCase "BSL" $ xTL @=? TTC.asTL id xBSL+    ]++testAsBS :: TestTree+testAsBS = testGroup "asBS"+    [ testCase "S" $ xBS @=? TTC.asBS id xS+    , testCase "T" $ xBS @=? TTC.asBS id xT+    , testCase "TL" $ xBS @=? TTC.asBS id xTL+    , testCase "BS" $ xBS @=? TTC.asBS id xBS+    , testCase "BSL" $ xBS @=? TTC.asBS id xBSL+    ]++testAsBSL :: TestTree+testAsBSL = testGroup "asBSL"+    [ testCase "S" $ xBSL @=? TTC.asBSL id xS+    , testCase "T" $ xBSL @=? TTC.asBSL id xT+    , testCase "TL" $ xBSL @=? TTC.asBSL id xTL+    , testCase "BS" $ xBSL @=? TTC.asBSL id xBS+    , testCase "BSL" $ xBSL @=? TTC.asBSL id xBSL+    ]++testToTLB :: TestTree+testToTLB = testCase "toTLB" $ xTLB @=? TTC.toTLB xS++testFromTLB :: TestTree+testFromTLB = testCase "fromTLB" $ xS @=? TTC.fromTLB xTLB++testToBSB :: TestTree+testToBSB = testCase "toBSB" $+    BSB.toLazyByteString xBSB @=? BSB.toLazyByteString (TTC.toBSB xS)++testFromBSB :: TestTree+testFromBSB = testCase "fromBSB" $ xS @=? TTC.fromBSB xBSB++testToSBS :: TestTree+testToSBS = testCase "toSBS" $ xSBS @=? TTC.toSBS xS++testFromSBS :: TestTree+testFromSBS = testCase "fromSBS" $ xS @=? TTC.fromSBS xSBS++------------------------------------------------------------------------------+-- $Render++testRender :: TestTree+testRender = testGroup "render"+    [ testCase "S" $ answerS @=? TTC.render answer+    , testCase "T" $ answerT @=? TTC.render answer+    , testCase "TL" $ answerTL @=? TTC.render answer+    , testCase "BS" $ answerBS @=? TTC.render answer+    , testCase "BSL" $ answerBSL @=? TTC.render answer+    ]++testRenderS :: TestTree+testRenderS = testCase "renderS" $ answerS @=? TTC.renderS answer++testRenderT :: TestTree+testRenderT = testCase "renderT" $ answerT @=? TTC.renderT answer++testRenderTL :: TestTree+testRenderTL = testCase "renderTL" $ answerTL @=? TTC.renderTL answer++testRenderBS :: TestTree+testRenderBS = testCase "renderBS" $ answerBS @=? TTC.renderBS answer++testRenderBSL :: TestTree+testRenderBSL = testCase "renderBSL" $ answerBSL @=? TTC.renderBSL answer++testRenderWithShow :: TestTree+testRenderWithShow = testGroup "renderWithShow"+    [ testCase "S" $ answerS @=? TTC.renderWithShow answerZ+    , testCase "T" $ answerT @=? TTC.renderWithShow answerZ+    , testCase "TL" $ answerTL @=? TTC.renderWithShow answerZ+    , testCase "BS" $ answerBS @=? TTC.renderWithShow answerZ+    , testCase "BSL" $ answerBSL @=? TTC.renderWithShow answerZ+    ]++------------------------------------------------------------------------------+-- $Parse++testParse :: TestTree+testParse = testGroup "parse"+    [ testCase "S" $ Right answer @=? TTC.parse answerS+    , testCase "T" $ Right answer @=? TTC.parse answerT+    , testCase "TL" $ Right answer @=? TTC.parse answerTL+    , testCase "BS" $ Right answer @=? TTC.parse answerBS+    , testCase "BSL" $ Right answer @=? TTC.parse answerBSL+    , testCase "negative" $ Left "not positive" @=?+        (TTC.parse ('-' : answerS) :: Either String PosInt)+    , testCase "invalid" $ Left "not an integer" @=?+        (TTC.parse ('a' : answerS) :: Either String PosInt)+    ]++testParseS :: TestTree+testParseS = testCase "parseS" $ Right answer @=? TTC.parseS answerS++testParseT :: TestTree+testParseT = testCase "parseT" $ Right answer @=? TTC.parseT answerT++testParseTL :: TestTree+testParseTL = testCase "parseTL" $ Right answer @=? TTC.parseTL answerTL++testParseBS :: TestTree+testParseBS = testCase "parseBS" $ Right answer @=? TTC.parseBS answerBS++testParseBSL :: TestTree+testParseBSL = testCase "parseBSL" $ Right answer @=? TTC.parseBSL answerBSL++testParseMaybe :: TestTree+testParseMaybe = testGroup "parseMaybe"+    [ testCase "S" $ Just answer @=? TTC.parseMaybe answerS+    , testCase "T" $ Just answer @=? TTC.parseMaybe answerT+    , testCase "TL" $ Just answer @=? TTC.parseMaybe answerTL+    , testCase "BS" $ Just answer @=? TTC.parseMaybe answerBS+    , testCase "BSL" $ Just answer @=? TTC.parseMaybe answerBSL+    , testCase "negative" $+        Nothing @=? (TTC.parseMaybe ('-' : answerS) :: Maybe PosInt)+    , testCase "invalid" $+        Nothing @=? (TTC.parseMaybe ('a' : answerS) :: Maybe PosInt)+    ]++testParseMaybeS :: TestTree+testParseMaybeS = testCase "parseMaybeS" $+    Just answer @=? TTC.parseMaybeS answerS++testParseMaybeT :: TestTree+testParseMaybeT = testCase "parseMaybeT" $+    Just answer @=? TTC.parseMaybeT answerT++testParseMaybeTL :: TestTree+testParseMaybeTL = testCase "parseMaybeTL" $+    Just answer @=? TTC.parseMaybeTL answerTL++testParseMaybeBS :: TestTree+testParseMaybeBS = testCase "parseMaybeBS" $+    Just answer @=? TTC.parseMaybeBS answerBS++testParseMaybeBSL :: TestTree+testParseMaybeBSL = testCase "parseMaybeBSL" $+    Just answer @=? TTC.parseMaybeBSL answerBSL++testParseUnsafe :: TestTree+testParseUnsafe = testGroup "parseUnsafe"+    [ testCase "S" $ answer @=? TTC.parseUnsafe answerS+    , testCase "T" $ answer @=? TTC.parseUnsafe answerT+    , testCase "TL" $ answer @=? TTC.parseUnsafe answerTL+    , testCase "BS" $ answer @=? TTC.parseUnsafe answerBS+    , testCase "BSL" $ answer @=? TTC.parseUnsafe answerBSL+    , testCase "negative" $ assertRaises (Proxy :: Proxy ErrorCall)+        (TTC.parseUnsafe ('-' : answerS) :: PosInt)+    , testCase "invalid" $ assertRaises (Proxy :: Proxy ErrorCall)+        (TTC.parseUnsafe ('a' : answerS) :: PosInt)+    ]++testParseUnsafeS :: TestTree+testParseUnsafeS = testCase "parseUnsafeS" $+    answer @=? TTC.parseUnsafeS answerS++testParseUnsafeT :: TestTree+testParseUnsafeT = testCase "parseUnsafeT" $+    answer @=? TTC.parseUnsafeT answerT++testParseUnsafeTL :: TestTree+testParseUnsafeTL = testCase "parseUnsafeTL" $+    answer @=? TTC.parseUnsafeTL answerTL++testParseUnsafeBS :: TestTree+testParseUnsafeBS = testCase "parseUnsafeBS" $+    answer @=? TTC.parseUnsafeBS answerBS++testParseUnsafeBSL :: TestTree+testParseUnsafeBSL = testCase "parseUnsafeBSL" $+    answer @=? TTC.parseUnsafeBSL answerBSL++testParseWithRead :: TestTree+testParseWithRead = testGroup "parseWithRead"+    [ testCase "S" $ Right answerZ @=? TTC.parseWithRead IntInvalid answerS+    , testCase "T" $ Right answerZ @=? TTC.parseWithRead IntInvalid answerT+    , testCase "TL" $ Right answerZ @=? TTC.parseWithRead IntInvalid answerTL+    , testCase "BS" $ Right answerZ @=? TTC.parseWithRead IntInvalid answerBS+    , testCase "BSL" $+        Right answerZ @=? TTC.parseWithRead IntInvalid answerBSL+    , testCase "invalid" $ Left IntInvalid @=?+        (TTC.parseWithRead IntInvalid ('a' : answerS) :: Either IntError Int)+    ]++testParseWithRead' :: TestTree+testParseWithRead' = testGroup "parseWithRead'"+    [ testCase "S" $ Right answerZ @=? TTC.parseWithRead' "Int" answerS+    , testCase "T" $ Right answerZ @=? TTC.parseWithRead' "Int" answerT+    , testCase "TL" $ Right answerZ @=? TTC.parseWithRead' "Int" answerTL+    , testCase "BS" $ Right answerZ @=? TTC.parseWithRead' "Int" answerBS+    , testCase "BSL" $ Right answerZ @=? TTC.parseWithRead' "Int" answerBSL+    , testCase "invalid" $ Left "invalid Int" @=?+        (TTC.parseWithRead' "Int" ('a' : answerS) :: Either String Int)+    ]++testParseEnum :: TestTree+testParseEnum = testGroup "parseEnum"+    [ testCase "S" $ Right Red @=? parse False False redS+    , testCase "T" $ Right Red @=? parse False False redT+    , testCase "TL" $ Right Red @=? parse False False redTL+    , testCase "BS" $ Right Red @=? parse False False redBS+    , testCase "BSL" $ Right Red @=? parse False False redBSL+    , testCase "CI" $ Right Red @=? parse True False ("Red" :: String)+    , testCase "!CI" $ Left ColorInvalid @=?+        parse False False ("Red" :: String)+    , testCase "prefix" $ Right Red @=? parse False True ("r" :: String)+    , testCase "ambiguous" $ Left ColorAmbiguous @=?+        parse False True ("bl" :: String)+    ]+  where+    parse :: TTC.Textual t => Bool -> Bool -> t -> Either ColorError Color+    parse allowCI allowPrefix =+      TTC.parseEnum allowCI allowPrefix ColorInvalid ColorAmbiguous++testParseEnum' :: TestTree+testParseEnum' = testGroup "parseEnum'"+    [ testCase "S" $ Right Red @=? parse False False redS+    , testCase "T" $ Right Red @=? parse False False redT+    , testCase "TL" $ Right Red @=? parse False False redTL+    , testCase "BS" $ Right Red @=? parse False False redBS+    , testCase "BSL" $ Right Red @=? parse False False redBSL+    , testCase "CI" $ Right Red @=? parse True False ("Red" :: String)+    , testCase "!CI" $ Left "invalid Color" @=?+        parse False False ("Red" :: String)+    , testCase "prefix" $ Right Red @=? parse False True ("r" :: String)+    , testCase "ambiguous" $ Left "ambiguous Color" @=?+        parse False True ("bl" :: String)+    ]+  where+    parse :: TTC.Textual t => Bool -> Bool -> t -> Either String Color+    parse = TTC.parseEnum' "Color"++testReadsWithParse :: TestTree+testReadsWithParse = testGroup "readsWithParse"+    [ testCase "valid" $ [(answer, "")] @=? TTC.readsWithParse answerS+    , testCase "invalid" $ [] @=? (TTC.readsWithParse :: ReadS PosInt) "-42"+    ]++testReadsEnum :: TestTree+testReadsEnum = testGroup "readsEnum"+    [ testCase "valid" $ Just Red @=? readMaybe "R"+    , testCase "invalid" $ Nothing @=? (readMaybe "bl" :: Maybe Color)+    ]++------------------------------------------------------------------------------++tests :: TestTree+tests = testGroup "Data.TTC"+    [ testGroup "Textual"+        [ testToS+        , testToT+        , testToTL+        , testToBS+        , testToBSL+        , testConvert+        , testFromS+        , testFromT+        , testFromTL+        , testFromBS+        , testFromBSL+        , testAsS+        , testAsT+        , testAsTL+        , testAsBS+        , testAsBSL+        , testToTLB+        , testFromTLB+        , testToBSB+        , testFromBSB+        , testToSBS+        , testFromSBS+        ]+    , testGroup "Render"+        [ testRender+        , testRenderS+        , testRenderT+        , testRenderTL+        , testRenderBS+        , testRenderBSL+        , testRenderWithShow+        ]+    , testGroup "Parse"+        [ testParse+        , testParseS+        , testParseT+        , testParseTL+        , testParseBS+        , testParseBSL+        , testParseMaybe+        , testParseMaybeS+        , testParseMaybeT+        , testParseMaybeTL+        , testParseMaybeBS+        , testParseMaybeBSL+        , testParseUnsafe+        , testParseUnsafeS+        , testParseUnsafeT+        , testParseUnsafeTL+        , testParseUnsafeBS+        , testParseUnsafeBSL+        , testParseWithRead+        , testParseWithRead'+        , testParseEnum+        , testParseEnum'+        , testReadsWithParse+        , testReadsEnum+        ]+    ]

@@ -0,0 +1,16 @@+module Main (main) where++-- https://hackage.haskell.org/package/tasty+import Test.Tasty (defaultMain, testGroup)++-- (ttc:test)+import qualified Data.TTC.Test+import qualified Data.TTC.Instances.Test++------------------------------------------------------------------------------++main :: IO ()+main = defaultMain $ testGroup "test"+    [ Data.TTC.Test.tests+    , Data.TTC.Instances.Test.tests+    ]

@@ -0,0 +1,168 @@+name:           ttc+version:        0.1.0.0+category:       Data, Text+synopsis:       Textual Type Classes+description:+  This library provides type classes for conversion between data types and+  textual data types (strings).  Please see the README on GitHub at+  <https://github.com/ExtremaIS/ttc-haskell#readme>.++homepage:       https://github.com/ExtremaIS/ttc-haskell#readme+bug-reports:    https://github.com/ExtremaIS/ttc-haskell/issues+author:         Travis Cardwell <travis.cardwell@extrema.is>+maintainer:     Travis Cardwell <travis.cardwell@extrema.is>+copyright:      Copyright (c) 2019 Travis Cardwell+license:        MIT+license-file:   LICENSE++cabal-version:  >=1.10+build-type:     Simple+tested-with:+  GHC ==8.2.2+   || ==8.4.4+   || ==8.6.5++extra-source-files:+  CHANGELOG.md+  README.md++source-repository head+  type: git+  location: https://github.com/ExtremaIS/ttc-haskell.git++flag example-invalid+  description: build example-invalid+  default: False++flag example-mkvalid+  description: build example-mkvalid+  default: False++flag example-prompt+  description: build example-prompt+  default: False++flag example-uname+  description: build example-uname+  default: False++flag example-valid+  description: build example-valid+  default: False++flag examples+  description: build all buildable examples+  default: False++library+  hs-source-dirs: src+  exposed-modules:+      Data.TTC+    , Data.TTC.Instances+  build-depends:+      base >=4.7 && <5+    , bytestring >=0.10.8 && <0.11+    , template-haskell >=2.12 && <2.16+    , text >=1.2.3 && <1.3+  default-language: Haskell2010+  ghc-options: -Wall++executable example-invalid+  if flag(example-invalid)+    buildable: True+  else+    buildable: False+  hs-source-dirs: examples+  main-is: invalid.hs+  other-modules:+      CreditCard+  build-depends:+      base+    , template-haskell+    , time >=1.8 && <1.9+    , ttc+  default-language: Haskell2010+  ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N++executable example-mkvalid+  if flag(examples) || flag(example-mkvalid)+    buildable: True+  else+    buildable: False+  hs-source-dirs: examples+  main-is: mkvalid.hs+  other-modules:+      Duration+  build-depends:+      base+    , time >=1.8 && <1.9+    , ttc+  default-language: Haskell2010+  ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N++executable example-prompt+  if flag(examples) || flag(example-prompt)+    buildable: True+  else+    buildable: False+  hs-source-dirs: examples+  main-is: prompt.hs+  other-modules:+      CreditCard+  build-depends:+      base+    , template-haskell+    , time >=1.8 && <1.9+    , ttc+  default-language: Haskell2010+  ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N++executable example-uname+  if flag(examples) || flag(example-uname)+    buildable: True+  else+    buildable: False+  hs-source-dirs: examples+  main-is: uname.hs+  other-modules:+      Username+  build-depends:+      base+    , text+    , ttc+  default-language: Haskell2010+  ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N++executable example-valid+  if flag(examples) || flag(example-valid)+    buildable: True+  else+    buildable: False+  hs-source-dirs: examples+  main-is: valid.hs+  other-modules:+      CreditCard+  build-depends:+      base+    , template-haskell+    , time >=1.8 && <1.9+    , ttc+  default-language: Haskell2010+  ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N++test-suite ttc-test+  type: exitcode-stdio-1.0+  hs-source-dirs: test+  main-is: Spec.hs+  other-modules:+      Data.TTC.Test+    , Data.TTC.Instances.Test+  build-depends:+      base+    , bytestring+    , tasty >=1.0 && <1.3+    , tasty-hunit >=0.10 && <0.11+    , text+    , ttc+  default-language: Haskell2010+  ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N