diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,3 @@ +0.2.0.1 +------- +* Turn examples into buildable tests, add readme, fix typos in documentation. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,29 @@ +validated-literals: Compile-time checking for partial smart-constructors +================================================================ +[![BSD3](https://img.shields.io/badge/License-BSD-blue.svg)](https://en.wikipedia.org/wiki/BSD_License) +[![Hackage](https://img.shields.io/hackage/v/validated-literals.svg)](https://hackage.haskell.org/package/validated-literals) +[![Build Status](https://travis-ci.org/merijn/validated-literals.svg)](https://travis-ci.org/merijn/validated-literals) + +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. diff --git a/ValidLiterals.hs b/ValidLiterals.hs --- a/ValidLiterals.hs +++ b/ValidLiterals.hs @@ -58,7 +58,7 @@ -- import ValidLiterals -- -- x :: ASCII --- x = $$(valid 'c') +-- x = $$(valid \'c\') -- @ valid :: Validate a b => a -> Q (TExp b) valid input = case fromLiteral input of diff --git a/ValidLiterals/Class.hs b/ValidLiterals/Class.hs --- a/ValidLiterals/Class.hs +++ b/ValidLiterals/Class.hs @@ -48,8 +48,8 @@ -- 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'. + -- @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 diff --git a/examples/ByteString.hs b/examples/ByteString.hs --- a/examples/ByteString.hs +++ b/examples/ByteString.hs @@ -5,7 +5,7 @@ import Data.ByteString.Char8 (ByteString, pack) import Data.Char -import ValidLiterals +import ValidLiterals.Class instance Validate String ByteString where fromLiteral s diff --git a/examples/Even.hs b/examples/Even.hs --- a/examples/Even.hs +++ b/examples/Even.hs @@ -1,11 +1,16 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TemplateHaskell #-} module Even where -import ValidLiterals +import Control.DeepSeq (NFData) +import GHC.Generics (Generic) +import ValidLiterals.Class -newtype Even = Even Integer +newtype Even = Even Integer deriving (Show, Generic) + +instance NFData Even instance Integral a => Validate a Even where fromLiteral i diff --git a/examples/Examples.hs b/examples/Examples.hs --- a/examples/Examples.hs +++ b/examples/Examples.hs @@ -1,12 +1,66 @@ {-# LANGUAGE TemplateHaskell #-} -module Examples where +module Main where +import Control.DeepSeq (NFData, force) +import Control.Exception + (SomeException(SomeException), bracket_, displayException, 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 + import ValidLiterals import Even import ByteString -x :: Even -x = $$(validInteger 38) +failingEven :: Q (TExp Even) +failingEven = validInteger 39 -b :: ByteString -b = $$(valid "HTTP/1.1 GET") +failingByteString :: Q (TExp ByteString) +failingByteString = valid "λ" + +evenVal :: Even +evenVal = $$(validInteger 38) + +bytestringVal :: ByteString +bytestringVal = $$(valid "HTTP/1.1 GET") + +checkExceptions :: NFData a => String -> a -> TestTree +checkExceptions name expr = testCase name $ do + result <- try . evaluate . force $ expr + case result of + Right _ -> return () + Left (SomeException e) -> assertFailure (displayException e) + +withRedirectedStderr :: IO a -> IO a +withRedirectedStderr act = withFile "/dev/null" WriteMode $ \nullHnd -> do + hFlush stderr + oldStderr <- hDuplicate stderr + bracket_ (hDuplicateTo nullHnd stderr) (hDuplicateTo oldStderr stderr) act + +checkTHFails :: String -> Q a -> TestTree +checkTHFails name thExpr = testCase name $ do + result <- try . withRedirectedStderr $ runQ thExpr + case result of + Right _ -> assertFailure "TH didn't fail!" + Left e | isUserError e -> return () + | otherwise -> assertFailure "Unexpected TH failure!" + +allTests :: TestTree +allTests = testGroup "Tests" + [ checkExceptions "Even" evenVal + , checkExceptions "ByteString" bytestringVal + , checkTHFails "Failing Even" $ failingEven + , checkTHFails "Failing ByteString" $ failingByteString + ] + +main :: IO () +main = travisTestReporter travisConfig [] allTests + where + travisConfig = defaultConfig + { travisFoldGroup = FoldMoreThan 1 + , travisSummaryWhen = SummaryAlways + } diff --git a/validated-literals.cabal b/validated-literals.cabal --- a/validated-literals.cabal +++ b/validated-literals.cabal @@ -1,12 +1,12 @@ Name: validated-literals -Version: 0.2.0 +Version: 0.2.0.1 Homepage: https://github.com/merijn/validated-literals Bug-Reports: https://github.com/merijn/validated-literals/issues Author: Merijn Verstraaten Maintainer: Merijn Verstraaten -Copyright: Copyright © 2015 Merijn Verstraaten +Copyright: Copyright © 2015-2018 Merijn Verstraaten License: BSD3 License-File: LICENSE @@ -14,7 +14,8 @@ Category: Data Cabal-Version: >= 1.10 Build-Type: Simple -Tested-With: GHC == 7.8.3 +Tested-With: GHC == 7.10.3, GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.3, + GHC == 8.6.1 Synopsis: Compile-time checking for partial smart-constructors @@ -44,10 +45,7 @@ This will check, at compile time, that the provided @Integer@ is, in fact, even and unwrap it from @Maybe@, avoiding the runtime check. -Extra-Source-Files: - examples/ByteString.hs - examples/Even.hs - examples/Examples.hs +Extra-Source-Files: README.md, CHANGELOG.md Library Default-Language: Haskell2010 @@ -61,9 +59,27 @@ ValidLiterals.Class Other-Modules: - Build-Depends: base >=4.8 && <4.9 + Build-Depends: base >=4.8 && <4.12 , template-haskell - , bytestring >=0.10 && <0.11 + +Test-Suite examples + Default-Language: Haskell2010 + Type: exitcode-stdio-1.0 + Main-Is: Examples.hs + Other-Modules: ByteString + Even + + GHC-Options: -Wall -fno-warn-unused-do-bind + Other-Extensions: TemplateHaskell + Hs-Source-Dirs: examples + Build-Depends: base + , bytestring == 0.10.* + , deepseq == 1.4.* + , tasty >= 0.11 && < 1.1 + , tasty-hunit == 0.9.* + , tasty-travis >= 0.2 && < 0.3 + , template-haskell + , validated-literals Source-Repository head Type: mercurial