validated-literals 0.2.0.1 → 0.3.0

raw patch · 7 files changed

+104/−110 lines, 7 filesdep ~basedep ~bytestringdep ~tastyPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base, bytestring, tasty, tasty-hunit, template-haskell

API changes (from Hackage documentation)

Files

• CHANGELOG.md +5/−0
• ValidLiterals.hs +58/−7
• ValidLiterals/Class.hs +0/−66
• examples/ByteString.hs +12/−5
• examples/Even.hs +8/−8
• examples/Examples.hs +2/−3
• validated-literals.cabal +19/−21

@@ -1,3 +1,8 @@+0.3.0+-----+* New implementation, forces use of Lift for the result, removes the unsafe+  typeclass functions, and adds the option to add a custom error message.+ 0.2.0.1 ------- * Turn examples into buildable tests, add readme, fix typos in documentation.

@@ -1,7 +1,7 @@ ------------------------------------------------------------------------------- -- | -- Module      :  ValidLiterals--- Copyright   :  (C) 2015 Merijn Verstraaten+-- Copyright   :  (C) 2015-2019 Merijn Verstraaten -- License     :  BSD-style (see the file LICENSE) -- Maintainer  :  Merijn Verstraaten <merijn@inconsistent.nl> -- Stability   :  experimental@@ -32,26 +32,74 @@ -- 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 (fromLiteral)+    ( Validate(..)+    , ValidationFailure(..)     , valid     , validInteger     , validRational     , validString     , validList+    -- * Re-export from "Language.Haskell.TH.Syntax"+    , Lift(..)     ) where +import Control.Exception (Exception(displayException), throwIO)+import Data.Maybe (maybe)+import Data.Proxy (Proxy(Proxy))+import Data.Typeable (Typeable) import Language.Haskell.TH.Syntax -import ValidLiterals.Class+-- | '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 -> Q (TExp b)+    default liftResult :: Lift b => Proxy a -> b -> Q (TExp 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 #-} --@@ -60,10 +108,13 @@ -- x :: ASCII -- x = $$(valid \'c\') -- @-valid :: Validate a b => a -> Q (TExp b)-valid input = case fromLiteral input of-    Nothing -> fail "Invalid input used for type-safe validated literal!"-    Just result -> spliceValid input result+valid :: forall a b . Validate a b => a -> Q (TExp b)+valid input = case fromLiteralWithError input of+    Right result -> liftResult (Proxy :: Proxy a) result+    Left err -> 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

@@ -1,66 +0,0 @@----------------------------------------------------------------------------------- |--- Module      :  ValidLiterals--- Copyright   :  (C) 2015 Merijn Verstraaten--- License     :  BSD-style (see the file LICENSE)--- Maintainer  :  Merijn Verstraaten <merijn@inconsistent.nl>--- Stability   :  experimental--- Portability :  portable------ __WARNING: For implementors of new 'Validate' instances only!__------ This module exposes functions whose use is easily screwed up. Users of--- validated literals should use the interface exported by "ValidLiterals".--- This module only exists for implementers of new 'Validate' instances.---------------------------------------------------------------------------------{-# LANGUAGE DefaultSignatures #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE TemplateHaskell #-}-module ValidLiterals.Class where--import Data.Maybe-import Language.Haskell.TH-import Language.Haskell.TH.Syntax---- | Class for validated, compile-time, partial conversions from type 'a' to--- 'b'.-class Validate a b where-    -- | Converts 'a' values into validated 'b' values-    fromLiteral :: a -> Maybe b--    -- | __WARNING: Don't use! For implementors of 'Validate' instances only!__-    ---    -- Produces the actual Typed Template Haskell splice for the validated-    -- value to splice into the source text. Since you may want to implement a-    -- 'Validate' instance for types that cannot have 'Lift' instances, this-    -- function receives __both__ the original 'a' value and the resulting 'b'-    -- as input.-    ---    -- This allows it to either:-    ---    --      1. Splice the resulting 'b' into the source using it's Lift-    --      instance, or a custom splice.-    --      2. Splice the initial 'a' into the source using it's Lift instance,-    --      and perform the conversion again at runtime, and coercing via,-    --      e.g., 'fromJust'. Since 'fromLiteral' is pure (right?!) this should-    --      be perfectly safe.-    ---    -- Clearly, splicing the result directly is much safer (it avoids any-    -- shenanigans with 'unsafePerformIO') and more efficient (no conversion at-    -- runtime). However, this is just not always possible, since, for example,-    -- @ByteString@ does not have a 'Lift' instance and we may still want to-    -- have validated newtypes of @ByteString@.-    ---    -- __Default implementation:__ The default implementation (using-    -- DefaultSignatures) uses 'b''s 'Lift' instance to do the efficient thing-    -- of directly splicing the resulting 'b' into the source.-    spliceValid :: a -> b -> Q (TExp b)-    default spliceValid :: Lift b => a -> b -> Q (TExp b)-    spliceValid _ v = [|| v ||]---- | Default implementation for 'spliceValid', uses the 'Lift' instance for 'a'--- and 'fromJust' to redo the conversion at runtime and (unsafely) coerce from--- 'Maybe b' to 'b'. . Since 'fromLiteral' is pure (right?!) this should be--- perfectly safe.-hackySpliceValid :: (Lift a, Validate a b) => a -> b -> Q (TExp b)-hackySpliceValid v _ = [|| fromJust (fromLiteral v) ||]

@@ -1,15 +1,22 @@+{-# OPTIONS_GHC -fno-warn-orphans #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TemplateHaskell #-} module ByteString (ByteString) where  import Data.ByteString.Char8 (ByteString, pack)+import qualified Data.ByteString as BS import Data.Char+import Language.Haskell.TH.Syntax -import ValidLiterals.Class+import ValidLiterals  instance Validate String ByteString where-    fromLiteral s-        | all ((<=255) . ord) s = Just $ pack s-        | otherwise = Nothing+    fromLiteralWithError s = case nonAsciiVals of+        [] -> Right $ pack s+        _ -> Left $ "Found non-ASCII values: " ++ show nonAsciiVals+      where+        nonAsciiVals = filter (not . (<=255) . ord) s -    spliceValid = hackySpliceValid+    liftResult _ v = unsafeTExpCoerce $+        AppE <$> [| BS.pack |] <*> lift (BS.unpack v)

@@ -1,20 +1,20 @@ {-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveLift #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE TemplateHaskell #-} module Even where  import Control.DeepSeq (NFData) import GHC.Generics (Generic)-import ValidLiterals.Class+import ValidLiterals -newtype Even = Even Integer deriving (Show, Generic)+newtype Even = Even Integer deriving (Show, Generic, Lift)  instance NFData Even  instance Integral a => Validate a Even where-    fromLiteral i-        | even i = Just . Even $ fromIntegral i-        | otherwise = Nothing--    spliceValid _ (Even i) = [|| Even i ||]+    fromLiteralWithError i+      | even i = Right . Even $ integer+      | otherwise = Left $ show integer ++ " is not even!"+      where+        integer = fromIntegral i

@@ -3,11 +3,10 @@  import Control.DeepSeq (NFData, force) import Control.Exception-    (SomeException(SomeException), bracket_, displayException, evaluate, try)+    (Exception(..), SomeException(..), bracket_, evaluate, try) import GHC.IO.Handle (hDuplicate, hDuplicateTo) import Language.Haskell.TH (Q, TExp, runQ) import System.IO (IOMode(WriteMode), stderr, hFlush, withFile)-import System.IO.Error (isUserError) import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit (assertFailure, testCase) import Test.Tasty.Travis@@ -46,7 +45,7 @@     result <- try . withRedirectedStderr $ runQ thExpr     case result of         Right _ -> assertFailure "TH didn't fail!"-        Left e | isUserError e -> return ()+        Left e | Just ValidationFailure{} <- fromException e -> return ()                | otherwise -> assertFailure "Unexpected TH failure!"  allTests :: TestTree

@@ -1,21 +1,20 @@-Name:                validated-literals-Version:             0.2.0.1+Name:               validated-literals+Version:            0.3.0 -Homepage:            https://github.com/merijn/validated-literals-Bug-Reports:         https://github.com/merijn/validated-literals/issues+Homepage:           https://github.com/merijn/validated-literals+Bug-Reports:        https://github.com/merijn/validated-literals/issues -Author:              Merijn Verstraaten-Maintainer:          Merijn Verstraaten <merijn@inconsistent.nl>-Copyright:           Copyright © 2015-2018 Merijn Verstraaten+Author:             Merijn Verstraaten+Maintainer:         Merijn Verstraaten <merijn@inconsistent.nl>+Copyright:          Copyright © 2015-2018 Merijn Verstraaten -License:             BSD3-License-File:        LICENSE+License:            BSD3+License-File:       LICENSE -Category:            Data-Cabal-Version:       >= 1.10-Build-Type:          Simple-Tested-With:         GHC == 7.10.3, GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.3,-                     GHC == 8.6.1+Category:           Data+Cabal-Version:      >= 1.10+Build-Type:         Simple+Tested-With:        GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.3  Synopsis:            Compile-time checking for partial smart-constructors @@ -51,15 +50,13 @@   Default-Language:     Haskell2010   GHC-Options:          -Wall -  Default-Extensions:      Other-Extensions:     DefaultSignatures, FlexibleContexts,-                        MultiParamTypeClasses, TemplateHaskell+                        MultiParamTypeClasses, ScopedTypeVariables,+                        TemplateHaskell    Exposed-Modules:      ValidLiterals-                        ValidLiterals.Class-  Other-Modules:         -  Build-Depends:        base >=4.8 && <4.12+  Build-Depends:        base >= 4.9 && < 4.13                ,        template-haskell  Test-Suite examples@@ -70,12 +67,13 @@                         Even    GHC-Options:          -Wall -fno-warn-unused-do-bind-  Other-Extensions:     TemplateHaskell+  Other-Extensions:     DeriveGeneric, DeriveLift, FlexibleInstances,+                        MultiParamTypeClasses, TemplateHaskell   Hs-Source-Dirs:       examples   Build-Depends:        base                ,        bytestring == 0.10.*                ,        deepseq == 1.4.*-               ,        tasty >= 0.11 && < 1.1+               ,        tasty >= 0.11 && < 1.2                ,        tasty-hunit == 0.9.*                ,        tasty-travis >= 0.2 && < 0.3                ,        template-haskell