-------------------------------------------------------------------------------
-- |
-- Module : ValidLiterals
-- Copyright : (C) 2015-2021 Merijn Verstraaten
-- License : BSD-style (see the file LICENSE)
-- Maintainer : Merijn Verstraaten <merijn@inconsistent.nl>
-- Stability : experimental
-- Portability : portable
--
-- To disallow invalid input it is common to define (new)types with hidden
-- data constructors. Forcing the user to go through a smart-constructor that
-- enforces invariants and returns @Maybe ResultType@, preventing the
-- construction of data with invalid values.
--
-- However, it is __also__ common to want to include literal values of such
-- types in source text. Things of textual literals for HTML, HTTP, etc.
-- In such cases smart-constructors force us to handle potential conversion
-- failures at runtime, or abusing functions like @fromJust@ to break away all
-- the safety smart-constructors provide. All this despite the fact that we
-- can statically know at compile time that the conversion will always succeed
-- or always fails.
--
-- This package provides a typeclasses for using TH to validate the
-- correctness of provided literals at compile. This lets you define, e.g.,
-- @newtype Even = Even Integer@ and write:
--
-- @
-- x :: Even
-- x = $$(valid 38)
-- @
--
-- This will check, at compile time, that the provided 'Integer' is, in fact,
-- even and unwrap it from 'Maybe', avoiding the runtime check.
-------------------------------------------------------------------------------
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
module ValidLiterals
( Validate(..)
, ValidationFailure(..)
, valid
, validInteger
, validRational
, validString
, validList
-- * Re-export from "Language.Haskell.TH.Syntax"
, Lift(..)
) where
import Control.Exception (Exception(displayException), throwIO)
import Data.Proxy (Proxy(Proxy))
import Data.Typeable (Typeable)
import Language.Haskell.TH.Syntax
import Language.Haskell.TH.Syntax.Compat (Splice, liftSplice)
-- | 'Exception' type for failed conversions. Useful for testing and more
-- gracefully handling compile time failures.
data ValidationFailure = ValidationFailure String deriving (Show, Typeable)
instance Exception ValidationFailure where
displayException (ValidationFailure s) = "Validation failure: " ++ s
-- | Class for validated, compile-time, partial conversions from type 'a' to
-- 'b'.
class Validate a b where
-- | Converts 'a' values into validated 'b' values, 'Left' values are
-- reported in the compilation error.
fromLiteralWithError :: a -> Either String b
fromLiteralWithError = maybe (Left errMsg) Right . fromLiteral
where
errMsg = "An error occured during compile-time validation!"
-- | Converts 'a' values into validated 'b' values, 'Nothing' values
-- produce a generic error message. Use 'fromLiteralWithError' for custom
-- error messages.
fromLiteral :: a -> Maybe b
fromLiteral = either (const Nothing) Just . fromLiteralWithError
{-# MINIMAL fromLiteralWithError | fromLiteral #-}
-- | Creates a Typed TH splice for the resulting 'b' values, useful for
-- avoiding the need for orphan 'Lift' instances and allowing complex
-- splices for types that can't be directly lifted. See the 'ByteString'
-- example module for an example.
liftResult :: Proxy a -> b -> Splice Q b
default liftResult :: Lift b => Proxy a -> b -> Splice Q b
liftResult _ val = [|| val ||]
-- | The core function of ValidLiterals, use this together with Typed Template
-- Haskell splices to insert validated literals into your code. For example, if
-- we assume @newtype ASCII = ASCII Char@ where @ASCII@ should only contain
-- ASCII characters, we would write:
--
-- Polymorphic literals, such as numbers (or strings when @OverloadedStrings@
-- is enabled) can result in ambiguous type errors with this function. Enabing
-- the @ExtendedDefaultRules@ extension will allow inputs to 'valid' to be
-- defaulted to 'Integer' or 'Double' allowing code to compile. A more robust
-- solution is to use the various explicitly defaulted functions in this
-- module, such as 'validInteger'.
--
-- @
-- {-\# LANGUAGE TemplateHaskell #-}
--
-- import ValidLiterals
--
-- x :: ASCII
-- x = $$(valid \'c\')
-- @
valid :: forall a b . Validate a b => a -> Splice Q b
valid input = case fromLiteralWithError input of
Right result -> liftResult (Proxy :: Proxy a) result
Left err -> liftSplice $ do
reportError $ unlines
[ "Invalid input used for type-safe validated literal!", err ]
runIO $ throwIO (ValidationFailure err)
-- | Integer literals lead to obnoxious defaulting complaints by GHC, by
-- using this function you can force the defaulting to 'Integer', silencing
-- these warnings.
--
-- Since 'Integral' literals use @fromInteger :: Num a => Integer -> a@ this
-- function cannot cost you any precision.
validInteger :: Validate Integer b => Integer -> Splice Q b
validInteger = valid
-- | Same as 'validInteger', but for 'Fractional' values.
--
-- Since 'Fractional' literals use
-- @fromRational :: Fractional a => Rational -> a@ this function cannot cost
-- you any precision.
validRational :: Validate Rational b => Rational -> Splice Q b
validRational = valid
-- | Same as 'validInteger', but for when enabling @OverloadedStrings@ makes
-- 'String' literals polymorphic.
validString :: Validate String b => String -> Splice Q b
validString = valid
-- | Same as 'validInteger', but for when enabling @OverloadedLists@ makes list
-- literals polymorphic.
validList :: Validate [a] b => [a] -> Splice Q b
validList = valid