diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2015, Julian K. Arni + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Julian K. Arni nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/examples/Tutorial.lhs b/examples/Tutorial.lhs new file mode 100644 --- /dev/null +++ b/examples/Tutorial.lhs @@ -0,0 +1,148 @@ +# Verdict + +*Very experimental!* + +~~~ {.haskell} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE OverloadedStrings #-} +import GHC.TypeLits +import Data.Proxy +import Data.Monoid +import qualified Data.Text as Text +import Verdict +~~~ + +## A very general smart constructor + +Sometimes you want to provide extra guarantees about a type that are best +expressed in terms of a smart constructor with an opaque type: + + +~~~ {.haskell} +newtype NonEmptyList' a = NonEmptyList' { getList :: [a] } +makeNonEmptyList :: [a] -> Maybe (NonEmptyList' a) +makeNonEmptyList x | null x = Nothing + | otherwise = Just (NonEmptyList' x) +~~~ + +Where the `NonEmptyList` constructor is not exported. + +This works, but it has quite a few downsides. You can no longer derive things +like `Read` and `FromJSON` without losing the invariants you set up. If you +have a `NonEmptyList` that is also of maximum length 100, you need to either +have a newtype to again wrap your `NonEmptyList`, or a newtype that expresses +both those constraints. Either way, all the functions you wrote for +`NonEmptyList`, and which ideally would work with `NonEmptyMax100List`, won't +do so (without some newtype unwrapping or coercing). + +Instead, with `verdict` you can do this: + +~~~ {.haskell} +type NonEmptyList a = Validated (Not (Length 0)) [a] +~~~ + +The smart constructor comes for free as `validate`. Specialized for clarity: + +~~~ {.haskell} +mkNonEmpty :: [a] -> Either ErrorTree (NonEmptyList a) +mkNonEmpty = validate +~~~ + +The `Read` instance also comes for free, and checks for validity: + +~~~ {.haskell} +testRead :: NonEmptyList Int +testRead = read "[]" +~~~ + +`testRead` will throw a descriptive error message. + +## With some of the power of refinement types + +Writing functions that express their precise assumptions can then be done with +`Implies`: + +~~~ {.haskell} +safeHead :: (c `Implies` (Not (Length 0))) => Validated c [a] -> a +safeHead = head . getVal +~~~ + +Now, if we have another type: + +~~~ {.haskell} +type ReasonableList a = Validated (MinLength 1 :&& MaxLength 100) [a] +~~~ + +Our function `safeHead` will typecheck when given either a `ReasonableList` or +a `NonEmptyList` (or anything else with constraints that imply the length is +not zero). + +The library provides some terms that can be used in the little constraint DSL. +Additionally, you may want to create your own. Doing so is as easy as declaring +an empty datatype, and a `HaskVerdict` instance for it. Let us for example +define a predicate `InCircle cx cy r`, which is true of a `Point` if the point +is inside a circle of radius `r` centered on coordinates `(cx, cy)`: + +~~~ {.haskell} +data InCircle centerX centerY radius +data Point = Point { x :: Integer, y :: Integer } deriving (Eq, Show) + +instance (KnownNat cx, KnownNat cy, KnownNat r) + => HaskVerdict (InCircle cx cy r) Point where + haskVerdict _ + = check (\p -> (x p - centerX) ^ 2 + (y p - centerY) ^ 2 < radius ^ 2) err + where centerX = natVal (Proxy :: Proxy cx) + centerY = natVal (Proxy :: Proxy cy) + radius = natVal (Proxy :: Proxy r) + err = "Point not inside circle: " <> (Text.pack $ show ((centerX, centerY), radius)) +~~~ + +Additionally, you may also want to declare type instances for `Implies'` which +describe what things imply or are implied by your new constraint. + +~~~ {.haskell} +type instance Implies' (InCircle cx cy r) (InCircle cx cy r') = r <= r' +~~~ + +## And opt-in validation capabilities + +Sometimes you may not want to or be able to change the types of records. You +can still validate them: + +~~~ {.haskell} +mkUpperRightQuad :: ApplicativeError ErrorTree m + => Integer -> Integer -> m Point +mkUpperRightQuad x' y' = Point <$> x' `checkWith` (Proxy :: Proxy (Minimum 0)) + <*> y' `checkWith` (Proxy :: Proxy (Minimum 0)) +~~~ + +If we instantiate `ApplicativeError` to a short-circuiting applicative (like +`Either`), only the first result will be returned. If we use something like +`Failure`, all of them will: + +~~~ {.haskell} +main :: IO () +main = do + print (mkUpperRightQuad 5 3 :: Either ErrorTree Point) + print (mkUpperRightQuad (-2) 1 :: Either ErrorTree Point) + print (mkUpperRightQuad (-2) (- 1) :: Either ErrorTree Point) + print (mkUpperRightQuad (-2) (- 1) :: Failure ErrorTree Point) + print (mkUpperRightQuad 0 (- 1) :: Either ErrorTree Point) + print testRead +~~~ + +The results: + + + Right (Point {x = 5, y = 3}) + Left (Leaf "Should be more than 0") + Left (Leaf "Should be more than 0") + Failure (And (Leaf "Should be more than 0") (Leaf "Should be more than 0")) + Left (Leaf "Should be more than 0") + tutorial: Leaf "this still needs to be figured out" diff --git a/src/Verdict.hs b/src/Verdict.hs new file mode 100644 --- /dev/null +++ b/src/Verdict.hs @@ -0,0 +1,40 @@ +module Verdict + ( + + -- * Essentials + Validated + , validate + , getVal + , unsafeCoerceVal + , check + , checkWith + , HaskVerdict(..) + , Implies + , Implies' + , KnownVal(..) + , (|.) + + -- * Verdict Terms + , (:&&) + , (:||) + , Not + , Minimum + , Maximum + , MaxLength + , MinLength + , Length + , MultipleOf + , HasElem + + -- * Errors + , ErrorTree + , ErrorTree'(..) + , Failure(..) + , ApplicativeError(..) + ) where + +import Verdict.Class +import Verdict.Failure +import Verdict.Logic +import Verdict.Types +import Verdict.Val diff --git a/src/Verdict/Class.hs b/src/Verdict/Class.hs new file mode 100644 --- /dev/null +++ b/src/Verdict/Class.hs @@ -0,0 +1,103 @@ +{-# LANGUAGE OverloadedStrings #-} +module Verdict.Class where + +import Control.Monad +import Data.Monoid +import Data.Proxy +import qualified Data.Text as Text +import GHC.TypeLits +import Verdict.Types + +------------------------------------------------------------------------------ +-- * HaskVerdict +------------------------------------------------------------------------------ +class HaskVerdict a b where + haskVerdict :: Proxy a -> b -> Maybe ErrorTree + + +------------------------------------------------------------------------------ +-- * Logical Base Terms +------------------------------------------------------------------------------ +instance (HaskVerdict a r, HaskVerdict b r) => HaskVerdict (a :&& b) r where + haskVerdict _ x = And <$> haskVerdict pa x <*> haskVerdict pb x + where pa = Proxy :: Proxy a + pb = Proxy :: Proxy b + +instance (HaskVerdict a r, HaskVerdict b r) => HaskVerdict (a :|| b) r where + haskVerdict _ x = Or <$> haskVerdict pa x <*> haskVerdict pb x + where pa = Proxy :: Proxy a + pb = Proxy :: Proxy b + +instance (HaskVerdict c a) => HaskVerdict (Not c) a where + haskVerdict _ x = case haskVerdict p x of + Just _ -> Nothing + Nothing -> Just (Leaf "this still needs to be figured out") + where p = Proxy :: Proxy c + +instance HaskVerdict 'True a where + haskVerdict _ _ = Nothing + +------------------------------------------------------------------------------ +-- * Datatype Representation Terms +------------------------------------------------------------------------------ + +{-instance ( G.Generic a ) => HaskVerdict (a :* b) r where-} + {-haskVerdict _ x = foldM (G.hcollapse . G.hap r $ G.from x)-} + {-where pa = Proxy :: Proxy a-} + {-pb = Proxy :: Proxy b-} + {-v1 = G.Fn $ \(G.I n) -> G.K (haskVerdict pa n)-} + {-v2 = G.Fn $ \(G.I n) -> G.K (haskVerdict pb n)-} + {-r = (v1 G.:* v2 G.:* G.Nil) G.:* G.Nil-} + +------------------------------------------------------------------------------ +-- * Other Base Terms +------------------------------------------------------------------------------ +instance HaskVerdict () a where + haskVerdict _ = const Nothing + +instance (Ord b, Show b, KnownVal a b) => HaskVerdict (Maximum a) b where + haskVerdict _ = check (<= p) ("Should be less than " <> showT p) + where p = knownVal (Proxy :: Proxy a) + +instance (Ord b, Show b, KnownVal a b) => HaskVerdict (Minimum a) b where + haskVerdict _ = check (>= p) ("Should be more than " <> showT p) + where p = knownVal (Proxy :: Proxy a) + +instance (Foldable f, Show (f b), KnownNat a) + => HaskVerdict (MaxLength a) (f b) where + haskVerdict _ = check ((<= p) . length) + ("Should be of length less than " <> showT p) + where p = fromInteger $ natVal (Proxy :: Proxy a) + +instance (Foldable f, Show (f b), KnownNat a) + => HaskVerdict (MinLength a) (f b) where + haskVerdict _ = check ((>= p) . length) + ("Should be of length more than " <> showT p) + where p = fromInteger $ knownVal (Proxy :: Proxy a) + +instance (Foldable t, KnownNat a) => HaskVerdict (Length a) (t b) where + haskVerdict _ = check ((== p) . length) ("Should be of length " <> showT p) + where p = fromInteger $ natVal (Proxy :: Proxy a) + +instance (Foldable t, Show b, Eq b, KnownVal a b) + => HaskVerdict (HasElem a) (t b) where + haskVerdict _ = check (elem p) ("Should contain " <> showT p) + where p = knownVal (Proxy :: Proxy a) + +instance (KnownNat n, Integral a) => HaskVerdict (MultipleOf n) a where + haskVerdict _ = check (\x -> (toInteger x `rem` p) == 0) ("Not a multiple of " <> showT p) + where p = natVal (Proxy :: Proxy n) + +showT :: Show a => a -> Text.Text +showT = Text.pack . show + +check :: (x -> Bool) -> err -> x -> Maybe (ErrorTree' err) +check pred' err x = guard (not $ pred' x) >> pure (Leaf err) + +------------------------------------------------------------------------------ +-- Known Val +class KnownVal a b | a -> b where + knownVal :: Proxy a -> b + +instance KnownNat n => KnownVal n Integer where + knownVal = natVal diff --git a/src/Verdict/Failure.hs b/src/Verdict/Failure.hs new file mode 100644 --- /dev/null +++ b/src/Verdict/Failure.hs @@ -0,0 +1,42 @@ +module Verdict.Failure + ( Failure(..) + , ApplicativeError(..) + ) where + +import Control.Exception (IOException, catch) +import qualified Control.Monad.Trans.Except as ExceptT +import Data.Monoid +import Data.Typeable (Typeable) +import GHC.Generics (Generic) + +data Failure e a = Failure e | Success a + deriving (Eq, Show, Functor, Generic, Typeable) + +class Applicative m => ApplicativeError e m | m -> e where + throwError :: e -> m a + catchError :: m a -> (e -> m a) -> m a + +instance Monoid e => Applicative (Failure e) where + pure = Success + Failure msgs <*> Failure msgs' = Failure (msgs <> msgs') + Success _ <*> Failure msgs' = Failure msgs' + Failure msgs' <*> Success _ = Failure msgs' + Success f <*> Success x = Success (f x) + +instance Monoid e => ApplicativeError e (Failure e) where + throwError = Failure + catchError (Failure e) f = f e + catchError s _ = s + +instance ApplicativeError e (Either e) where + throwError = Left + catchError (Left e) f = f e + catchError s _ = s + +instance ApplicativeError IOException IO where + throwError = ioError + catchError = catch + +instance Monad m => ApplicativeError e (ExceptT.ExceptT e m) where + throwError = ExceptT.throwE + catchError = ExceptT.catchE diff --git a/src/Verdict/Logic.hs b/src/Verdict/Logic.hs new file mode 100644 --- /dev/null +++ b/src/Verdict/Logic.hs @@ -0,0 +1,27 @@ +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE UndecidableInstances #-} +module Verdict.Logic where + +import GHC.Exts (Constraint) +import GHC.TypeLits +import Verdict.Types + + +type family Or (a :: Constraint) (b :: Constraint) :: Constraint where + Or () x = () + Or x () = () + +type family Implies (a :: k) (b :: k) :: Constraint where + Implies (a :&& b) c = (a `Implies` c) `Or` (b `Implies` c) + Implies a (b :|| c) = (a `Implies` b) `Or` (a `Implies` c) + Implies a (Not a) = ('True ~ 'False) + Implies (Not a) a = ('True ~ 'False) + Implies a (Not (Not a)) = () + Implies a 'True = () + Implies a b = Implies' a b + +type family Implies' a b :: Constraint +type instance Implies' (Length a) (MaxLength b) = a <= b +type instance Implies' (Length a) (MinLength b) = b <= b +type instance Implies' (MaxLength a) (MaxLength b) = a <= b +type instance Implies' (MinLength a) (MinLength b) = b <= a diff --git a/src/Verdict/Types.hs b/src/Verdict/Types.hs new file mode 100644 --- /dev/null +++ b/src/Verdict/Types.hs @@ -0,0 +1,51 @@ +{-# LANGUAGE DeriveFunctor #-} +module Verdict.Types where + +import qualified Data.Text as Text + +------------------------------------------------------------------------------ +-- * Logical Base Terms +------------------------------------------------------------------------------ +data a :&& b = a :&& b +infixr 3 :&& +data a :|| b = a :|| b +infixr 2 :|| +data Not a + +------------------------------------------------------------------------------ +-- * Datatype Representation Terms +------------------------------------------------------------------------------ + +data a :* b +infixr 5 :* + +------------------------------------------------------------------------------ +-- * Other Base Terms +------------------------------------------------------------------------------ + +data Minimum a +data Maximum a +data MaxLength a +data MinLength a +data Length a +data MultipleOf a + +data HasElem a + +------------------------------------------------------------------------------ +-- * Other Types +------------------------------------------------------------------------------ + +-- | Error representation +data ErrorTree' e + = Leaf e + | Or (ErrorTree' e) (ErrorTree' e) + | And (ErrorTree' e) (ErrorTree' e) + | Sum (ErrorTree' e) (ErrorTree' e) + deriving (Eq, Show, Functor) + +type ErrorTree = ErrorTree' Text.Text + +instance Monoid e => Monoid (ErrorTree' e) where + mempty = Leaf mempty + mappend = And diff --git a/src/Verdict/Val.hs b/src/Verdict/Val.hs new file mode 100644 --- /dev/null +++ b/src/Verdict/Val.hs @@ -0,0 +1,122 @@ +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE ScopedTypeVariables #-} +module Verdict.Val where + +import Control.Monad.Fix +import Control.Monad.Zip +import Data.Coerce (Coercible, coerce) +import Data.Foldable +import Data.Proxy +import Data.String (IsString (..)) +import Text.Read + +import Verdict.Class +import Verdict.Failure +import Verdict.Logic +import Verdict.Types + +------------------------------------------------------------------------------ +-- * Validated +------------------------------------------------------------------------------ +-- | A generalization of smart constructors with opaque types. +-- Construct a @Validated@ with 'validate'. +newtype Validated constraint a = Validated { getVal :: a } + deriving (Show, Eq, Ord) + +-- * Validated () + +-- @Validated ()@ is the same as 'Data.Functor.Identity'; we use the same +-- instances. +validateEmpty :: a -> Validated () a +validateEmpty = coerce + +instance Functor (Validated ()) where + fmap = coerce + +instance Applicative (Validated ()) where + pure = Validated + (<*>) = coerce + +instance Monad (Validated ()) where + return = Validated + m >>= k = k (getVal m) + +instance MonadFix (Validated ()) where + mfix f = Validated (fix (getVal . f)) + +instance MonadZip (Validated ()) where + mzipWith = coerce + munzip = coerce + +instance Monoid m => Monoid (Validated () m) where + mempty = Validated mempty + mappend a b = Validated $ mappend (getVal a) (getVal b) + +instance Foldable (Validated ()) where + foldMap = coerce + elem = (. getVal) #. (==) + foldl = coerce + foldl' = coerce + foldl1 _ = getVal + foldr f z (Validated x) = f x z + foldr' = foldr + foldr1 _ = getVal + length _ = 1 + maximum = getVal + minimum = getVal + null _ = False + product = getVal + sum = getVal + toList (Validated x) = [x] + +instance (HaskVerdict c v, Read v) => Read (Validated c v) where + readPrec = force . validate <$> readPrec + where force = either (error . show) id + +instance (HaskVerdict c v, IsString v) => IsString (Validated c v) where + fromString = force . validate . fromString + where force = either (error . show) id + + +-- | Constructs a @Validated c a@ from an @a@ if @a@ matches the constraints; +-- throws an error with a description of precise constraints not satisfied +-- otherwise. +validate :: forall c a m . (HaskVerdict c a, ApplicativeError ErrorTree m) + => a -> m (Validated c a) +validate a = case haskVerdict (Proxy :: Proxy c) a of + Nothing -> pure $ Validated a + Just err -> throwError err + +-- | Coerce a 'Validated' to another set of constraints. This is safe with +-- respect to memory corruption, but loses the guarantee that the values +-- satisfy the predicates. +unsafeCoerceVal :: Validated c a -> Validated c' a +unsafeCoerceVal = coerce + +protect :: ( ApplicativeError (String, ErrorTree) m + , HaskVerdict c a + ) => Proxy c -> String -> (a -> b) -> a -> m b +protect p name fn a = case haskVerdict p a of + Nothing -> pure $ fn a + Just e -> throwError (name, e) + +-- | Checks a non-'Validated' value against a set of constraints given by a +-- 'Proxy'. +checkWith :: forall m c a . (ApplicativeError ErrorTree m, HaskVerdict c a) + => a -> Proxy c -> m a +checkWith v _ = getVal <$> v' + where v' = validate v :: ApplicativeError ErrorTree m => m (Validated c a) + +-- | Function composition. Typechecks if the result of applying the first +-- function has a constraint that implies the constraint of the argument of the +-- second function. +(|.) :: (cb' `Implies` cb) + => (Validated cb b -> Validated cc c) + -> (Validated ca a -> Validated cb' b) + -> Validated ca a -> Validated cc c +f |. g = f . coerce . g +infixr 8 |. + +-- * Internal +(#.) :: Coercible b c => (b -> c) -> (a -> b) -> (a -> c) +(#.) _f = coerce diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-} diff --git a/test/VerdictSpec.hs b/test/VerdictSpec.hs new file mode 100644 --- /dev/null +++ b/test/VerdictSpec.hs @@ -0,0 +1,96 @@ +module VerdictSpec (spec) where + +import Data.Either +import Test.Hspec +import Verdict + +spec :: Spec +spec = describe "Verdict" $ do + maximumSpec + minimumSpec + maxLengthSpec + minLengthSpec + lengthSpec + multipleOfSpec + +maximumSpec :: Spec +maximumSpec = describe "Maximum" $ do + + it "rejects larger values" $ do + (validate 5 :: Either ErrorTree (Validated (Maximum 3) Integer)) + `shouldSatisfy` isLeft + + it "accepts smaller values" $ do + (validate 3 :: Either ErrorTree (Validated (Maximum 5) Integer)) + `shouldSatisfy` isRight + + it "accepts equal sized values" $ do + (validate 3 :: Either ErrorTree (Validated (Maximum 3) Integer)) + `shouldSatisfy` isRight + +minimumSpec :: Spec +minimumSpec = describe "Minimum" $ do + + it "rejects smaller values" $ do + (validate 3 :: Either ErrorTree (Validated (Minimum 5) Integer)) + `shouldSatisfy` isLeft + + it "accepts larger values" $ do + (validate 5 :: Either ErrorTree (Validated (Minimum 3) Integer)) + `shouldSatisfy` isRight + + it "accepts equal sized values" $ do + (validate 3 :: Either ErrorTree (Validated (Minimum 3) Integer)) + `shouldSatisfy` isRight + +maxLengthSpec :: Spec +maxLengthSpec = describe "MaxLength" $ do + + it "rejects longer values" $ do + (validate [(),()] :: Either ErrorTree (Validated (MaxLength 1) [()])) + `shouldSatisfy` isLeft + + it "accepts shorter values" $ do + (validate [()] :: Either ErrorTree (Validated (MaxLength 3) [()])) + `shouldSatisfy` isRight + + it "accepts equal sized values" $ do + (validate [()] :: Either ErrorTree (Validated (MaxLength 1) [()])) + `shouldSatisfy` isRight + +minLengthSpec :: Spec +minLengthSpec = describe "MinLength" $ do + + it "rejects shorter values" $ do + (validate [()] :: Either ErrorTree (Validated (MinLength 2) [()])) + `shouldSatisfy` isLeft + + it "accepts shorter values" $ do + (validate [(), ()] :: Either ErrorTree (Validated (MinLength 1) [()])) + `shouldSatisfy` isRight + + it "accepts equal sized values" $ do + (validate [()] :: Either ErrorTree (Validated (MinLength 1) [()])) + `shouldSatisfy` isRight + +lengthSpec :: Spec +lengthSpec = describe "Length" $ do + + it "rejects differing lengths" $ do + (validate [()] :: Either ErrorTree (Validated (Length 2) [()])) + `shouldSatisfy` isLeft + + it "accepts matching lengths" $ do + (validate [()] :: Either ErrorTree (Validated (Length 1) [()])) + `shouldSatisfy` isRight + +multipleOfSpec :: Spec +multipleOfSpec = describe "MultipleOf" $ do + + it "rejects non-multiples" $ do + (validate 5 :: Either ErrorTree (Validated (MultipleOf 2) Integer)) + `shouldSatisfy` isLeft + + it "accepts multiples" $ do + (validate 4 :: Either ErrorTree (Validated (MultipleOf 2) Integer)) + `shouldSatisfy` isRight diff --git a/verdict.cabal b/verdict.cabal new file mode 100644 --- /dev/null +++ b/verdict.cabal @@ -0,0 +1,72 @@ +name: verdict +version: 0.0.0.0 +synopsis: Validation framework +description: + DO NOT USE! Unstable, not thoroughly tested. +license: BSD3 +license-file: LICENSE +author: Julian K. Arni +maintainer: jkarni@gmail.com +copyright: (c) Julian K. Arni +build-type: Simple +cabal-version: >=1.10 + +library + exposed-modules: Verdict + other-modules: Verdict.Class + , Verdict.Failure + , Verdict.Types + , Verdict.Logic + , Verdict.Val + default-extensions: TypeOperators + , MultiParamTypeClasses + , DataKinds + , FunctionalDependencies + , PolyKinds + , ScopedTypeVariables + , FlexibleInstances + , FlexibleContexts + , TypeFamilies + , DeriveFunctor + , DeriveGeneric + , DeriveDataTypeable + build-depends: base >=4.7 && <4.9 + , mtl + , transformers + , text + hs-source-dirs: src + ghc-options: -Wall + default-language: Haskell2010 + +test-suite spec + type: exitcode-stdio-1.0 + ghc-options: -Wall + -fno-warn-unused-binds + -fno-warn-type-defaults + default-language: Haskell2010 + hs-source-dirs: test + main-is: Spec.hs + other-modules: VerdictSpec + default-extensions: DeriveFunctor + , TypeOperators + , MultiParamTypeClasses + , DataKinds + , FunctionalDependencies + , PolyKinds + , ScopedTypeVariables + , FlexibleInstances + , FlexibleContexts + , TypeFamilies + build-depends: base == 4.* + , verdict + , hspec == 2.* + +executable tutorial + main-is: Tutorial.lhs + ghc-options: -Wall -pgmL markdown-unlit + hs-source-dirs: examples + build-depends: base >=4.7 && <4.9 + , verdict + , text + , markdown-unlit + default-language: Haskell2010