Checked (empty) → 0.0.0.1

raw patch · 3 files changed

+188/−0 lines, 3 filesdep +basedep +textsetup-changed

Dependencies added: base, text

Files

• Checked.cabal +21/−0
• Data/Checked.hs +165/−0
• Setup.hs +2/−0

@@ -0,0 +1,21 @@+-- Initial checked.cabal generated by cabal init.  For further 
+-- documentation, see http://haskell.org/cabal/users-guide/
+
+name:                Checked
+version:             0.0.0.1
+synopsis:            Inbuilt checking for ultra reliable computing
+-- description:         
+license:             BSD3
+--license-file:      BSD3
+author:              Robert Onslow
+maintainer:          ronslow@xlegal.co.uk
+-- copyright:           
+category:            Data
+build-type:          Simple
+cabal-version:       >=1.8
+
+library
+  exposed-modules:   Data.Checked
+  -- other-modules:       
+  build-depends:       base ==4.5.*,
+                       text >=0.11.2.0

@@ -0,0 +1,165 @@+{-# LANGUAGE ExistentialQuantification, TypeSynonymInstances, FlexibleInstances #-} 
+
+{-| A checked value is a value, potentially wrapped in a warning, i.e. a non-fatal exception.
+
+Where the checked value looks like (Right value), the value is within limits
+Where the checked value looks like (Left (warning, cause, value)), the value is out of limits
+
+Warning is (\"warning message\", severity), and cause is also a (Left (warning, cause value)) which allows a \"linked list\" of warnings to be set up
+
+Run your code within a 'Checked' monad to benefit from real time checking
+
+To retrofit checking to an existing function myFunc :: MyType1 -> MyType2 -> MyType3:
+
+(a) define a type which is a tuple of the parameters to myFunc
+   
+@
+    type  MyFuncParams = (MyType1, MyType2)
+@
+
+(b) define the test for validity of the parameters expected by myFunc:
+
+@
+     instance Checkable MyFuncParams where
+       check params = .. Checked (Right params) -- if OK
+                      .. Checked (Left (pack \"Invalid params to myFunc\", 20), Nothing, params) -- if params are out of whack
+@
+
+(c) define the test for validity of the output type, or any type in your code:
+
+@
+     instance 'Checkable' MyType3 where
+       check v = .. Checked (Right v) -- if OK
+                 .. Checked (Left (pack \"Type MyType3 is out of range\", 20), Nothing, v) -- if the value is out of whack for this type
+@
+ 
+(d) define a wrapper function for myFunction for myFunc which accepts a parameter of type MyFuncParams:
+
+@
+     myFunc\' :: MyFuncParams -> MyType3
+     myFunc\' (a, b) = myFunc a b
+ \* Looking to automate this step, perhaps with TH \*
+@
+
+(e) run your function within the 'Checked' monad, using 'applyWithParamsCheck' as the function calls, and 'check' to check the output values
+
+@
+ code :: MyType1 -> MyType2 -> Checked MyType4
+ code a b = do
+     f <- applyWithCheckedParams myFunc\' (a, b)
+     g <- check y
+     h <- applyWithCheckedParams myFunc1\' g
+     check h
+@
+-}
+module Data.Checked
+
+where
+
+import Data.Text
+import Control.Applicative
+import Control.Monad
+
+-- |A warning that the value is not within limits, with a measurable indication of severity
+type Warning = (Text, Integer)
+
+-- |A wrapper type indicating that the value is or is not within limits
+data Checked a =  forall b. Checked (Either (Warning, Maybe (Checked b), a) a)
+
+-- |Useful function
+getCheckedValue :: Checked a -> a
+getCheckedValue (Checked (Left (_, _, v))) = v
+getCheckedValue (Checked (Right v)) = v
+
+-- |This is implemented for types whose values will be checked
+class (Checkable a) where
+  check :: a -> Checked a
+
+-- |for debugging
+
+instance (Show a) => Show (Checked a) where
+ show (Checked (Right v)) = show v
+ show (Checked (Left ((t, s), Nothing, v))) = unpack t ++ show s ++ show v
+ show (Checked (Left ((t, s), Just ch, v))) = unpack t ++ show s ++ show v ++ "together with: " ++ showChecked ch
+      where
+        showChecked :: Checked b -> String
+        showChecked (Checked (Left ((t', s'), Nothing, v'))) = unpack t' ++ show s'
+        showChecked (Checked (Left (w, Just ch', v'))) = (showChecked (Checked (Left (w, Nothing, v')))) ++ showChecked ch'
+
+-- |The function is simply applied to the value within the checked wrapper
+instance Functor Checked where
+ fmap f (Checked (Right v)) = Checked (Right (f v))
+ fmap f (Checked (Left ((t, s), mb, v))) = Checked (Left ((t, s), mb, f v))
+
+-- |Checked values combine as you would expect, except that two Left values combine to set up a trace of warnings
+instance Applicative Checked where
+ pure v = Checked (Right v)
+ (Checked (Right f)) <*> (Checked (Right v)) = Checked (Right (f v))
+ (Checked (Right f)) <*> (Checked (Left ((t, s), mb, v))) = Checked (Left ((t, s), Just (Checked (Left ((t, s), mb, v))), f v))
+ (Checked (Left ((t, s), mb, f))) <*> (Checked (Right v)) = Checked (Left ((t, s), mb, f v))
+ (Checked (Left ((t, s), mb, f))) <*> (Checked (Left ((t', s'), mb', v'))) = Checked (Left ((t, s), Just (Checked (Left ((t', s'), mb', v'))), f v'))
+          
+-- |The monadic values also combine like the Applicative
+instance Monad Checked where
+ Checked (Right v) >>= k = k v
+ Checked (Left (w, mb, v)) >>= k = pure id <$> Checked (Left (w, mb, v)) <*> k v
+ return v = Checked (Right v) 
+
+
+-- |This is needed because we need to select the correct check function for the parameters to this function
+-- We do this by capturing the parameters as a single type, for which we have defined a checkable instance
+ 
+applyWithParamsCheck :: Checkable a => (a -> b) -> a -> Checked b
+applyWithParamsCheck f params = fmap f (check params)
+
+
+
+
+--now some testing
+-- a type whose values should normally be less than 100
+data UnderOneHundred a = UnderOneHundred a deriving (Show, Eq, Ord)
+
+--an existing function which we are going to retrofit into checked
+sumTest :: UnderOneHundred Integer -> UnderOneHundred Integer -> UnderOneHundred Integer
+sumTest (UnderOneHundred i) (UnderOneHundred j) = UnderOneHundred $ i + j
+
+--make the UnderOneHundred type checkable
+-- if the value is out of whack, signal with a severity rating of 50
+instance (Num a, Eq a, Ord a) => Checkable (UnderOneHundred a) where
+ check (UnderOneHundred i) = if (i < 100)
+  then Checked (Right (UnderOneHundred i))
+  else Checked (Left ((pack "Value exceeds expected limit", 50), Nothing, (UnderOneHundred i))) 
+
+--define a type representing a tuple of parameter types into sumTest
+type SumTestFuncParams =  (UnderOneHundred Integer, UnderOneHundred Integer)
+
+-- a wrapper function for the function to be retrofitted
+sumTest' :: SumTestFuncParams -> UnderOneHundred Integer
+sumTest' (a, b) = sumTest a b
+
+--then make the parameters expected by this particular function checkable
+-- in this case, the first parameter should not exceed the second parameter
+-- if the parameters are out of whack, signal with a severity rating of 20
+
+instance Checkable SumTestFuncParams where
+ check (j, k) = if (j < k)
+                               then Checked (Right ((j, k) :: SumTestFuncParams))
+                               else Checked (Left ((pack "first param exceeds the second param", 20), Nothing, (j, k) :: SumTestFuncParams))
+                               
+
+           
+--monadic use of the checker 
+
+test :: UnderOneHundred Integer -> UnderOneHundred Integer -> Checked (UnderOneHundred Integer)
+test a b = do
+-- call sumTest while checking the validity of the parameters
+ y <- applyWithParamsCheck sumTest' (a, b)
+-- check the output of sumTest'
+ check y
+-- or e.g. z <- check y
+-- applyWithParamsCheck nextFunc' z
+-- etc. etc.
+  
+
+
+

@@ -0,0 +1,2 @@+import Distribution.Simple
+main = defaultMain