diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -24,6 +24,22 @@ [KaC]: +## 0.4.0.0 (2021-03-27) + +### Breaking + +* Add support for GHC 9 +* Add `renderTLB`, `renderBSB`, and `renderSBS` functions +* Use `Textual` error messages for `parseEnum'` + +### Non-Breaking + +* Add `@since` annotations +* Rename Git default branch to `main` +* Use GitHub Actions instead of Travis CI +* Add Cabal tests to GitHub Actions +* Add [stan](https://hackage.haskell.org/package/stan) static analysis + ## 0.3.0.0 (2020-11-03) ### Breaking diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,6 +1,6 @@ The MIT License -Copyright (c) 2019-2020 Travis Cardwell +Copyright (c) 2019-2021 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 diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,6 +1,6 @@ # TTC: Textual Type Classes -[![Build Status](https://travis-ci.com/ExtremaIS/ttc-haskell.svg?branch=master)](https://travis-ci.com/ExtremaIS/ttc-haskell) +[![GitHub CI](https://github.com/ExtremaIS/ttc-haskell/workflows/CI/badge.svg?branch=main)](https://github.com/ExtremaIS/ttc-haskell/actions) [![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) @@ -100,7 +100,7 @@ ```haskell instance TTC.Parse Username where - parse = TTC.asT $ \t-> first TTC.fromS $ do + parse = TTC.asT $ \t -> first TTC.fromS $ do unless (T.all isAsciiLower t) $ Left "username has invalid character(s)" let len = T.length t when (len < 3) $ Left "username has fewer than 3 characters" @@ -212,7 +212,7 @@ * Hackage: * Stackage: * GitHub: -* Travis CI: +* GitHub Actions CI: ### Dependencies @@ -223,7 +223,7 @@ ### Releases -All releases are tagged in the `master` branch. Release tags are signed using +All releases are tagged in the `main` branch. Release tags are signed using the [`security@extrema.is` GPG key](http://keys.gnupg.net/pks/lookup?op=vindex&fingerprint=on&search=0x1D484E4B4705FADF). diff --git a/src/Data/TTC.hs b/src/Data/TTC.hs --- a/src/Data/TTC.hs +++ b/src/Data/TTC.hs @@ -2,7 +2,7 @@ -- | -- Module : Data.TTC -- Description : textual type classes --- Copyright : Copyright (c) 2019-2020 Travis Cardwell +-- Copyright : Copyright (c) 2019-2021 Travis Cardwell -- License : MIT -- -- TTC, an initialism of /Textual Type Classes/, is a library that provides @@ -16,9 +16,14 @@ -- @ ------------------------------------------------------------------------------ +{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TemplateHaskell #-} +#if __GLASGOW_HASKELL__ >= 900 +{-# LANGUAGE ExplicitForAll #-} +#endif + module Data.TTC ( -- * Textual Textual @@ -61,6 +66,9 @@ , renderTL , renderBS , renderBSL + , renderTLB + , renderBSB + , renderSBS -- ** Render Utilities , renderWithShow -- * Parse @@ -97,6 +105,7 @@ , readsEnum , readsWithParse -- ** Constant Validation + -- $ParseValid , valid , validOf , mkValid @@ -153,23 +162,37 @@ -- 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. +-- +-- @since 0.1.0.0 class Textual t where -- | Convert to a 'String' + -- + -- @since 0.1.0.0 toS :: t -> String -- | Convert to strict 'T.Text' + -- + -- @since 0.1.0.0 toT :: t -> T.Text -- | Convert to lazy 'TL.Text' + -- + -- @since 0.1.0.0 toTL :: t -> TL.Text -- | Convert to a strict 'BS.ByteString' + -- + -- @since 0.1.0.0 toBS :: t -> BS.ByteString -- | Convert to a lazy 'BS.ByteString' + -- + -- @since 0.1.0.0 toBSL :: t -> BSL.ByteString -- | Convert between any supported textual data types + -- + -- @since 0.1.0.0 convert :: Textual t' => t' -> t instance Textual String where @@ -242,6 +265,7 @@ {-# INLINE toBSL #-} {-# INLINE convert #-} +------------------------------------------------------------------------------ -- $TextualTo -- -- These functions are equivalent to 'convert', but they specify the type @@ -255,30 +279,41 @@ -- in cases where the type is ambiguous. -- | Convert from a 'String' +-- +-- @since 0.1.0.0 fromS :: Textual t => String -> t fromS = convert {-# INLINE fromS #-} -- | Convert from strict 'T.Text' +-- +-- @since 0.1.0.0 fromT :: Textual t => T.Text -> t fromT = convert {-# INLINE fromT #-} -- | Convert from lazy 'TL.Text' +-- +-- @since 0.1.0.0 fromTL :: Textual t => TL.Text -> t fromTL = convert {-# INLINE fromTL #-} -- | Convert from a strict 'BS.ByteString' +-- +-- @since 0.1.0.0 fromBS :: Textual t => BS.ByteString -> t fromBS = convert {-# INLINE fromBS #-} -- | Convert from a lazy 'BSL.ByteString' +-- +-- @since 0.1.0.0 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 @@ -286,30 +321,41 @@ -- definitions. -- | Convert an argument to a 'String' +-- +-- @since 0.1.0.0 asS :: Textual t => (String -> a) -> t -> a asS f = f . convert {-# INLINE asS #-} -- | Convert an argument to strict 'T.Text' +-- +-- @since 0.1.0.0 asT :: Textual t => (T.Text -> a) -> t -> a asT f = f . convert {-# INLINE asT #-} -- | Convert an argument to lazy 'TL.Text' +-- +-- @since 0.1.0.0 asTL :: Textual t => (TL.Text -> a) -> t -> a asTL f = f . convert {-# INLINE asTL #-} -- | Convert an argument to a strict 'BS.ByteString' +-- +-- @since 0.1.0.0 asBS :: Textual t => (BS.ByteString -> a) -> t -> a asBS f = f . convert {-# INLINE asBS #-} -- | Convert an argument to a lazy 'BSL.ByteString' +-- +-- @since 0.1.0.0 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 @@ -320,26 +366,38 @@ -- * 'SBS.ShortByteString' (@SBS@) -- | Convert to a @Text@ 'TLB.Builder' +-- +-- @since 0.1.0.0 toTLB :: Textual t => t -> TLB.Builder toTLB = TLB.fromLazyText . convert -- | Convert from a @Text@ 'TLB.Builder' +-- +-- @since 0.1.0.0 fromTLB :: Textual t => TLB.Builder -> t fromTLB = convert . TLB.toLazyText -- | Convert to a @ByteString@ 'BSB.Builder' +-- +-- @since 0.1.0.0 toBSB :: Textual t => t -> BSB.Builder toBSB = BSB.lazyByteString . convert -- | Convert from a @ByteString@ 'BSB.Builder' +-- +-- @since 0.1.0.0 fromBSB :: Textual t => BSB.Builder -> t fromBSB = convert . BSB.toLazyByteString -- | Convert to a 'SBS.ShortByteString' +-- +-- @since 0.1.0.0 toSBS :: Textual t => t -> SBS.ShortByteString toSBS = SBS.toShort . convert -- | Convert from a 'SBS.ShortByteString' +-- +-- @since 0.1.0.0 fromSBS :: Textual t => SBS.ShortByteString -> t fromSBS = convert . SBS.fromShort @@ -353,9 +411,12 @@ -- basic data types are available in "Data.TTC.Instances". -- -- See the @uname@ and @prompt@ example programs in the @examples@ directory. +-- +-- @since 0.1.0.0 class Render a where render :: Textual t => a -> t +------------------------------------------------------------------------------ -- $RenderSpecific -- -- These functions are equivalent to 'render', but they specify the type being @@ -363,33 +424,67 @@ -- where the type is ambiguous. -- | Render to a 'String' +-- +-- @since 0.1.0.0 renderS :: Render a => a -> String renderS = render {-# INLINE renderS #-} -- | Render to strict 'T.Text' +-- +-- @since 0.1.0.0 renderT :: Render a => a -> T.Text renderT = render {-# INLINE renderT #-} -- | Render to lazy 'TL.Text' +-- +-- @since 0.1.0.0 renderTL :: Render a => a -> TL.Text renderTL = render {-# INLINE renderTL #-} -- | Render to a strict 'BS.ByteString' +-- +-- @since 0.1.0.0 renderBS :: Render a => a -> BS.ByteString renderBS = render {-# INLINE renderBS #-} -- | Render to a lazy 'BSL.ByteString' +-- +-- @since 0.1.0.0 renderBSL :: Render a => a -> BSL.ByteString renderBSL = render {-# INLINE renderBSL #-} +-- | Render to a @Text@ 'TLB.Builder' +-- +-- @since 0.4.0.0 +renderTLB :: Render a => a -> TLB.Builder +renderTLB = TLB.fromLazyText . renderTL +{-# INLINE renderTLB #-} + +-- | Render to a @ByteString@ 'BSB.Builder' +-- +-- @since 0.4.0.0 +renderBSB :: Render a => a -> BSB.Builder +renderBSB = BSB.lazyByteString . renderBSL +{-# INLINE renderBSB #-} + +-- | Render to a 'SBS.ShortByteString' +-- +-- @since 0.4.0.0 +renderSBS :: Render a => a -> SBS.ShortByteString +renderSBS = SBS.toShort . renderBS +{-# INLINE renderSBS #-} + +------------------------------------------------------------------------------ -- $RenderUtils -- | Render a value to a textual data type using the 'Show' instance +-- +-- @since 0.1.0.0 renderWithShow :: (Show a, Textual t) => a -> t renderWithShow = convert . show {-# INLINE renderWithShow #-} @@ -404,15 +499,20 @@ -- basic data types are available in "Data.TTC.Instances". -- -- See the @uname@ and @prompt@ example programs in the @examples@ directory. +-- +-- @since 0.3.0.0 class Parse a where parse :: (Textual t, Textual e) => t -> Either e a -- This function is equivalent to 'parse' with the error type fixed to -- 'String', used internally when the error is ignored. +-- +-- @since 0.3.0.0 parse' :: (Parse a, Textual t) => t -> Either String a parse' = parse {-# INLINE parse' #-} +------------------------------------------------------------------------------ -- $ParseSpecific -- -- These functions are equivalent to 'parse', but they specify the type being @@ -420,30 +520,41 @@ -- where the type is ambiguous. -- | Parse from a 'String' +-- +-- @since 0.3.0.0 parseS :: (Parse a, Textual e) => String -> Either e a parseS = parse {-# INLINE parseS #-} -- | Parse from strict 'T.Text' +-- +-- @since 0.3.0.0 parseT :: (Parse a, Textual e) => T.Text -> Either e a parseT = parse {-# INLINE parseT #-} -- | Parse from lazy 'TL.Text' +-- +-- @since 0.3.0.0 parseTL :: (Parse a, Textual e) => TL.Text -> Either e a parseTL = parse {-# INLINE parseTL #-} -- | Parse from a strict 'BS.ByteString' +-- +-- @since 0.3.0.0 parseBS :: (Parse a, Textual e) => BS.ByteString -> Either e a parseBS = parse {-# INLINE parseBS #-} -- | Parse from a lazy 'BSL.ByteString' +-- +-- @since 0.3.0.0 parseBSL :: (Parse a, Textual e) => BSL.ByteString -> Either e a parseBSL = parse {-# INLINE parseBSL #-} +------------------------------------------------------------------------------ -- $ParseMaybe -- -- The 'parseMaybe' function parses to a 'Maybe' type instead of an 'Either' @@ -452,35 +563,48 @@ -- annotations in cases where the type is ambiguous. -- | Parse to a 'Maybe' type +-- +-- @since 0.3.0.0 parseMaybe :: (Parse a, Textual t) => t -> Maybe a parseMaybe = either (const Nothing) Just . parse' {-# INLINE parseMaybe #-} -- | Parse from a 'String' to a 'Maybe' type +-- +-- @since 0.3.0.0 parseMaybeS :: Parse a => String -> Maybe a parseMaybeS = parseMaybe {-# INLINE parseMaybeS #-} -- | Parse from strict 'T.Text' to a 'Maybe' type +-- +-- @since 0.3.0.0 parseMaybeT :: Parse a => T.Text -> Maybe a parseMaybeT = parseMaybe {-# INLINE parseMaybeT #-} -- | Parse from lazy 'TL.Text' to a 'Maybe' type +-- +-- @since 0.3.0.0 parseMaybeTL :: Parse a => TL.Text -> Maybe a parseMaybeTL = parseMaybe {-# INLINE parseMaybeTL #-} -- | Parse from a strict 'BS.ByteString' to a 'Maybe' type +-- +-- @since 0.3.0.0 parseMaybeBS :: Parse a => BS.ByteString -> Maybe a parseMaybeBS = parseMaybe {-# INLINE parseMaybeBS #-} -- | Parse from a lazy 'BSL.ByteString' to a 'Maybe' type +-- +-- @since 0.3.0.0 parseMaybeBSL :: Parse a => BSL.ByteString -> Maybe a parseMaybeBSL = parseMaybe {-# INLINE parseMaybeBSL #-} +------------------------------------------------------------------------------ -- $ParseUnsafe -- -- The 'parseUnsafe' function raises an exception on error instead of using an @@ -490,35 +614,48 @@ -- in cases where the type is ambiguous. -- | Unsafely parse +-- +-- @since 0.1.0.0 parseUnsafe :: (Parse a, Textual t) => t -> a parseUnsafe = either (error . ("parseUnsafe: " ++)) id . parse {-# INLINE parseUnsafe #-} -- | Unsafely parse to a 'String' +-- +-- @since 0.1.0.0 parseUnsafeS :: Parse a => String -> a parseUnsafeS = parseUnsafe {-# INLINE parseUnsafeS #-} -- | Unsafely parse to strict 'T.Text' +-- +-- @since 0.1.0.0 parseUnsafeT :: Parse a => T.Text -> a parseUnsafeT = parseUnsafe {-# INLINE parseUnsafeT #-} -- | Unsafely parse to lazy 'TL.Text' +-- +-- @since 0.1.0.0 parseUnsafeTL :: Parse a => TL.Text -> a parseUnsafeTL = parseUnsafe {-# INLINE parseUnsafeTL #-} -- | Unsafely parse to a strict 'BS.ByteString' +-- +-- @since 0.1.0.0 parseUnsafeBS :: Parse a => BS.ByteString -> a parseUnsafeBS = parseUnsafe {-# INLINE parseUnsafeBS #-} -- | Unsafely parse to a lazy 'BSL.ByteString' +-- +-- @since 0.1.0.0 parseUnsafeBSL :: Parse a => BSL.ByteString -> a parseUnsafeBSL = parseUnsafe {-# INLINE parseUnsafeBSL #-} +------------------------------------------------------------------------------ -- $ParseUtils -- | Parse a value in an enumeration @@ -527,6 +664,8 @@ -- the implementation uses a linear algorithm. -- -- See the @enum@ example program in the @examples@ directory. +-- +-- @since 0.1.0.0 parseEnum :: (Bounded a, Enum a, Render a, Textual t) => Bool -- ^ case-insensitive when 'True' @@ -540,7 +679,7 @@ in case [v | v <- [minBound ..], t' `match` norm (render v)] of [v] -> Right v [] -> Left invalidError - _ -> Left ambiguousError + _vs -> Left ambiguousError where norm :: T.Text -> T.Text norm = if allowCI then T.toLower else id @@ -548,24 +687,31 @@ match :: T.Text -> T.Text -> Bool match = if allowPrefix then T.isPrefixOf else (==) --- | Parse a value in an enumeration, with 'String' error messages +-- | Parse a value in an enumeration, with 'Textual' 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 +-- +-- @since 0.4.0.0 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 + :: (Bounded a, Enum a, Render a, Textual t, Textual e) + => String -- ^ name to include in error messages + -> Bool -- ^ case-insensitive when 'True' + -> Bool -- ^ accept unique prefixes when 'True' + -> t -- ^ textual input to parse + -> Either e a -- ^ error or parsed value parseEnum' name allowCI allowPrefix = - parseEnum allowCI allowPrefix ("invalid " ++ name) ("ambiguous " ++ name) + parseEnum + allowCI allowPrefix + (fromS $ "invalid " ++ name) + (fromS $ "ambiguous " ++ name) {-# INLINEABLE parseEnum' #-} -- | Parse a value using the 'Read' instance +-- +-- @since 0.1.0.0 parseWithRead :: (Read a, Textual t) => e -- ^ invalid input error @@ -574,11 +720,13 @@ parseWithRead invalidError = maybe (Left invalidError) Right . readMaybe . toS {-# INLINEABLE parseWithRead #-} --- | Parse a value using the 'Read' instance, with 'String' error messages +-- | Parse a value using the 'Read' instance, with 'Textual' error messages -- -- The following English error message is returned: -- -- * \"invalid {name}\" when the parse fails +-- +-- @since 0.3.0.0 parseWithRead' :: (Read a, Textual t, Textual e) => String -- ^ name to include in error messages @@ -588,6 +736,8 @@ {-# INLINEABLE parseWithRead' #-} -- | Parse a value to a 'Maybe' type using the 'Read' instance +-- +-- @since 0.3.0.0 maybeParseWithRead :: (Read a, Textual t) => t -- ^ textual input to parse @@ -597,6 +747,8 @@ -- | Implement 'ReadS' using 'parseEnum' -- -- This implementation expects all of the input to be consumed. +-- +-- @since 0.1.0.0 readsEnum :: (Bounded a, Enum a, Render a) => Bool -- ^ case-insensitive when 'True' @@ -611,6 +763,8 @@ -- | Implement 'ReadS' using a 'Parse' instance -- -- This implementation expects all of the input to be consumed. +-- +-- @since 0.3.0.0 readsWithParse :: Parse a => ReadS a @@ -619,7 +773,26 @@ Nothing -> [] {-# INLINEABLE readsWithParse #-} +------------------------------------------------------------------------------ -- $ParseValid +-- +-- The follow functions provide a number of ways to use a 'Parse' instance to +-- validate constants at compile-time. +-- +-- If you can use Template Haskell typed expressions in your project, use +-- 'valid', 'mkValid', or 'validOf'. Use 'valid' to define constants for +-- types that have a 'THS.Lift' instance. For types that do not have a +-- 'THS.Lift' instance, use 'mkValid' to define a validation function for that +-- type using a 'Proxy', or use 'validOf' to pass the 'Proxy' when defining +-- constants. +-- +-- Typed expressions were not supported in @haskell-src-exts <1.22.0@, which +-- causes problems with old versions of @hlint@. If the issue affects you, +-- you may use 'mkUntypedValid', 'mkUntypedValidQQ', or 'untypedValidOf' +-- instead of the above functions. Use 'mkUntypedValid' to define a +-- validation function for a type using a 'Proxy', or use 'untypedValidOf' to +-- pass the 'Proxy' when defining constants. Alternatively, use +-- 'mkUntypedValidQQ' to define a validation quasi-quoter. -- | Validate a constant at compile-time using a 'Parse' instance -- @@ -628,20 +801,61 @@ -- a 'THS.Lift' instance. When this is inconvenient, use one of the -- alternative functions in this library. -- --- This function uses a typed expression. Typed expressions were not --- supported in @haskell-src-exts <1.22.0@, which caused problems with --- @hlint@. If the issue effects you, use @hlint -i "Parse error"@ to ignore --- parse errors or use one of the alternative functions in this library. +-- This function uses a Template Haskell typed expression. Typed expressions +-- were not supported in @haskell-src-exts <1.22.0@, which causes problems +-- with old versions of @hlint@. If the issue affects you, use +-- @hlint -i "Parse error"@ to ignore parse errors or use one of the +-- alternative functions in this library. -- --- See the @valid@, @invalid@, and @lift@ example programs in the @examples@ --- directory. +-- Note that the typed Template Haskell API changed in GHC 9. The type +-- displayed in this documentation is determined by the version of GHC used to +-- build the documentation. +-- +-- The type of this function in GHC 9 or later is as follows: +-- +-- @ +-- valid +-- :: (MonadFail m, THS.Quote m, Parse a, THS.Lift a) +-- => String +-- -> THS.Code m a +-- @ +-- +-- The type of this function in previous versions of GHC is as follows: +-- +-- @ +-- valid +-- :: (Parse a, THS.Lift a) +-- => String +-- -> TH.Q (TH.TExp a) +-- @ +-- +-- This function is used the same way in all GHC versions. See the @valid@, +-- @invalid@, and @lift@ example programs in the @examples@ directory. The +-- following is example usage from the @valid@ example: +-- +-- @ +-- sample :: Username +-- sample = $$(TTC.valid "tcard") +-- @ +-- +-- @since 0.1.0.0 +#if __GLASGOW_HASKELL__ >= 900 valid + :: (MonadFail m, THS.Quote m, Parse a, THS.Lift a) + => String + -> THS.Code m a +valid s = case parse s of + Right x -> [|| x ||] + Left err -> THS.Code . fail $ "Invalid constant: " ++ err +#else +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 +#endif -- | Validate a constant at compile-time using a 'Parse' instance -- @@ -653,13 +867,57 @@ -- run-time. Since the result is not compiled in, no 'THS.Lift' instance is -- required. -- --- This function uses a typed expression. Typed expressions were not --- supported in @haskell-src-exts <1.22.0@, which caused problems with --- @hlint@. If the issue effects you, use @hlint -i "Parse error"@ to ignore --- parse errors or use 'untypedValidOf' instead. +-- This function uses a Template Haskell typed expression. Typed expressions +-- were not supported in @haskell-src-exts <1.22.0@, which causes problems +-- with old versions of @hlint@. If the issue affects you, use +-- @hlint -i "Parse error"@ to ignore parse errors or use 'untypedValidOf' +-- instead. -- --- See the @validof@ example program in the @examples@ directory. +-- Note that the typed Template Haskell API changed in GHC 9. The type +-- displayed in this documentation is determined by the version of GHC used to +-- build the documentation. +-- +-- The type of this function in GHC 9 or later is as follows: +-- +-- @ +-- validOf +-- :: (MonadFail m, THS.Quote m, Parse a) +-- => Proxy a +-- -> String +-- -> THS.Code m a +-- @ +-- +-- The type of this function in previous versions of GHC is as follows: +-- +-- @ +-- validOf +-- :: Parse a +-- => Proxy a +-- -> String +-- -> TH.Q (TH.TExp a) +-- @ +-- +-- This function is used the same way in all GHC versions. See the @validof@ +-- example program in the @examples@ directory. The following is example +-- usage from the @validof@ example: +-- +-- @ +-- sample :: Username +-- sample = $$(TTC.validOf (Proxy :: Proxy Username) "tcard") +-- @ +-- +-- @since 0.1.0.0 +#if __GLASGOW_HASKELL__ >= 900 validOf + :: (MonadFail m, THS.Quote m, Parse a) + => Proxy a + -> String + -> THS.Code m a +validOf proxy s = case (`asProxyTypeOf` proxy) <$> parse s of + Right{} -> [|| parseUnsafeS s ||] + Left err -> THS.Code . fail $ "Invalid constant: " ++ err +#else +validOf :: Parse a => Proxy a -> String @@ -667,18 +925,57 @@ validOf proxy s = case (`asProxyTypeOf` proxy) <$> parse s of Right{} -> [|| parseUnsafeS s ||] Left err -> fail $ "Invalid constant: " ++ err +#endif -- | Make a @valid@ function using 'validOf' for the given type -- --- Create a @valid@ function in the module for a type in order to avoid having --- to write a 'Proxy' when defining constants. +-- Create a @valid@ function for a type in order to avoid having to write a +-- 'Proxy' when defining constants. -- --- This function uses a typed expression. Typed expressions were not --- supported in @haskell-src-exts <1.22.0@, which caused problems with --- @hlint@. If the issue effects you, use @hlint -i "Parse error"@ to ignore --- parse errors or use 'mkUntypedValidOf' instead. +-- This function uses a Template Haskell typed expression. Typed expressions +-- were not supported in @haskell-src-exts <1.22.0@, which causes problems +-- with old versions of @hlint@. If the issue affects you, use +-- @hlint -i "Parse error"@ to ignore parse errors or use 'mkUntypedValid' +-- instead. -- --- See the @mkvalid@ example program in the @examples@ directory. +-- Note that the typed Template Haskell API changed in GHC 9. The type +-- displayed in this documentation is determined by the version of GHC used to +-- build the documentation. +-- +-- The type of the created @valid@ function in GHC 9 or later is as follows: +-- +-- @ +-- \$funName +-- :: forall m. (MonadFail m, THS.Quote m) +-- => String +-- -> THS.Code m $resultType +-- @ +-- +-- The type of the created @valid@ function in previous versions of GHC is as +-- follows: +-- +-- @ +-- \$funName +-- :: String +-- -> TH.Q (TH.TExp $resultType) +-- @ +-- +-- This function is used the same way in all GHC versions. See the @mkvalid@ +-- example program in the @examples@ directory. The following is example +-- usage from the @mkvalid@ example: +-- +-- @ +-- \$(TTC.mkValid "valid" ''Username) +-- @ +-- +-- The created @valid@ function can then be used as follows: +-- +-- @ +-- sample :: Username +-- sample = $$(Username.valid "tcard") +-- @ +-- +-- @since 0.1.0.0 mkValid :: String -> TH.Name @@ -686,7 +983,15 @@ mkValid funName typeName = do let funName' = TH.mkName funName resultType = pure $ TH.ConT typeName +#if __GLASGOW_HASKELL__ >= 900 + funType <- + [t| + forall m . (MonadFail m, THS.Quote m) => + String -> THS.Code m $resultType + |] +#else funType <- [t| String -> TH.Q (TH.TExp $resultType) |] +#endif body <- [| validOf (Proxy :: Proxy $resultType) |] return [ TH.SigD funName' funType @@ -703,7 +1008,15 @@ -- run-time. Since the result is not compiled in, no 'THS.Lift' instance is -- required. -- --- See the @uvalidof@ example program in the @examples@ directory. +-- See the @uvalidof@ example program in the @examples@ directory. The +-- following is example usage from the @uvalidof@ example: +-- +-- @ +-- sample :: Username +-- sample = $(TTC.untypedValidOf (Proxy :: Proxy Username) "tcard") +-- @ +-- +-- @since 0.2.0.0 untypedValidOf :: Parse a => Proxy a @@ -715,10 +1028,24 @@ -- | Make a @valid@ function using 'untypedValidOf' for the given type -- --- Create a @valid@ function in the module for a type in order to avoid having --- to write a 'Proxy' when defining constants. +-- Create a @valid@ function for a type in order to avoid having to write a +-- 'Proxy' when defining constants. -- --- See the @mkuvalid@ example program in the @examples@ directory. +-- See the @mkuvalid@ example program in the @examples@ directory. The +-- following is example usage from the @mkuvalid@ example: +-- +-- @ +-- \$(TTC.mkUntypedValid "valid" ''Username) +-- @ +-- +-- The created @valid@ function can then be used as follows: +-- +-- @ +-- sample :: Username +-- sample = $(Username.valid "tcard") +-- @ +-- +-- @since 0.2.0.0 mkUntypedValid :: String -> TH.Name @@ -735,7 +1062,21 @@ -- | Make a @valid@ quasi-quoter using 'untypedValidOf' for the given type -- --- See the @uvalidqq@ example program in the @examples@ directory. +-- See the @uvalidqq@ example program in the @examples@ directory. The +-- following is example usage from the @uvalidqq@ example: +-- +-- @ +-- \$(TTC.mkUntypedValidQQ "valid" ''Username) +-- @ +-- +-- The created @valid@ function can then be used as follows: +-- +-- @ +-- sample :: Username +-- sample = [Username.valid|tcard|] +-- @ +-- +-- @since 0.2.0.0 mkUntypedValidQQ :: String -> TH.Name diff --git a/src/Data/TTC/Instances.hs b/src/Data/TTC/Instances.hs --- a/src/Data/TTC/Instances.hs +++ b/src/Data/TTC/Instances.hs @@ -2,7 +2,7 @@ -- | -- Module : Data.TTC.Instances -- Description : instances for basic data types --- Copyright : Copyright (c) 2019-2020 Travis Cardwell +-- Copyright : Copyright (c) 2019-2021 Travis Cardwell -- License : MIT -- -- This module defines TTC 'TTC.Render' and 'TTC.Parse' instances for some @@ -44,7 +44,7 @@ instance TTC.Parse Char where parse = TTC.asS $ \case [c] -> Right c - _ -> Left $ TTC.fromS "invalid Char" + _cs -> Left $ TTC.fromS "invalid Char" instance TTC.Render Char where render c = TTC.fromS [c] diff --git a/test/Data/TTC/Test.hs b/test/Data/TTC/Test.hs --- a/test/Data/TTC/Test.hs +++ b/test/Data/TTC/Test.hs @@ -123,6 +123,12 @@ answerBSL :: BSL.ByteString answerBSL = "42" +answerTLB :: TLB.Builder +answerTLB = "42" + +answerSBS :: SBS.ShortByteString +answerSBS = "42" + answerZ :: Int answerZ = 42 @@ -394,6 +400,16 @@ testRenderBSL :: TestTree testRenderBSL = testCase "renderBSL" $ answerBSL @=? TTC.renderBSL answer +testRenderTLB :: TestTree +testRenderTLB = testCase "renderTLB" $ answerTLB @=? TTC.renderTLB answer + +testRenderBSB :: TestTree +testRenderBSB = testCase "renderBSB" $ + answerBSL @=? BSB.toLazyByteString (TTC.renderBSB answer) + +testRenderSBS :: TestTree +testRenderSBS = testCase "renderSBS" $ answerSBS @=? TTC.renderSBS answer + testRenderWithShow :: TestTree testRenderWithShow = testGroup "renderWithShow" [ testCase "S" $ answerS @=? TTC.renderWithShow answerZ @@ -657,6 +673,9 @@ , testRenderTL , testRenderBS , testRenderBSL + , testRenderTLB + , testRenderBSB + , testRenderSBS , testRenderWithShow ] , testGroup "Parse" diff --git a/ttc.cabal b/ttc.cabal --- a/ttc.cabal +++ b/ttc.cabal @@ -1,5 +1,5 @@ name: ttc -version: 0.3.0.0 +version: 0.4.0.0 category: Data, Text synopsis: Textual Type Classes description: @@ -11,18 +11,19 @@ bug-reports: https://github.com/ExtremaIS/ttc-haskell/issues author: Travis Cardwell maintainer: Travis Cardwell -copyright: Copyright (c) 2019-2020 Travis Cardwell +copyright: Copyright (c) 2019-2021 Travis Cardwell license: MIT license-file: LICENSE -cabal-version: >=1.10 +cabal-version: 1.24 build-type: Simple tested-with: GHC ==8.2.2 || ==8.4.4 || ==8.6.5 || ==8.8.4 - || ==8.10.2 + || ==8.10.4 + || ==9.0.1 extra-source-files: CHANGELOG.md @@ -32,6 +33,10 @@ type: git location: https://github.com/ExtremaIS/ttc-haskell.git +flag write-hie + description: write .hie files + default: False + library hs-source-dirs: src exposed-modules: @@ -40,10 +45,15 @@ build-depends: base >=4.7 && <5 , bytestring >=0.10.8 && <0.12 - , template-haskell >=2.12 && <2.17 + , template-haskell >=2.12 && <2.18 , text >=1.2.3 && <1.3 default-language: Haskell2010 - ghc-options: -Wall + default-extensions: + OverloadedStrings + if flag(write-hie) + ghc-options: -Wall -fwrite-ide-info -hiedir=.hie + else + ghc-options: -Wall test-suite ttc-test type: exitcode-stdio-1.0