diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c)2011, James Deng + +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 James Deng 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/ivy-web.cabal b/ivy-web.cabal new file mode 100644 --- /dev/null +++ b/ivy-web.cabal @@ -0,0 +1,75 @@ +-- ivy-route.cabal auto-generated by cabal init. For additional +-- options, see +-- http://www.haskell.org/cabal/release/cabal-latest/doc/users-guide/authors.html#pkg-descr. +-- The name of the package. +Name: ivy-web + +-- The package version. See the Haskell package versioning policy +-- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for +-- standards guiding when and how versions should be incremented. +Version: 0.1 + +-- A short (one-line) description of the package. +Synopsis: A lightweight web framework, with type safe routes, based on invertible-syntax, and i18n support. + +-- A longer description of the package. +Description: The features of this web framework: + * Type safe routes, specify url-handler mapping in one place + * Simple yet elegant handler via type class + * Flexible template system, utilize exsisting libraries such as Blaze-Html and Hastache. + * Easy i18n + For an example, refer to https://github.com/lilac/ivy-example/ + +-- URL for the project homepage or repository. +Homepage: https://github.com/lilac/ivy-web/ + +-- The license under which the package is released. +License: BSD3 + +-- The file containing the license text. +License-file: LICENSE + +-- The package author(s). +Author: James Deng + +-- An email address to which users can send suggestions, bug reports, +-- and patches. +Maintainer: cnJamesDeng@gmail.com + +-- A copyright notice. +-- Copyright: + +Category: Web + +Build-type: Simple + +-- Extra files to be distributed with the package, such as examples or +-- a README. +-- Extra-source-files: + +-- Constraint on the version of Cabal needed to build this package. +Cabal-version: >=1.2 + + +Library + -- Modules exported by the library. + Hs-source-dirs: src + Exposed-modules: + Web.Ivy.Routes + Web.Ivy.Types + + -- Packages needed in order to build this package. + Build-depends: + base >= 3 && < 5, + partial-isomorphisms < 0.3, + invertible-syntax >= 0.2, + wai >= 0.4.0, + http-types >= 0.6.5 + + + -- Modules not exported by this package. + -- Other-modules: + + -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source. + -- Build-tools: + diff --git a/src/Web/Ivy/Routes.hs b/src/Web/Ivy/Routes.hs new file mode 100644 --- /dev/null +++ b/src/Web/Ivy/Routes.hs @@ -0,0 +1,62 @@ +{-# LANGUAGE TemplateHaskell, NoMonomorphismRestriction, RankNTypes, GADTs, ScopedTypeVariables #-} +module Web.Ivy.Routes where + +import Prelude hiding (print) +import Text.Syntax +import Control.Isomorphism.Partial +import Control.Isomorphism.Partial.TH +import Control.Isomorphism.Partial.Unsafe (Iso (Iso)) +import Data.Char (isLetter, isDigit, isAlphaNum) +import Text.Syntax.Printer.Naive +import Text.Syntax.Parser.Naive +import Web.Ivy.Types +import Data.Typeable + +{- +class HasSyntax a where + syntax :: Syntax s => a -> s a +-} + +data Route = forall a. (Typeable a, Handler a) => Route a + +routeIso :: forall a. (Typeable a, Handler a) => Iso a Route +routeIso = Iso f g where + f = Just . Route + g r = case r of Route r' -> cast r' + +{- +instance Resource Route where + get r = case r of Route r' -> get r' + post r= case r of Route r' -> post r' + put r = case r of Route r' -> put r' + delete r = case r of Route r' -> delete r' + +unwrap :: (Resource a => a -> Application) -> Route -> Application +unwrap f r = case r of Route r' -> f r' + +print' :: HasSyntax a => a -> Maybe String +print' a = print (syntax a) a +-} + +parseUrl = parse + +url :: (Typeable a, Handler a) => Printer Route -> a -> Maybe String +url r h = print r (Route h) + +dash = text "-" +a b = a <*> text "/" *> b +infixr 7 <-> +a <-> b = a <*> text "-" *> b + +int :: Syntax delta => delta Int +int = Iso read' show' <$> many digit where + read' s = case [ x | (x, "") <- reads s ] of + [] -> Nothing + (x : _) -> Just x + + show' x = Just (show x) + +digit = subset isDigit <$> token + +char = subset isAlphaNum <$> token +string = many char diff --git a/src/Web/Ivy/Types.hs b/src/Web/Ivy/Types.hs new file mode 100644 --- /dev/null +++ b/src/Web/Ivy/Types.hs @@ -0,0 +1,24 @@ +{-# LANGUAGE OverloadedStrings #-} +module Web.Ivy.Types + (Handler(..) + , Application) + where +import Network.Wai +import Network.HTTP.Types + +class Handler a where + get, post, put, delete, handle :: a -> Application + get _ = unimplemented + post _ = unimplemented + put _ = unimplemented + delete _ = unimplemented + + handle a req = case requestMethod req of + m | m == methodGet -> get a req + | m == methodPost -> post a req + | m == methodPut -> put a req + | m == methodDelete -> delete a req + otherwise -> unimplemented req + +unimplemented :: Application +unimplemented _ = return $ responseLBS status501 [("Content-Type", "text/plain")] "not implemented method"