diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,31 @@ +Copyright (c) 2009, Jinjing Wang + +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 Jinjing Wang 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/Nemesis b/Nemesis new file mode 100644 --- /dev/null +++ b/Nemesis @@ -0,0 +1,27 @@ +nemesis = do + + clean + [ "**/*.hi" + , "**/*.o" + , "manifest" + ] + + desc "prepare cabal dist" + task "dist" $ do + sh "cabal clean" + sh "cabal configure" + sh "cabal sdist" + + desc "start console" + task "i" (sh "ghci -isrc -Wall src/Network/Spata.hs") + + desc "run test" + task "test" (sh "runghc -isrc src/test.hs") + + desc "put all .hs files in manifest" + task "manifest" $ do + sh "find . | grep 'hs$' > manifest" + + desc "show sloc" + task "stat" $ do + sh "cloc -match-f=hs$ --quiet src --no3" diff --git a/Setup.lhs b/Setup.lhs new file mode 100644 --- /dev/null +++ b/Setup.lhs @@ -0,0 +1,4 @@ +#! /usr/bin/env runhaskell + +> import Distribution.Simple +> main = defaultMain diff --git a/changelog.md b/changelog.md new file mode 100644 --- /dev/null +++ b/changelog.md @@ -0,0 +1,4 @@ +2009.9.18 +--------- + +Init diff --git a/known-issues.md b/known-issues.md new file mode 100644 --- /dev/null +++ b/known-issues.md diff --git a/readme.md b/readme.md new file mode 100644 --- /dev/null +++ b/readme.md @@ -0,0 +1,25 @@ +Spata +===== + +bruteforce form validation + +Demo +==== + +put following in `test.hs` + + import Network.Spata + import MPS.Env + import Prelude () + + inputs = [("a", "1"), ("b", "2"), ("c", "")] + + main = print - guard inputs - do + validate inclusion_of ["a", "b", "c"] + validate presence_of ["c"] + + +`runghc test.hs` should output + + Left "c can not be empty" + diff --git a/spata.cabal b/spata.cabal new file mode 100644 --- /dev/null +++ b/spata.cabal @@ -0,0 +1,26 @@ +Name: spata +Version: 2009.9.18 +Build-type: Simple +Synopsis: bruteforce form validation +Description: + + who needs a brain when it can be solved with fists + +License: BSD3 +License-file: LICENSE +Author: Wang, Jinjing +Maintainer: Wang, Jinjing +Build-Depends: base +Cabal-version: >= 1.2 +category: Web +homepage: http://github.com/nfjinjing/spata/tree/master +data-files: readme.md, changelog.md, known-issues.md, Nemesis, src/test.hs + +library + ghc-options: -Wall + build-depends: base >= 4 && < 5, mps, mtl, dlist + hs-source-dirs: src/ + exposed-modules: + Network.Spata + Network.Spata.Type + Network.Spata.DSL diff --git a/src/Network/Spata.hs b/src/Network/Spata.hs new file mode 100644 --- /dev/null +++ b/src/Network/Spata.hs @@ -0,0 +1,6 @@ +module Network.Spata +( + module Network.Spata.DSL +) where + +import Network.Spata.DSL diff --git a/src/Network/Spata/DSL.hs b/src/Network/Spata/DSL.hs new file mode 100644 --- /dev/null +++ b/src/Network/Spata/DSL.hs @@ -0,0 +1,41 @@ +module Network.Spata.DSL where + +import Data.DList (singleton, toList, fromList) +import Control.Monad.Writer +import MPS.Env +import Prelude () +import Data.Maybe +import Network.Spata.Type +import Control.Monad.Error +import MPS (empty) + +guard :: Assoc -> Guardians -> Either String Assoc +guard xs m = execWriter m .toList .inject (Right xs) (>>=) + +validate :: Guard -> [String]-> Guardians +validate f xs = + tell - fromList - xs.map f + +train :: Task -> Guardians +train f = tell - singleton f + +inclusion_of :: Guard +inclusion_of = p (const True) "" + +presence_of :: Guard +presence_of = p (empty > not) "should not be empty" + +length_of :: (Integer -> Bool) -> Guard +length_of f = p (length > from_i > f) "should satisfy length properties" + +p = predicate + +predicate, p :: (String -> Bool) -> String -> Guard +predicate f s x xs = + case xs.lookup x of + Nothing -> Left - x ++ " should exist" + Just y -> + if f y + then Right xs + else Left - x ++ " " ++ s + diff --git a/src/Network/Spata/Type.hs b/src/Network/Spata/Type.hs new file mode 100644 --- /dev/null +++ b/src/Network/Spata/Type.hs @@ -0,0 +1,13 @@ +module Network.Spata.Type where + +import Data.DList (DList) +import Control.Monad.Writer + +type Assoc = [(String, String)] +type Guard = String -> Assoc -> Either String Assoc +type Guards = [String] -> Assoc -> Either String Assoc +type Task = Assoc -> Either String Assoc + +type GuardiansT a = Writer (DList Task) a +type Guardians = GuardiansT () + diff --git a/src/test.hs b/src/test.hs new file mode 100644 --- /dev/null +++ b/src/test.hs @@ -0,0 +1,9 @@ +import Network.Spata +import MPS.Env +import Prelude () + +inputs = [("a", "1"), ("b", "2"), ("c", "")] + +main = print - guard inputs - do + validate inclusion_of ["a", "b", "c"] + validate presence_of ["c"]