├── .gitignore ├── .travis.yml ├── README.md ├── contrib └── auth │ └── auth.lisp ├── docs ├── api.scr ├── extensions.scr ├── includes │ ├── project.lisp │ └── run-app.lisp ├── manifest.lisp ├── overview.scr ├── project.scr ├── utweet.png └── utweet.scr ├── examples ├── hello-world │ └── app.lisp └── utweet │ ├── .gitignore │ ├── models.lisp │ ├── static │ └── style.css │ ├── templates │ ├── base.html │ ├── head.html │ ├── index.html │ ├── navbar.html │ ├── profile.html │ ├── show-tweets.html │ ├── timeline.html │ └── user-list.html │ └── views.lisp ├── lucerne-auth.asd ├── lucerne-hello-world.asd ├── lucerne-test.asd ├── lucerne-utweet.asd ├── lucerne.asd ├── skeleton ├── README.md ├── asdf-test.lisp ├── asdf.lisp ├── assets │ ├── css │ │ ├── style.css │ │ └── style.scss │ └── js │ │ └── scripts.js ├── docs │ ├── manifest.lisp │ └── manual.scr ├── gitignore.txt ├── src │ └── source.lisp ├── t │ └── test.lisp ├── templates │ ├── base.html │ ├── includes │ │ └── head.html │ └── index.html └── travis.yml ├── src ├── app.lisp ├── control.lisp ├── http.lisp ├── lucerne.lisp ├── skeleton.lisp └── views.lisp └── t ├── examples.lisp ├── final.lisp ├── lucerne.lisp ├── skeleton.lisp └── subapps.lisp /.gitignore: -------------------------------------------------------------------------------- 1 | *.fasl 2 | *.dx32fsl 3 | *.dx64fsl 4 | *.lx32fsl 5 | *.lx64fsl 6 | *.x86f 7 | *~ 8 | .#* 9 | docs/build 10 | _site -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: common-lisp 2 | sudo: false 3 | 4 | env: 5 | global: 6 | - PATH=~/.roswell/bin:$PATH 7 | - ROSWELL_BRANCH=master 8 | - ROSWELL_INSTALL_DIR=$HOME/.roswell 9 | - COVERAGE_EXCLUDE=t 10 | matrix: 11 | - LISP=sbcl-bin COVERALLS=true 12 | 13 | install: 14 | # Roswell & coveralls 15 | - curl -L https://raw.githubusercontent.com/snmsts/roswell/$ROSWELL_BRANCH/scripts/install-for-ci.sh | sh 16 | - git clone https://github.com/fukamachi/cl-coveralls ~/lisp/cl-coveralls 17 | # Clone the latest copies of external libraries 18 | - git clone https://github.com/fukamachi/lack.git ~/lisp/lack 19 | - git clone https://github.com/fukamachi/clack.git ~/lisp/clack 20 | 21 | cache: 22 | directories: 23 | - $HOME/.roswell 24 | - $HOME/.config/common-lisp 25 | 26 | before_script: 27 | - ros --version 28 | - ros config 29 | 30 | script: 31 | - ros -e '(ql:quickload (list :cl-coveralls :lucerne-test))' 32 | -e '(setf fiveam:*debug-on-error* t 33 | fiveam:*debug-on-failure* t)' 34 | -e '(setf *debugger-hook* 35 | (lambda (c h) 36 | (declare (ignore c h)) 37 | (uiop:quit -1)))' 38 | -e '(coveralls:with-coveralls (:exclude (list "t" "examples/utweet/models.lisp")) 39 | (lucerne-test:run-tests))' 40 | 41 | notifications: 42 | email: 43 | - eudoxiahp@gmail.com 44 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Lucerne: a web framework 2 | 3 | [![Build Status](https://travis-ci.org/eudoxia0/lucerne.svg?branch=master)](https://travis-ci.org/eudoxia0/lucerne) 4 | [![Coverage Status](https://coveralls.io/repos/eudoxia0/lucerne/badge.svg?branch=master)](https://coveralls.io/r/eudoxia0/lucerne?branch=master) 5 | [![Quicklisp](http://quickdocs.org/badge/lucerne.svg)](http://quickdocs.org/lucerne/) 6 | 7 | Read the [docs](http://borretti.me/lucerne/docs/overview.html). 8 | 9 | ## Usage 10 | 11 | ```lisp 12 | (defapp app) 13 | 14 | @route app "/" 15 | (defview index () 16 | (respond "

Welcome to Lucerne

")) 17 | 18 | @route app "/greet/:name" 19 | (defview greet (name) 20 | (respond (format nil "Hello, ~A!" name))) 21 | 22 | (start app) 23 | ``` 24 | 25 | # License 26 | 27 | Copyright (c) 2014-2018 Fernando Borretti (eudoxiahp@gmail.com) 28 | 29 | Licensed under the MIT License. 30 | -------------------------------------------------------------------------------- /contrib/auth/auth.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-user) 2 | (defpackage lucerne-auth 3 | (:use :cl) 4 | (:import-from :clack.request 5 | :env) 6 | (:export :get-userid 7 | :login 8 | :logout 9 | :logged-in-p)) 10 | (in-package :lucerne-auth) 11 | 12 | (defclass auth-manager () 13 | ((get-user :initarg :get-user 14 | :reader get-user 15 | :type function) 16 | (user-pass :initarg :user-pass 17 | :reader user-pass 18 | :type function))) 19 | 20 | (defun get-userid () 21 | "Extract the user ID from the current session." 22 | (gethash :userid (lucerne:session))) 23 | 24 | (defun login (userid) 25 | "Log in the user specified by @cl:param(userid)." 26 | (setf (gethash :userid (lucerne:session)) 27 | userid)) 28 | 29 | (defun logout () 30 | "Log out the current user." 31 | (remhash :userid (lucerne:session))) 32 | 33 | (defun logged-in-p () 34 | "Whether the user is logged in or not." 35 | (if (get-userid) 36 | t)) 37 | -------------------------------------------------------------------------------- /docs/api.scr: -------------------------------------------------------------------------------- 1 | @begin(section) 2 | @title(API Reference) 3 | 4 | @begin(section) 5 | @title(Apps) 6 | 7 | @cl:with-package[name="lucerne.app"]( 8 | @cl:doc(class base-app) 9 | @cl:doc(macro defapp) 10 | ) 11 | 12 | @end(section) 13 | 14 | @begin(section) 15 | @title(Views) 16 | 17 | @cl:with-package[name="lucerne.views"]( 18 | @cl:doc(macro defview) 19 | ) 20 | 21 | @cl:with-package[name="lucerne.http"]( 22 | @cl:doc(variable *request*) 23 | @cl:doc(function respond) 24 | @cl:doc(function redirect) 25 | @cl:doc(macro session) 26 | @cl:doc(macro with-params) 27 | @cl:doc(macro render-template) 28 | ) 29 | 30 | @end(section) 31 | 32 | @begin(section) 33 | @title(Control) 34 | 35 | @cl:with-package[name="lucerne.ctl"]( 36 | @cl:doc(method start (app base-app) &key (port 8000) (server :hunchentoot) debug) 37 | @cl:doc(method stop (app base-app)) 38 | ) 39 | 40 | @end(section) 41 | 42 | @end(section) 43 | -------------------------------------------------------------------------------- /docs/extensions.scr: -------------------------------------------------------------------------------- 1 | @begin(section) 2 | @title(Extensions) 3 | 4 | @begin(section) 5 | @title(lucerne-auth) 6 | 7 | lucerne-auth is a contrib module for simple session authentication. 8 | 9 | @cl:with-package[name="lucerne-auth"]( 10 | @cl:doc(function get-userid) 11 | @cl:doc(function login) 12 | @cl:doc(function logout) 13 | @cl:doc(function logged-in-p) 14 | ) 15 | 16 | @end(section) 17 | 18 | @end(section) 19 | -------------------------------------------------------------------------------- /docs/includes/project.lisp: -------------------------------------------------------------------------------- 1 | CL-USER> (lucerne.skeleton:make-project) 2 | 3 | Project name (e.g. 'my-app'): my-app 4 | 5 | Author's full name: Fernando Borretti 6 | 7 | Author's email: eudoxiahp@gmail.com 8 | 9 | License (e.g. 'MIT', 'GPLv3'): MIT 10 | 11 | One-line project description: A simple example app. 12 | 13 | Dependencies (e.g. 'drakma, quri, clack'): drakma, cl-gists, jonathan 14 |  15 | Use Sass as the CSS preprocessor? (yes or no) yes 16 |  17 | Use Travis for continuous integration? (yes or no) no 18 |  19 | Add .gitignore? (yes or no) yes 20 |  21 | Do you have a GitHub username? (yes or no) yes 22 | 23 | GitHub username: eudoxia0 24 | 25 | Finally, where do we put the project directory? (e.g. '/code/lisp/' will put the project in '/code/lisp/my-app'): /home/eudoxia/code/ 26 | ;; Writing /home/eudoxia/code/my-app/README.md 27 | ;; Writing /home/eudoxia/code/my-app/.gitignore 28 | ;; Writing /home/eudoxia/code/my-app/my-app.asd 29 | ;; Writing /home/eudoxia/code/my-app/src/my-app.lisp 30 | ;; Writing /home/eudoxia/code/my-app/my-app-test.asd 31 | ;; Writing /home/eudoxia/code/my-app/t/my-app.lisp 32 | ;; Writing /home/eudoxia/code/my-app/templates/base.html 33 | ;; Writing /home/eudoxia/code/my-app/templates/includes/head.html 34 | ;; Writing /home/eudoxia/code/my-app/templates/index.html 35 | ;; Writing /home/eudoxia/code/my-app/assets/css/style.scss 36 | ;; Writing /home/eudoxia/code/my-app/assets/js/scripts.js 37 | ;; Writing /home/eudoxia/code/my-app/docs/manifest.lisp 38 | ;; Writing /home/eudoxia/code/my-app/docs/manual.scr 39 | T 40 | -------------------------------------------------------------------------------- /docs/includes/run-app.lisp: -------------------------------------------------------------------------------- 1 | CL-USER> (ql:quickload :my-app) 2 | To load "my-app": 3 | Load 1 ASDF system: 4 | my-app 5 | ; Loading "my-app" 6 | [package my-app]............ 7 | (:MY-APP) 8 | 9 | CL-USER> (lucerne:start my-app:app :port 8000) 10 | To load "clack-handler-hunchentoot": 11 | Load 1 ASDF system: 12 | clack-handler-hunchentoot 13 | ; Loading "clack-handler-hunchentoot" 14 | 15 | Hunchentoot server is started. 16 | Listening on localhost:8000. 17 | T 18 | CL-USER> 19 | -------------------------------------------------------------------------------- /docs/manifest.lisp: -------------------------------------------------------------------------------- 1 | (:docstring-markup-format :scriba 2 | :systems (:lucerne 3 | :lucerne-utweet 4 | :lucerne-auth) 5 | :documents ((:title "Lucerne" 6 | :authors ("Fernando Borretti") 7 | :output-format (:type :multi-html 8 | :template :minima) 9 | :sources ("overview.scr" 10 | "utweet.scr" 11 | "project.scr" 12 | "api.scr" 13 | "extensions.scr")))) 14 | -------------------------------------------------------------------------------- /docs/overview.scr: -------------------------------------------------------------------------------- 1 | @begin(section) 2 | @title(Overview) 3 | 4 | Lucerne is a web application framework built on 5 | @link[uri=http://clacklisp.org/](Clack). 6 | 7 | @begin(section) 8 | @title(Features) 9 | 10 | @begin(deflist) 11 | 12 | @term(Built on Clack) 13 | 14 | @def(Lucerne uses @link[uri=http://clacklisp.org/](Clack), an HTTP server 15 | abstraction, which enables it to use any server backend supported by Clack 16 | @l(ndash) from Hunchentoot to the very fast 17 | @link[uri="https://github.com/fukamachi/woo"](Woo).) 18 | 19 | @term(Inspired by Flask) 20 | @def(@link[uri="http://flask.pocoo.org/"](Flask) is a small and flexible web framework for Python, and Lucerne borrows most of its design concepts from it.) 21 | 22 | @term(Extensively Tested) 23 | @def(Lucerne maintains 24 | @link[uri="https://coveralls.io/r/eudoxia0/lucerne?branch=master"](100% code 25 | coverage). Everything including the examples is covered by the tests.) 26 | 27 | @term(Django-like Templates) 28 | @def(Lucerne uses @link[uri="https://github.com/mmontone/djula"](Djula), a clone 29 | of the @link[uri="https://www.djangoproject.com/"](Django) template engine.) 30 | 31 | @term(Easy to Set Up) 32 | @def(Lucerne includes a project skeleton generator, which takes care of setting 33 | up the structure of a basic application so you can start coding right away.) 34 | 35 | @term(Built-in Web Debugger) 36 | @def(Lucerne comes with 37 | @link[uri="https://github.com/eudoxia0/clack-errors"](clack-errors), to make 38 | debugging server-side errors in development easier.) 39 | 40 | @end(deflist) 41 | 42 | @end(section) 43 | 44 | @end(section) 45 | -------------------------------------------------------------------------------- /docs/project.scr: -------------------------------------------------------------------------------- 1 | @begin(section) 2 | @title(Starting a Project) 3 | 4 | Lucerne includes a project skeleton generator, which asks you some questions 5 | about the project and generates it accordingly. 6 | 7 | The generated app is a runnable application with views and unit tests. To run it: 8 | 9 | @code[lang=lisp](@include[path=includes/run-app.lisp]()) 10 | 11 | To run the tests: 12 | 13 | @code[lang=lisp]((ql:quickload :my-app-test)) 14 | 15 | @begin(section) 16 | @title(Usage) 17 | 18 | @code[lang=lisp](@include[path=includes/project.lisp]()) 19 | 20 | The resulting files and directories, created in @c(/home/eudoxia/code/my-app/), 21 | look like this: 22 | 23 | @begin[lang=txt](code) 24 | my-app/ 25 | assets/ 26 | css/ 27 | style.scss 28 | js/ 29 | scripts.js 30 | src/ 31 | my-app.lisp 32 | templates/ 33 | includes/ 34 | head.html 35 | base.html 36 | index.html 37 | docs/ 38 | manifest.lisp 39 | manual.scr 40 | t/ 41 | my-app.lisp 42 | .gitignore 43 | .travis.yml 44 | my-app.asd 45 | my-app-test.asd 46 | README.md 47 | @end(code) 48 | 49 | @end(section) 50 | 51 | @begin(section) 52 | @title(Roles of the Files) 53 | 54 | @begin(deflist) 55 | 56 | @term(@c(README.md)) 57 | @def(The app's README, where you describe what it is and how to 58 | set it up and use it.) 59 | 60 | @term(@c(my-app.asd)) 61 | @def(The system definition file, where you describe the application's metadata, 62 | dependencies, and the files that make it up.) 63 | 64 | @term(@c(my-app-test.asd)) 65 | @def(The system definition file for the tests.) 66 | 67 | @term(@c(.travis.yml)) 68 | 69 | @def(This file provides integration with 70 | @link[uri="https://travis-ci.org/"](Travis) for easily testing the application 71 | on the cloud.) 72 | 73 | @term(@c(src/my-app.lisp)) 74 | @def(This is the application's main file. It defines the Lucerne application 75 | object, adds an example route, and sets up the templates and assets. As the 76 | application grows, you will find it convenient to split these up into other 77 | files.) 78 | 79 | @term(@c(t/my-app.lisp)) 80 | @def(The main tests file, defines an example test suite, a couple of tests and 81 | runs them.) 82 | 83 | @term(@c(templates/base.html)) 84 | @def(The base template.) 85 | 86 | @term(@c(templates/index.html)) 87 | @def(The template for the main page.) 88 | 89 | @end(deflist) 90 | 91 | @end(section) 92 | 93 | @end(section) 94 | -------------------------------------------------------------------------------- /docs/utweet.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/eudoxia0/lucerne/7037f2c20d5bbf7a789bd9fe2e85eb1ed3ef247c/docs/utweet.png -------------------------------------------------------------------------------- /docs/utweet.scr: -------------------------------------------------------------------------------- 1 | @begin(section) 2 | @title(Example: A Twitter Clone) 3 | 4 | @image[src=utweet.png]() 5 | 6 | utweet is a small Twitter clone inspired by Flask's 7 | @link[uri="https://github.com/mitsuhiko/flask/tree/master/examples/minitwit/"](minitwit) 8 | example. 9 | 10 | You can load the app with @c((ql:quickload :lucerne-utweet)) and test it locally 11 | with @c((lucerne:start utweet.views:app :port 8000)). 12 | 13 | @begin(section) 14 | @title(The Models) 15 | 16 | We'll make a package, @c(utweet.models), specifically for the models (users, 17 | tweets, et cetera). We'll build an abstract interface that could be implemented 18 | over an SQL database, a document DB, or, in the case of this example, a simple 19 | in-memory storage. 20 | 21 | First, we create a @c(models.lisp) and add the system definition: 22 | 23 | @code[lang=lisp](@include[path=../examples/utweet/models.lisp start=1 end=28]()) 24 | 25 | The actual class definitions are fairly straightforward: We define @c(user), 26 | which represents a user, @c(subscription), which represents a user following 27 | another, and @c(tweet), which is a single tweet. 28 | 29 | @code[lang=lisp](@include[path=../examples/utweet/models.lisp start=32 end=72]()) 30 | 31 | Now, we won't discuss the actual implementation of the functions. Those are 32 | availble in the 33 | @link[uri="https://github.com/eudoxia0/lucerne/tree/master/examples/utweet"](source 34 | code). We'll just present the function documentation which describes the 35 | interface. 36 | 37 | @cl:with-package[name="utweet.models"]( 38 | @cl:doc(function find-user) 39 | @cl:doc(function register-user) 40 | @cl:doc(function followers) 41 | @cl:doc(function following) 42 | @cl:doc(function tweet) 43 | @cl:doc(function user-timeline) 44 | @cl:doc(function user-tweets) 45 | @cl:doc(function follow) 46 | ) 47 | 48 | @end(section) 49 | 50 | @begin(section) 51 | @title(The Views) 52 | 53 | First, we'll create the @c(utweet.views) package. We'll @c(:use :lucerne) to 54 | import everything and simply export the @c(app). 55 | 56 | @code[lang=lisp](@include[path=../examples/utweet/views.lisp start=1 end=6]()) 57 | 58 | That last line is important, it allows us to use the reader macros Lucerne uses 59 | for routing. 60 | 61 | Now, we define the application. We use the session middleware, since we'll need 62 | it for authentication, and also the static files middleware: This takes every 63 | request that starts with @c(/static/) and finds the corresponding file in the 64 | @c(examples/utweet/static/) folder inside the Lucerne source. 65 | 66 | @code[lang=lisp](@include[path=../examples/utweet/views.lisp start=10 end=15]()) 67 | 68 | Now we add some Djula templates for the different pages: 69 | 70 | @code[lang=lisp](@include[path=../examples/utweet/views.lisp start=19 end=28]()) 71 | 72 | Next up, a couple of utility functions: @c(current-user) finds the user model 73 | that corresponds to the username stored in Lucerne's session 74 | data. @c(display-tweets) is a function to make templating easier: It goes 75 | through a list of tweets, and creates a plist that has the tweet object as well 76 | as the author object (instead of referencing the author through its username). 77 | 78 | @code[lang=lisp](@include[path=../examples/utweet/views.lisp start=32 end=43]()) 79 | 80 | The index view is very simple: If the user is logged in, find the user object, 81 | and display their timeline. If the user is not logged in, display the landing 82 | page. 83 | 84 | @code[lang=lisp](@include[path=../examples/utweet/views.lisp start=47 end=57]()) 85 | 86 | When visiting a user's profile, we find that user by name, get a list of their 87 | tweets, and render the profile page template. We additionally ask whether the 88 | user is the logged-in user: This lets us know whether we should display buttons 89 | to follow unfollow the user. 90 | 91 | @code[lang=lisp](@include[path=../examples/utweet/views.lisp start=58 end=69]()) 92 | 93 | These next views are quite simple, @c(utweet.models) does most of our work. 94 | 95 | @code[lang=lisp](@include[path=../examples/utweet/views.lisp start=71 end=85]()) 96 | 97 | And, finally, the core of the app: Tweeting something. If the user's not logged 98 | in, we give them an error, otherwise, we create the tweet and redirect them to 99 | the home page. 100 | 101 | @code[lang=lisp](@include[path=../examples/utweet/views.lisp start=87 end=95]()) 102 | 103 | @begin(section) 104 | @title(Authentication) 105 | 106 | Here we implement all the authentication views. We'll use the 107 | @link[uri="https://github.com/eudoxia0/cl-pass/"](@c(cl-pass)) library so we 108 | don't have to concern ourselves with security needs. 109 | 110 | The signup view is the most complex: We have to check if a user with that name 111 | exists and that the supplied passwords match. If both check out, we create the 112 | user and redirect them to the home page. 113 | 114 | @code[lang=lisp](@include[path=../examples/utweet/views.lisp start=99 end=119]()) 115 | 116 | To sign in, we both check whether a username by that name exists and if the 117 | password is a match. If so, we log them in and redirect them to their timeline. 118 | 119 | @code[lang=lisp](@include[path=../examples/utweet/views.lisp start=121 end=138]()) 120 | 121 | Signing out is simpler: If the user is logged in, sign them out. Otherwise, do 122 | nothing. Then redirect them to the home. 123 | 124 | @code[lang=lisp](@include[path=../examples/utweet/views.lisp start=140 end=144]()) 125 | 126 | @end(section) 127 | 128 | @end(section) 129 | 130 | @end(section) 131 | -------------------------------------------------------------------------------- /examples/hello-world/app.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-user) 2 | (defpackage lucerne-hello-world 3 | (:use :cl :lucerne) 4 | (:export :app)) 5 | (in-package :lucerne-hello-world) 6 | (annot:enable-annot-syntax) 7 | 8 | (defapp app) 9 | 10 | @route app "/" 11 | (defview hello () 12 | (respond "Hello, world!")) 13 | -------------------------------------------------------------------------------- /examples/utweet/.gitignore: -------------------------------------------------------------------------------- 1 | migrations/ 2 | -------------------------------------------------------------------------------- /examples/utweet/models.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-user) 2 | (defpackage utweet.models 3 | (:use :cl) 4 | ;; Users 5 | (:export :user 6 | :user-username 7 | :user-full-name 8 | :user-password 9 | :user-avatar-url) 10 | ;; Subscriptions (follows) 11 | (:export :subscription 12 | :subscription-follower 13 | :subscription-followed) 14 | ;; Tweets 15 | (:export :tweet 16 | :tweet-author 17 | :tweet-text 18 | :tweet-timestamp) 19 | ;; Some functions 20 | (:export :find-user 21 | :register-user 22 | :followers 23 | :following 24 | :tweet 25 | :user-timeline 26 | :user-tweets 27 | :follow)) 28 | (in-package :utweet.models) 29 | 30 | ;;; Models 31 | 32 | (defclass user () 33 | ((username :accessor user-username 34 | :initarg :username 35 | :type string) 36 | (full-name :accessor user-full-name 37 | :initarg :full-name 38 | :type string) 39 | (email :accessor user-email 40 | :initarg :email 41 | :type string) 42 | (password :accessor user-password 43 | :initarg :password 44 | :type string) 45 | (avatar-url :accessor user-avatar-url 46 | :initarg :avatar-url 47 | :type string)) 48 | (:documentation "A user.")) 49 | 50 | (defclass subscription () 51 | ((follower :reader subscription-follower 52 | :initarg :follower 53 | :type string 54 | :documentation "The follower's username.") 55 | (followed :reader subscription-followed 56 | :initarg :followed 57 | :type string 58 | :documentation "The followed's username.")) 59 | (:documentation "Represents a user following another.")) 60 | 61 | (defclass tweet () 62 | ((author :reader tweet-author 63 | :initarg :author 64 | :type string 65 | :documentation "The author's username.") 66 | (text :reader tweet-text 67 | :initarg :text 68 | :type string) 69 | (timestamp :reader tweet-timestamp 70 | :initarg :timestamp 71 | :initform (local-time:now))) 72 | (:documentation "A tweet.")) 73 | 74 | ;;; Storage 75 | 76 | (defparameter *users* (make-hash-table :test #'equal)) 77 | 78 | (defparameter *subscriptions* (list)) 79 | 80 | (defparameter *tweets* (list)) 81 | 82 | ;;; Functions 83 | 84 | (defun find-user (username) 85 | "Find a user by @cl:param(username), returns @c(NIL) if none is found." 86 | (gethash username *users*)) 87 | 88 | (defun register-user (&key username full-name email password) 89 | "Create a new user and hash their @cl:param(password)." 90 | (setf (gethash username *users*) 91 | (make-instance 'user 92 | :username username 93 | :full-name full-name 94 | :email email 95 | :password (cl-pass:hash password) 96 | :avatar-url (avatar-api:gravatar email 120)))) 97 | 98 | (defun followers (user) 99 | "List of users (@c(user) instances) that follow @cl:param(user)." 100 | (mapcar #'(lambda (sub) 101 | (find-user (subscription-follower sub))) 102 | (remove-if-not #'(lambda (sub) 103 | (string= (subscription-followed sub) 104 | (user-username user))) 105 | *subscriptions*))) 106 | 107 | (defun following (user) 108 | "List of users (@c(user) instances) the @cl:param(user) follows." 109 | (mapcar #'(lambda (sub) 110 | (find-user (subscription-followed sub))) 111 | (remove-if-not #'(lambda (sub) 112 | (string= (subscription-follower sub) 113 | (user-username user))) 114 | *subscriptions*))) 115 | 116 | (defun tweet (author text) 117 | "Create a new tweet from @cl:param(author) containing @cl:param(text)." 118 | (push (make-instance 'tweet 119 | :author (user-username author) 120 | :text text) 121 | *tweets*)) 122 | 123 | (defun sort-tweets (tweets) 124 | "Given a list of tweets, sort them so the newest are first." 125 | (sort tweets 126 | #'(lambda (tweet-a tweet-b) 127 | (local-time:timestamp>= (tweet-timestamp tweet-a) 128 | (tweet-timestamp tweet-b))))) 129 | 130 | (defun user-timeline (user) 131 | "Find the tweets for this @cl:param(user)'s timeline." 132 | (sort-tweets (remove-if-not #'(lambda (tweet) 133 | (or (member (tweet-author tweet) 134 | (following user) 135 | :test #'equal) 136 | (string= (tweet-author tweet) 137 | (user-username user)))) 138 | *tweets*))) 139 | 140 | (defun user-tweets (user) 141 | "Return a @cl:param(user)'s tweets, sorted through time." 142 | (sort-tweets (remove-if-not #'(lambda (tweet) 143 | (string= (tweet-author tweet) 144 | (user-username user))) 145 | *tweets*))) 146 | 147 | (defun follow (follower followed) 148 | "Follow a user. Takes two @c(user) instances: @cl:param(follower) and @cl:param(followed)." 149 | (push (make-instance 'subscription 150 | :follower (user-username follower) 151 | :followed (user-username followed)) 152 | *subscriptions*)) 153 | -------------------------------------------------------------------------------- /examples/utweet/static/style.css: -------------------------------------------------------------------------------- 1 | @import url(http://fonts.googleapis.com/css?family=Source+Sans+Pro); 2 | 3 | /* General CSS */ 4 | 5 | h1, h2, h3, h4 { 6 | font-family: 'Source Sans Pro', sans-serif; 7 | } 8 | 9 | body, html { 10 | height:100%; 11 | overflow: auto; 12 | } 13 | 14 | /* Panels */ 15 | 16 | .panel { 17 | padding: 10px; 18 | margin: 75px auto 0; 19 | width: 60%; 20 | } 21 | 22 | .panel-heading { 23 | background-color: #fff !important; 24 | padding-bottom: 35px; 25 | overflow: auto; 26 | } 27 | 28 | /* Sign up/in page */ 29 | 30 | #landing { 31 | background-image: -webkit-gradient(linear, left bottom, right top, color-stop(0, #787FD5), color-stop(1, #9EDDFF)); 32 | background-image: -webkit-linear-gradient(right top, #787FD5 0%, #9EDDFF 100%); 33 | background-image: -moz-linear-gradient(right top, #787FD5 0%, #9EDDFF 100%); 34 | background-image: -ms-linear-gradient(right top, #787FD5 0%, #9EDDFF 100%); 35 | background-image: -o-linear-gradient(right top, #787FD5 0%, #9EDDFF 100%); 36 | background-image: linear-gradient(to right top, #787FD5 0%, #9EDDFF 100%); 37 | 38 | width: 100%; 39 | min-height: 100%; 40 | overflow: auto; 41 | } 42 | 43 | #welcome-panel .panel-heading { 44 | text-align: center; 45 | } 46 | 47 | /* Profile page */ 48 | 49 | #names { 50 | list-style-type: none; 51 | padding-left: 0; 52 | } 53 | 54 | #names .full { 55 | font-size: 32px; 56 | font-style: bold; 57 | } 58 | 59 | .tweet .media-object { 60 | width: 64px; 61 | } 62 | -------------------------------------------------------------------------------- /examples/utweet/templates/base.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | {% include "head.html" %} 4 | 5 | {% block content %}{% endblock %} 6 | 7 | 8 | -------------------------------------------------------------------------------- /examples/utweet/templates/head.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 14 | 15 | 16 | 17 | {% if title %} 18 | {{ title }} – µtweet 19 | {% else %} 20 | µtweet 21 | {% endif %} 22 | 23 | 24 | -------------------------------------------------------------------------------- /examples/utweet/templates/index.html: -------------------------------------------------------------------------------- 1 | {% extends "base.html" %} 2 | 3 | {% block content %} 4 |
5 |
6 |
7 |

Welcome to µtweet

8 |
9 |
10 | {% if error %} 11 | 14 | {% endif %} 15 |
16 |
17 |

Sign up

18 |
19 |
20 | 21 | 22 |
23 |
24 | 25 | 26 |
27 |
28 | 29 | 30 |
31 |
32 | 33 | 34 |
35 |
36 | 37 | 38 |
39 | 40 |
41 |
42 |
43 |

Or sign in

44 |
45 |
46 | 47 | 48 |
49 |
50 | 51 | 52 |
53 | 54 |
55 |
56 |
57 |
58 |
59 |
60 | {% endblock %} 61 | -------------------------------------------------------------------------------- /examples/utweet/templates/navbar.html: -------------------------------------------------------------------------------- 1 | 22 | -------------------------------------------------------------------------------- /examples/utweet/templates/profile.html: -------------------------------------------------------------------------------- 1 | {% extends "base.html" %} 2 | 3 | {% block content %} 4 | {% include "navbar.html" %} 5 |
6 |
7 |
8 | 9 |
10 |
11 | {{ user.name }} 12 | {% if is-self %} 13 | 15 | Followers 16 | 17 | 19 | Following 20 | 21 | {% else %} 22 | Follow 23 | {% endif %} 24 |
25 |
26 |
27 | {% if tweets %} 28 | {% include "show-tweets.html" %} 29 | {% else %} 30 | 33 | {% endif %} 34 |
35 |
36 | {% endblock %} 37 | -------------------------------------------------------------------------------- /examples/utweet/templates/show-tweets.html: -------------------------------------------------------------------------------- 1 |
2 | {% for tweet in tweets do %} 3 |
4 |
5 | 6 | 7 | 8 |
9 |
10 |

11 | 12 | {{ tweet.author.name }} 13 | 14 |

15 | {{ tweet.text }} 16 |
17 |
18 | {% endfor %} 19 |
20 | -------------------------------------------------------------------------------- /examples/utweet/templates/timeline.html: -------------------------------------------------------------------------------- 1 | {% extends "base.html" %} 2 | 3 | {% block content %} 4 | {% include "navbar.html" %} 5 |
6 |
7 |

Timeline

8 |
9 |
10 | 11 | 12 | 13 |
14 |
15 |
16 |
17 | {% if tweets %} 18 | {% include "show-tweets.html" %} 19 | {% else %} 20 | 23 | {% endif %} 24 |
25 |
26 | {% endblock %} 27 | -------------------------------------------------------------------------------- /examples/utweet/templates/user-list.html: -------------------------------------------------------------------------------- 1 | {% extends "base.html" %} 2 | 3 | {% block content %} 4 | {% include "navbar.html" %} 5 |
6 |
7 |

{{ title }}

8 |
9 |
10 | {% for user in users %} 11 | {{ user.username }} 12 | {% endfor %} 13 |
14 |
15 | {% endblock %} 16 | -------------------------------------------------------------------------------- /examples/utweet/views.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-user) 2 | (defpackage utweet.views 3 | (:use :cl :lucerne) 4 | (:export :app)) 5 | (in-package :utweet.views) 6 | (annot:enable-annot-syntax) 7 | 8 | ;;; App definition 9 | 10 | (defapp app 11 | :middlewares (clack.middleware.session: 12 | (clack.middleware.static: 13 | :path "/static/" 14 | :root (asdf:system-relative-pathname :lucerne-utweet 15 | #p"examples/utweet/static/")))) 16 | 17 | ;;; Templates 18 | 19 | (djula:add-template-directory 20 | (asdf:system-relative-pathname :lucerne-utweet #p"examples/utweet/templates/")) 21 | 22 | (defparameter +timeline+ (djula:compile-template* "timeline.html")) 23 | 24 | (defparameter +index+ (djula:compile-template* "index.html")) 25 | 26 | (defparameter +profile+ (djula:compile-template* "profile.html")) 27 | 28 | (defparameter +user-list+ (djula:compile-template* "user-list.html")) 29 | 30 | ;;; Utilities 31 | 32 | (defun current-user () 33 | "Find the user from request data." 34 | (let ((username (lucerne-auth:get-userid))) 35 | (when username 36 | (utweet.models:find-user username)))) 37 | 38 | (defun display-tweets (tweets) 39 | "Go through a list of tweets, and create a list of plists with data from the 40 | tweet and its author." 41 | (loop for tweet in tweets collecting 42 | (list :author (utweet.models:find-user (utweet.models:tweet-author tweet)) 43 | :text (utweet.models:tweet-text tweet)))) 44 | 45 | ;;; Views 46 | 47 | @route app "/" 48 | (defview index () 49 | (if (lucerne-auth:logged-in-p) 50 | ;; Serve the user's timeline 51 | (let* ((user (current-user))) 52 | (render-template (+timeline+) 53 | :username (utweet.models:user-username user) 54 | :name (utweet.models:user-full-name user) 55 | :tweets (display-tweets (utweet.models:user-timeline user)))) 56 | (render-template (+index+)))) 57 | 58 | @route app "/profile/:username" 59 | (defview profile (username) 60 | (let* ((user (utweet.models:find-user username)) 61 | ;; The user's timeline 62 | (user-tweets (utweet.models:user-tweets user)) 63 | ;; Is the user viewing his own profile? 64 | (is-self (string= (lucerne-auth:get-userid) 65 | username))) 66 | (render-template (+profile+) 67 | :user user 68 | :tweets (display-tweets user-tweets) 69 | :is-self is-self))) 70 | 71 | @route app "/followers/:username" 72 | (defview user-followers (username) 73 | (let ((user (utweet.models:find-user username))) 74 | (render-template (+user-list+) 75 | :user user 76 | :title "Followers" 77 | :users (utweet.models:followers user)))) 78 | 79 | @route app "/following/:username" 80 | (defview user-following (username) 81 | (let ((user (utweet.models:find-user username))) 82 | (render-template (+user-list+) 83 | :user user 84 | :title "Following" 85 | :users (utweet.models:following user)))) 86 | 87 | @route app (:post "/tweet") 88 | (defview tweet () 89 | (if (lucerne-auth:logged-in-p) 90 | (let ((user (current-user))) 91 | (with-params (tweet) 92 | (utweet.models:tweet user tweet)) 93 | (redirect "/")) 94 | (render-template (+index+) 95 | :error "You are not logged in."))) 96 | 97 | ;;; Authentication views 98 | 99 | @route app (:post "/signup") 100 | (defview sign-up () 101 | (with-params (name username email password password-repeat) 102 | ;; Does a user with that name exist? 103 | (if (utweet.models:find-user username) 104 | ;; If it does, render the landing template with a corresponding error 105 | (render-template (+index+) 106 | :error "A user with that name already exists.") 107 | ;; We have a new user. Do both passwords match? 108 | (if (string= password password-repeat) 109 | ;; Okay, the passwords are a match. Let's create the user and return 110 | ;; the user to the homepage 111 | (progn 112 | (utweet.models:register-user :username username 113 | :full-name name 114 | :email email 115 | :password password) 116 | (redirect "/")) 117 | ;; The passwords don't match 118 | (render-template (+index+) 119 | :error "Passwords don't match."))))) 120 | 121 | @route app (:post "/signin") 122 | (defview sign-in () 123 | (with-params (username password) 124 | ;; Check whether a user with this name exists 125 | (let ((user (utweet.models:find-user username))) 126 | (if user 127 | (if (cl-pass:check-password password 128 | (utweet.models:user-password user)) 129 | (progn 130 | ;; Log the user in 131 | (lucerne-auth:login username) 132 | (redirect "/")) 133 | ;; Wrong password 134 | (render-template (+index+) 135 | :error "Wrong password.")) 136 | ;; No such user 137 | (render-template (+index+) 138 | :error "No such user."))))) 139 | 140 | @route app "/signout" 141 | (defview sign-out () 142 | (when (lucerne-auth:logged-in-p) 143 | (lucerne-auth:logout)) 144 | (redirect "/")) 145 | -------------------------------------------------------------------------------- /lucerne-auth.asd: -------------------------------------------------------------------------------- 1 | (asdf:defsystem lucerne-auth 2 | :version "0.1" 3 | :author "Fernando Borretti" 4 | :license "MIT" 5 | :depends-on (:cl-pass 6 | :lucerne) 7 | :components ((:module "contrib/auth" 8 | :components 9 | ((:file "auth")))) 10 | :description "An authentication framework for Lucerne." 11 | :in-order-to ((test-op (test-op lucerne-auth-test)))) 12 | -------------------------------------------------------------------------------- /lucerne-hello-world.asd: -------------------------------------------------------------------------------- 1 | (asdf:defsystem lucerne-hello-world 2 | :version "0.1" 3 | :author "Fernando Borretti" 4 | :license "MIT" 5 | :depends-on (:lucerne) 6 | :components ((:module "examples/hello-world" 7 | :components 8 | ((:file "app")))) 9 | :description "The simplest Lucerne app.") 10 | -------------------------------------------------------------------------------- /lucerne-test.asd: -------------------------------------------------------------------------------- 1 | (asdf:defsystem lucerne-test 2 | :author "Fernando Borretti" 3 | :license "MIT" 4 | :depends-on (:lucerne 5 | :lucerne-hello-world 6 | :lucerne-utweet 7 | :fiveam 8 | :drakma) 9 | :description "Lucerne tests" 10 | :components ((:module "t" 11 | :serial t 12 | :components 13 | ((:file "lucerne") 14 | (:file "subapps") 15 | (:file "examples") 16 | (:file "skeleton") 17 | (:file "final"))))) 18 | -------------------------------------------------------------------------------- /lucerne-utweet.asd: -------------------------------------------------------------------------------- 1 | (asdf:defsystem lucerne-utweet 2 | :version "0.1" 3 | :author "Fernando Borretti" 4 | :license "MIT" 5 | :depends-on (:lucerne 6 | :local-time 7 | :lucerne-auth 8 | :avatar-api) 9 | :components ((:module "examples/utweet" 10 | :serial t 11 | :components 12 | ((:file "models") 13 | (:file "views")))) 14 | :description "A small Twitter clone built with Lucerne.") 15 | -------------------------------------------------------------------------------- /lucerne.asd: -------------------------------------------------------------------------------- 1 | (asdf:defsystem lucerne 2 | :author "Fernando Borretti " 3 | :maintainer "Fernando Borretti " 4 | :license "MIT" 5 | :version "0.3" 6 | :homepage "https://github.com/eudoxia0/lucerne" 7 | :bug-tracker "https://github.com/eudoxia0/lucerne/issues" 8 | :source-control (:git "git@github.com:eudoxia0/lucerne.git") 9 | :depends-on (:clack 10 | :clack-v1-compat 11 | :myway 12 | :cl-annot 13 | :trivial-types 14 | :clack-errors 15 | :djula 16 | :log4cl 17 | :alexandria 18 | :cl-mustache 19 | :local-time) 20 | :components ((:module "src" 21 | :components 22 | ((:file "app") 23 | (:file "http") 24 | (:file "views") 25 | (:file "control") 26 | (:file "lucerne") 27 | (:file "skeleton")))) 28 | :description "A Clack-based microframework." 29 | :long-description 30 | #.(uiop:read-file-string 31 | (uiop:subpathname *load-pathname* "README.md")) 32 | :in-order-to ((test-op (test-op lucerne-test)))) 33 | -------------------------------------------------------------------------------- /skeleton/README.md: -------------------------------------------------------------------------------- 1 | # {{name}} 2 | {{#description}} 3 | 4 | {{description}} 5 | 6 | {{/description}} 7 | # Overview 8 | 9 | # Usage 10 | 11 | # License 12 | 13 | Copyright (c) {{year}} {{author}} 14 | 15 | Licensed under the {{license}} License. 16 | -------------------------------------------------------------------------------- /skeleton/asdf-test.lisp: -------------------------------------------------------------------------------- 1 | (defsystem {{name}}-test 2 | :author "{{#email}}{{author}} <{{email}}>{{/email}}{{^email}}{{author}}{{/email}}" 3 | {{#license}}:license "{{license}}"{{/license}} 4 | :description "Tests for {{name}}." 5 | :depends-on (:{{name}} 6 | :fiveam) 7 | :components ((:module "t" 8 | :serial t 9 | :components 10 | ((:file "{{name}}"))))) 11 | -------------------------------------------------------------------------------- /skeleton/asdf.lisp: -------------------------------------------------------------------------------- 1 | (defsystem {{name}} 2 | :author "{{#email}}{{author}} <{{email}}>{{/email}}{{^email}}{{author}}{{/email}}" 3 | :maintainer "{{#email}}{{author}} <{{email}}>{{/email}}{{^email}}{{author}}{{/email}}" 4 | {{#license}}:license "{{license}}"{{/license}} 5 | :version "0.1" 6 | {{#ghuser}} 7 | :homepage "https://github.com/{{ghuser}}/{{name}}" 8 | :bug-tracker "https://github.com/{{ghuser}}/{{name}}/issues" 9 | :source-control (:git "git@github.com:{{ghuser}}/{{name}}.git"){{/ghuser}} 10 | :depends-on (:lucerne{{dependencies}}) 11 | {{#sassp}} 12 | :defsystem-depends-on (:asdf-linguist) 13 | {{/sassp}} 14 | :components ((:module "assets" 15 | :components 16 | ((:module "css" 17 | :components 18 | ({{#sassp}}(:sass "style"){{/sassp}}{{^sassp}}(:static-file "style.css"){{/sassp}})) 19 | (:module "js" 20 | :components 21 | ((:static-file "scripts.js"))))) 22 | (:module "src" 23 | :serial t 24 | :components 25 | ((:file "{{name}}")))) 26 | :description "{{description}}" 27 | :long-description 28 | #.(uiop:read-file-string 29 | (uiop:subpathname *load-pathname* "README.md")) 30 | :in-order-to ((test-op (test-op {{name}}-test)))) 31 | -------------------------------------------------------------------------------- /skeleton/assets/css/style.css: -------------------------------------------------------------------------------- 1 | @charset "utf-8"; 2 | 3 | *, *:after, *:before { 4 | margin: 0; 5 | padding: 0; 6 | -webkit-box-sizing: border-box; 7 | -moz-box-sizing: border-box; 8 | box-sizing: border-box; 9 | } 10 | 11 | html { 12 | height: 100vh; 13 | margin: 0; 14 | padding: 0; 15 | } 16 | -------------------------------------------------------------------------------- /skeleton/assets/css/style.scss: -------------------------------------------------------------------------------- 1 | @charset "utf-8"; 2 | 3 | /* Variables */ 4 | 5 | $text-font-size: 1.2em; 6 | 7 | $mobile-size: 768px; 8 | 9 | /* Mixins */ 10 | 11 | @mixin on-desktop() { 12 | /* Style for large devices */ 13 | @media (min-width: $mobile-size) { 14 | @content; 15 | } 16 | } 17 | 18 | @mixin on-mobile() { 19 | /* Style for mobile devices */ 20 | @media (max-width: $mobile-size) { 21 | @content; 22 | } 23 | } 24 | 25 | /* Style */ 26 | 27 | *, *:after, *:before { 28 | margin: 0; 29 | padding: 0; 30 | -webkit-box-sizing: border-box; 31 | -moz-box-sizing: border-box; 32 | box-sizing: border-box; 33 | } 34 | 35 | html { 36 | height: 100vh; 37 | margin: 0; 38 | padding: 0; 39 | } 40 | -------------------------------------------------------------------------------- /skeleton/assets/js/scripts.js: -------------------------------------------------------------------------------- 1 | /* JavaScript */ 2 | -------------------------------------------------------------------------------- /skeleton/docs/manifest.lisp: -------------------------------------------------------------------------------- 1 | (:docstring-markup-format :scriba 2 | :systems ({{name}}) 3 | :documents ((:title "{{name}} Manual" 4 | :authors ("{{author}}") 5 | :output-format (:type :multi-html 6 | :template :minima) 7 | :sources ("manual.scr")))) 8 | -------------------------------------------------------------------------------- /skeleton/docs/manual.scr: -------------------------------------------------------------------------------- 1 | @begin(section) 2 | @title(Overview) 3 | {{#description}} 4 | 5 | {{description}} 6 | 7 | {{/description}} 8 | @end(section) 9 | 10 | @begin(section) 11 | @title(API Reference) 12 | 13 | 14 | 15 | @end(section) 16 | 17 | -------------------------------------------------------------------------------- /skeleton/gitignore.txt: -------------------------------------------------------------------------------- 1 | *.fasl 2 | *.dx32fsl 3 | *.dx64fsl 4 | *.lx32fsl 5 | *.lx64fsl 6 | *.x86f 7 | *~ 8 | .#* 9 | docs/build/ 10 | -------------------------------------------------------------------------------- /skeleton/src/source.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-user) 2 | (defpackage {{name}} 3 | (:use :cl :lucerne) 4 | (:export :app) 5 | (:documentation "Main {{name}} code.")) 6 | (in-package :{{name}}) 7 | (annot:enable-annot-syntax) 8 | 9 | ;;; App 10 | 11 | (defapp app 12 | :middlewares ((clack.middleware.static: 13 | :root (asdf:system-relative-pathname :{{name}} #p"assets/") 14 | :path "/static/"))) 15 | 16 | ;;; Templates 17 | 18 | (djula:add-template-directory 19 | (asdf:system-relative-pathname :{{name}} #p"templates/")) 20 | 21 | (defparameter +index+ (djula:compile-template* "index.html")) 22 | 23 | ;;; Views 24 | 25 | @route app "/" 26 | (defview index () 27 | (render-template (+index+))) 28 | -------------------------------------------------------------------------------- /skeleton/t/test.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-user) 2 | (defpackage {{name}}-test 3 | (:use :cl :fiveam)) 4 | (in-package :{{name}}-test) 5 | 6 | (def-suite tests 7 | :description "{{name}} tests.") 8 | (in-suite tests) 9 | 10 | (test simple-test 11 | (is 12 | (equal 1 1)) 13 | (is-true 14 | (and t t))) 15 | 16 | (run! 'tests) 17 | -------------------------------------------------------------------------------- /skeleton/templates/base.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | {% include "includes/head.html" %} 4 | 5 | {% block content %}{% endblock %} 6 | 7 | 8 | -------------------------------------------------------------------------------- /skeleton/templates/includes/head.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | {% if title %} 7 | {{ title }} – {{name}} 8 | {% else %} 9 | {{name}} 10 | {% endif %} 11 | 12 | 13 | 14 | 15 | -------------------------------------------------------------------------------- /skeleton/templates/index.html: -------------------------------------------------------------------------------- 1 | {% extends "base.html" %} 2 | 3 | {% block content %} 4 |

Welcome to Lucerne!

5 | {% endblock %} 6 | -------------------------------------------------------------------------------- /skeleton/travis.yml: -------------------------------------------------------------------------------- 1 | language: common-lisp 2 | sudo: required 3 | 4 | env: 5 | matrix: 6 | - LISP=sbcl COVERALLS=true 7 | 8 | install: 9 | # Install cl-travis 10 | - curl https://raw.githubusercontent.com/luismbo/cl-travis/master/install.sh | bash 11 | # Coveralls support 12 | - git clone https://github.com/fukamachi/cl-coveralls ~/lisp/cl-coveralls 13 | 14 | script: 15 | - cl -l fiveam -l cl-coveralls 16 | -e '(setf fiveam:*debug-on-error* t)' 17 | -e '(setf *debugger-hook* 18 | (lambda (c h) 19 | (declare (ignore c h)) 20 | (uiop:quit -1)))' 21 | -e '(coveralls:with-coveralls (:exclude (list "t")) 22 | (ql:quickload :{{name}}-test))' 23 | 24 | {{#email}} 25 | notifications: 26 | email: 27 | - {{email}} 28 | {{/email}} 29 | -------------------------------------------------------------------------------- /src/app.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-user) 2 | (defpackage lucerne.app 3 | (:use :cl :trivial-types :cl-annot) 4 | (:export :prefix-mount 5 | :prefix 6 | :base-app 7 | : 8 | :routes 9 | :middlewares 10 | :sub-apps 11 | :handler 12 | :register 13 | :use 14 | :build-app 15 | :defapp) 16 | (:documentation "Here we define the class foundations of Lucerne. There are 17 | applications, which have routes, middleware and sub-applications. 18 | 19 | Routes map a particular URL pattern and HTTP method to a function that takes a 20 | request and returns a response to the client. 21 | 22 | Middleware is what we all know and love: An item of Clack middleware is a class 23 | that wraps a request to perform some preprocessing, or regular processing. For 24 | example, serving files, guarding against CSRF attacks, etc. 25 | 26 | Sub applications give us the ability to compose different applications. For 27 | example, you can have an `admin` application which implements an administration 28 | panel, and has its own middleware (For serving the CSS and JS used by the 29 | panel). You can integrate this application into your own simply by adding it as 30 | a sub-application under a mount point (Most typically '/admin/'). The ability to 31 | painlessly compose applications is extremely valuable, as it allows you to 32 | easily modularize an application, and even separate some functionality into a 33 | completely separate library. 34 | 35 | Lucerne applications are not strictly the same as Clack applications: Rather 36 | than applying middleware and mounting sub-applications when an app is defined, 37 | those things are kept in slots. When an application is started, Lucerne 38 | recursively tranverses the tree of nested applications and sub-applications, 39 | mounts them all together, and ensures all their middleware is applied.")) 40 | (in-package :lucerne.app) 41 | 42 | (defclass mount-point () ()) 43 | 44 | (defclass prefix-mount () 45 | ((prefix :reader prefix 46 | :initarg :prefix 47 | :type string) 48 | (app :reader app 49 | :initarg :app 50 | :type base-app)) 51 | (:documentation "Maps a prefix to a sub-application.")) 52 | 53 | (defclass base-app (clack:) 54 | ((routes :accessor routes 55 | :initform (myway:make-mapper) 56 | :type myway.mapper:mapper 57 | :documentation "The application's routes.") 58 | (middlewares :accessor middlewares 59 | :initarg :middlewares 60 | :initform nil 61 | :type list 62 | :documentation "List of middlewares the application will run.") 63 | (sub-apps :accessor sub-apps 64 | :initarg :sub-apps 65 | :initform nil 66 | :type (proper-list mount-point) 67 | :documentation "A list of sub-application mount points.") 68 | (handler :accessor handler 69 | :initform nil 70 | :documentation "The server handler.")) 71 | (:documentation "The base class for all Lucerne applications.")) 72 | 73 | (defmethod register ((app base-app) prefix (sub-app base-app)) 74 | "Mount `sub-app` to `app` on the prefix `prefix`." 75 | (push (make-instance 'prefix-mount 76 | :prefix prefix 77 | :app sub-app) 78 | (sub-apps app))) 79 | 80 | (defmethod use ((app base-app) middleware) 81 | "Make `app` use the middleware instance `middleware`." 82 | (push middleware (middlewares app))) 83 | 84 | ;;; Internals 85 | 86 | (defun apply-middlewares-list (app middleware-list) 87 | "Apply the middlewares in `middleware-list` to `app`, returning a new app." 88 | (if middleware-list 89 | (clack:wrap (first middleware-list) 90 | (apply-middlewares-list app (rest middleware-list))) 91 | app)) 92 | 93 | (defun apply-mounts (app) 94 | "Recursively go through an app, mounting sub-applications to their prefix URLs 95 | and returning the resulting mounted app." 96 | (if (sub-apps app) 97 | (let ((resulting-app (make-instance 'clack.app.urlmap:))) 98 | (clack.app.urlmap:mount resulting-app "/" app) 99 | (loop for mount-point in (sub-apps app) do 100 | (clack.app.urlmap:mount resulting-app 101 | (prefix mount-point) 102 | (build-app (app mount-point)))) 103 | resulting-app) 104 | app)) 105 | 106 | (defmethod build-app ((app base-app)) 107 | "Take a Lucerne application, and recursively mount sub-applications and apply 108 | middleware." 109 | (apply-middlewares-list (apply-mounts app) (middlewares app))) 110 | 111 | ;;; Application definition 112 | 113 | (defmacro defapp (name &key middlewares sub-apps (class ''base-app)) 114 | "Define an application." 115 | (alexandria:with-gensyms (app) 116 | `(defparameter ,name 117 | (let ((,app (make-instance ,class))) 118 | ;; Use the middlewares 119 | ,@(loop for mw in middlewares collecting 120 | (if (listp mw) 121 | ;; The middleware is a list, so we splice in a make-instance 122 | `(use ,app (make-instance ',(first mw) ,@(rest mw))) 123 | ;; The middleware is just a class name with no arguments 124 | `(use ,app (make-instance ',mw)))) 125 | ;; Register the sub-applications 126 | ,@(loop for sub-app in sub-apps collecting 127 | `(register ,app ,(first sub-app) ,(second sub-app))) 128 | ,app)))) 129 | -------------------------------------------------------------------------------- /src/control.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-user) 2 | (defpackage lucerne.ctl 3 | (:use :cl) 4 | (:import-from :lucerne.app 5 | :base-app 6 | :handler 7 | :build-app) 8 | (:export :start 9 | :stop) 10 | (:documentation "Lucerne keeps a database of running applications and their 11 | port numbers. This is useful when loading a system that starts a Lucerne 12 | application, but either does not shut it down or fails to do so because of an 13 | error -- This is particularly common in testing. By using this system, we don't 14 | leak ports and prevent 'address in use' errors.")) 15 | (in-package :lucerne.ctl) 16 | 17 | (defmethod start ((app base-app) &key (port 8000) (server :hunchentoot) (address "127.0.0.1") debug silent) 18 | "Bring up @cl:param(app), by default on @cl:param(port) 8000. If the server 19 | was not running, it returns @c(T). If the server was running, it restarts it and 20 | returns @c(NIL)." 21 | (let ((rebooted nil)) 22 | (when (handler app) 23 | ;; The handler already exists, meaning the server is running. Bring it 24 | ;; down before bringing it up again. 25 | (setf rebooted t) 26 | (clack:stop (handler app))) 27 | (setf (handler app) 28 | (clack:clackup 29 | (lack:builder (let ((clack-app (build-app app))) 30 | (if debug 31 | (funcall clack-errors:*clack-error-middleware* 32 | clack-app 33 | :debug t) 34 | clack-app))) 35 | :port port 36 | :server server 37 | :address address 38 | :use-default-middlewares nil 39 | :silent silent)) 40 | (sleep 1) 41 | ;; If it was rebooted, return nil. Otherwise t. 42 | (not rebooted))) 43 | 44 | (defmethod stop ((app base-app)) 45 | "If @cl:param(app) is running, stop it and return @c(T). Otherwise, do nothing 46 | and return @c(NIL)." 47 | (if (handler app) 48 | ;; The handler exists, so the app is up and running. Stop it, and return t. 49 | (progn 50 | (clack:stop (handler app)) 51 | (sleep 1) 52 | (setf (handler app) nil) 53 | t) 54 | ;; Not running 55 | nil)) 56 | -------------------------------------------------------------------------------- /src/http.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-user) 2 | (defpackage lucerne.http 3 | (:use :cl) 4 | (:import-from :clack.request 5 | :parameter 6 | :env) 7 | (:export :*request* 8 | :respond 9 | :redirect 10 | :session 11 | :with-params 12 | :render-template)) 13 | (in-package :lucerne.http) 14 | 15 | (defvar *request* nil 16 | "The current request. This will be bound in the body of a view through a 17 | lexical let.") 18 | 19 | (defun respond (body &key (type "text/html;charset=utf-8") (status 200)) 20 | "Construct a response from a @cl:param(body), content @cl:param(type) and 21 | @cl:param(status) code." 22 | (list status 23 | (list :content-type type) 24 | (typecase body 25 | (string (list body)) 26 | (otherwise body)))) 27 | 28 | (defun redirect (url &key (status 302)) 29 | "Redirect a user to @cl:param(url), optionally specifying a status code 30 | @cl:param(status) (302 by default)." 31 | (list status 32 | (list :location url) 33 | (list ""))) 34 | 35 | (defmacro session () 36 | "Extract the session hash table from the request object." 37 | `(getf (env *request*) :clack.session)) 38 | 39 | (defmacro with-params (params &body body) 40 | "Extract the parameters in @cl:param(param) from the @c(*request*), and bind 41 | them for use in @cl:param(body)." 42 | `(let ,(loop for param in params collecting 43 | `(,param (let ((str (parameter *request* 44 | ,(intern (string-downcase 45 | (symbol-name param)) 46 | :keyword)))) 47 | (if (equal str "") 48 | nil 49 | str)))) 50 | ,@body)) 51 | 52 | (defmacro render-template ((template) &rest args) 53 | "Render a Djula template @cl:param(template-name) passing arguments 54 | @cl:param(args)." 55 | `(respond (djula:render-template* ,template 56 | nil 57 | ,@args))) 58 | -------------------------------------------------------------------------------- /src/lucerne.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-user) 2 | (defpackage lucerne 3 | (:use :cl :lucerne.http :lucerne.ctl) 4 | (:import-from :lucerne.app 5 | :base-app 6 | :defapp 7 | :register 8 | :use) 9 | (:import-from :lucerne.views 10 | :not-found 11 | :defview 12 | :route) 13 | (:export :base-app 14 | :defapp 15 | :register 16 | :use 17 | :*request* 18 | :respond 19 | :redirect 20 | :session 21 | :with-params 22 | :render-template 23 | :not-found 24 | :defview 25 | :*request* 26 | :route 27 | :start 28 | :stop)) 29 | (in-package :lucerne) 30 | -------------------------------------------------------------------------------- /src/skeleton.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-user) 2 | (defpackage lucerne.skeleton 3 | (:use :cl) 4 | (:export :make-project) 5 | (:documentation "Lucerne project skeleton generator.")) 6 | (in-package :lucerne.skeleton) 7 | 8 | ;;; Utilities 9 | 10 | (defparameter +skeleton-directory+ 11 | (asdf:system-relative-pathname :lucerne #p"skeleton/")) 12 | 13 | (defun skeleton-to-file (skeleton-file target-file directory plist-data) 14 | (let ((skeleton-pathname (merge-pathnames skeleton-file 15 | +skeleton-directory+)) 16 | (target-pathname (merge-pathnames target-file 17 | directory))) 18 | (let ((target-directory (uiop:pathname-directory-pathname target-pathname))) 19 | (ensure-directories-exist target-directory)) 20 | (with-open-file (output-stream target-pathname 21 | :direction :output 22 | :if-exists :supersede 23 | :if-does-not-exist :create) 24 | (format t ";; Writing ~A~%" target-pathname) 25 | (mustache:render (uiop:read-file-string skeleton-pathname) 26 | (alexandria:plist-alist plist-data) 27 | output-stream)))) 28 | 29 | (defun strip-whitespace (string) 30 | (string-trim '(#\Space #\Tab) string)) 31 | 32 | (defun parse-systems-list (systems-list) 33 | (loop for system-name 34 | in (remove-if (lambda (x) (string= "" x)) 35 | (split-sequence:split-sequence #\, systems-list)) 36 | collecting 37 | (strip-whitespace system-name))) 38 | 39 | ;;; Generate 40 | 41 | (defun make-project () 42 | "Generate a project by interactively asking questions." 43 | (flet ((ask (format-string &rest args) 44 | (let ((string (apply #'format (append (list nil format-string) 45 | args)))) 46 | (format t "~%~A: " string) 47 | (finish-output nil) 48 | (read-line))) 49 | (yes-or-no (format-string &rest args) 50 | (apply #'yes-or-no-p (cons format-string args)))) 51 | (let* ((name (ask "Project name (e.g. 'my-app')")) 52 | (author (ask "Author's full name")) 53 | (email (ask "Author's email")) 54 | (license (ask "License (e.g. 'MIT', 'GPLv3')")) 55 | (description (ask "One-line project description")) 56 | (dependencies (parse-systems-list 57 | (ask "Dependencies (e.g. 'drakma, quri, clack')"))) 58 | (sassp (yes-or-no "Use Sass as the CSS preprocessor?")) 59 | (travisp (yes-or-no "Use Travis for continuous integration?")) 60 | (gitignorep (yes-or-no "Add .gitignore?")) 61 | (githubp (yes-or-no "Do you have a GitHub username?")) 62 | (github-user (if githubp 63 | (ask "GitHub username") 64 | nil)) 65 | (parent-directory (uiop:ensure-directory-pathname 66 | (parse-namestring 67 | (ask "Finally, where do we put the project directory? (e.g. '/code/lisp/' will put the project in '/code/lisp/~A')" 68 | name)))) 69 | (directory (merge-pathnames (make-pathname :directory (list :relative name)) 70 | parent-directory)) 71 | (plist (list :name name 72 | :author author 73 | :email email 74 | :license license 75 | :description description 76 | ;; Format the deps for the sys. def. file 77 | :dependencies (format nil "~{~^~% :~A~}" 78 | dependencies) 79 | :sassp sassp 80 | :travisp travisp 81 | :ghuser github-user 82 | ;; For the README 83 | :year (write-to-string 84 | (local-time:timestamp-year 85 | (local-time:now)))))) 86 | (flet ((generate (skeleton target &rest args) 87 | (apply #'skeleton-to-file (list skeleton 88 | target 89 | directory 90 | (append plist args))))) 91 | ;; Ensure directories exist 92 | (loop for dir in (list #p"src/" #p"t/" #p"docs/") do 93 | (ensure-directories-exist (merge-pathnames dir 94 | directory))) 95 | ;; The README 96 | (generate #p"README.md" #p"README.md") 97 | ;; The .gitignore 98 | (when gitignorep 99 | (generate #p"gitignore.txt" #p".gitignore")) 100 | ;; Source code 101 | (generate #p"asdf.lisp" (parse-namestring 102 | (format nil "~A.asd" name))) 103 | (generate #p"src/source.lisp" (parse-namestring 104 | (format nil "src/~A.lisp" name))) 105 | ;; Tests 106 | (generate #p"asdf-test.lisp" (parse-namestring 107 | (format nil "~A-test.asd" name))) 108 | (generate #p"t/test.lisp" (parse-namestring 109 | (format nil "t/~A.lisp" name))) 110 | ;; Templates 111 | (generate #p"templates/base.html" #p"templates/base.html") 112 | (generate #p"templates/includes/head.html" #p"templates/includes/head.html") 113 | (generate #p"templates/index.html" #p"templates/index.html") 114 | ;; Assets 115 | (if sassp 116 | (generate #p"assets/css/style.scss" #p"assets/css/style.scss") 117 | (generate #p"assets/css/style.css" #p"assets/css/style.css")) 118 | (generate #p"assets/js/scripts.js" #p"assets/js/scripts.js") 119 | ;; Documentation 120 | (generate #p"docs/manifest.lisp" #p"docs/manifest.lisp") 121 | (generate #p"docs/manual.scr" #p"docs/manual.scr") 122 | t)))) 123 | -------------------------------------------------------------------------------- /src/views.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-user) 2 | (defpackage lucerne.views 3 | (:use :cl :trivial-types :cl-annot) 4 | (:import-from :clack.request 5 | :make-request 6 | :request-method 7 | :script-name 8 | :request-uri) 9 | (:export :not-found 10 | :define-route 11 | :defview 12 | :route)) 13 | (in-package :lucerne.views) 14 | 15 | (defmethod not-found ((app lucerne.app:base-app)) 16 | "The basic not found screen: Returns HTTP 404 and the text 'Not found'." 17 | (lucerne.http:respond "Not found" :type "text/plain" :status 404)) 18 | 19 | (defun strip-app-prefix-and-query-string (url app-prefix) 20 | (subseq url 21 | (max 0 (1- (length app-prefix))) 22 | (position #\? url))) 23 | 24 | (defmethod clack:call ((app lucerne.app:base-app) env) 25 | "Routes the request determined by @cl:param(env) on the application 26 | @cl:param(app)." 27 | (let* ((req (make-request env)) 28 | (method (request-method req)) 29 | (prefix (script-name req)) 30 | (uri (request-uri req)) 31 | (final-uri (strip-app-prefix-and-query-string uri prefix)) 32 | ;; Now, we actually do the dispatching 33 | (route (myway:dispatch (lucerne.app:routes app) 34 | final-uri 35 | :method method))) 36 | (if route 37 | ;; We have a hit 38 | (funcall route req) 39 | ;; Not found 40 | (let ((lucerne.http:*request* req)) 41 | (not-found app))))) 42 | 43 | (defmethod define-route ((app lucerne.app:base-app) url method fn) 44 | "Map @cl:param(method) calls to @cl:param(url) in @cl:param(app) to the 45 | function @cl:param(fn)." 46 | (myway:connect (lucerne.app:routes app) 47 | url 48 | (lambda (params) 49 | ;; Dispatching returns a function that closes over `params` 50 | (lambda (req) 51 | (let ((lucerne.http:*request* req)) 52 | (funcall fn params)))) 53 | :method method)) 54 | 55 | (annot:defannotation route (app config body) (:arity 3) 56 | (if (atom config) 57 | ;; The config is just a URL 58 | `(progn 59 | (lucerne.views:define-route ,app 60 | ,config 61 | :get 62 | ,body)) 63 | ;; The config is a ( ) pair 64 | `(progn 65 | (lucerne.views:define-route ,app 66 | ,(second config) 67 | ,(first config) 68 | ,body)))) 69 | 70 | (defmacro defview (name (&rest args) &body body) 71 | "Define a view. The body of the view implicitly has access to the global 72 | request object @c(*request*)." 73 | (alexandria:with-gensyms (params) 74 | `(defun ,(intern (symbol-name name)) (,params) 75 | ,(unless args 76 | `(declare (ignore ,params))) 77 | ;; Here, we extract arguments from the params plist into the arguments 78 | ;; defined in the argument list 79 | (let ,(mapcar #'(lambda (arg) 80 | `(,arg (getf ,params ,(intern (symbol-name arg) 81 | :keyword)))) 82 | args) 83 | ,@body)))) 84 | -------------------------------------------------------------------------------- /t/examples.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-user) 2 | (defpackage lucerne-test.examples 3 | (:use :cl :lucerne :fiveam) 4 | (:import-from :lucerne-test 5 | :+port+ 6 | :make-url) 7 | (:export :examples)) 8 | (in-package :lucerne-test.examples) 9 | 10 | ;;; Utilities 11 | 12 | (defmacro response-ok (&rest arguments) 13 | `(multiple-value-bind (body status-code &rest other) 14 | (drakma:http-request ,@arguments) 15 | (declare (ignore body other)) 16 | (is 17 | (equal status-code 200)))) 18 | 19 | ;;; Tests 20 | 21 | (def-suite examples 22 | :description "Test Lucerne examples.") 23 | (in-suite examples) 24 | 25 | (test hello-world 26 | (finishes 27 | (lucerne:start lucerne-hello-world:app :port +port+)) 28 | (is (equal (drakma:http-request (make-url "")) 29 | "Hello, world!")) 30 | (finishes 31 | (lucerne:stop lucerne-hello-world:app))) 32 | 33 | (test utweet 34 | ;; Create some test data 35 | (let ((john (utweet.models:register-user :username "john" 36 | :full-name "John Doe" 37 | :email "jdoe@initech.com" 38 | :password "pass")) 39 | (jane (utweet.models:register-user :username "jane" 40 | :full-name "Jane Doe" 41 | :email "j.doe@initech.com" 42 | :password "pass")) 43 | (user (utweet.models:register-user :username "user" 44 | :full-name "Test User" 45 | :email "test@example.com" 46 | :password "pass"))) 47 | ;; Follow 48 | (finishes 49 | (utweet.models:follow user john) 50 | (utweet.models:follow user jane)) 51 | ;; Add some tweets 52 | (finishes 53 | (utweet.models:tweet john "BEEP BOOP feed me followers") 54 | (utweet.models:tweet jane "boop beep i'm a test tweet")) 55 | ;; Test the models are consistent 56 | (is 57 | (equal (hash-table-count utweet.models::*users*) 58 | 3)) 59 | (is 60 | (equal (length utweet.models::*subscriptions*) 61 | 2)) 62 | (is 63 | (equal (length utweet.models::*tweets*) 64 | 2)) 65 | ;; Bring up the app 66 | (finishes 67 | (lucerne:start utweet.views:app :port +port+)) 68 | ;; Requests 69 | (is-true 70 | (search "Sign up" 71 | (drakma:http-request (make-url "")))) 72 | ;; Create an account 73 | (response-ok (make-url "signup") 74 | :method :post 75 | :parameters (list (cons "username" "eudoxia") 76 | (cons "name" "Fernando") 77 | (cons "email" "eudoxiahp@gmail.com") 78 | (cons "password" "pass") 79 | (cons "password-repeat" "pass"))) 80 | (finishes 81 | (utweet.models:follow (utweet.models:find-user "eudoxia") john) 82 | (utweet.models:follow (utweet.models:find-user "eudoxia") jane)) 83 | (let ((cookie-jar (make-instance 'drakma:cookie-jar))) 84 | ;; Log in 85 | (response-ok (make-url "signin") 86 | :method :post 87 | :parameters (list (cons "username" "eudoxia") 88 | (cons "password" "pass")) 89 | :cookie-jar cookie-jar) 90 | ;; View the timeline 91 | (response-ok (make-url "") 92 | :cookie-jar cookie-jar) 93 | ;; View the profile 94 | (response-ok (make-url "profile/eudoxia") 95 | :cookie-jar cookie-jar) 96 | ;; Followers and following 97 | (response-ok (make-url "followers/eudoxia") 98 | :cookie-jar cookie-jar) 99 | (response-ok (make-url "following/eudoxia") 100 | :cookie-jar cookie-jar) 101 | ;; Send a tweet 102 | (response-ok (make-url "tweet") 103 | :method :post 104 | :parameters (list (cons "tweet" "test")) 105 | :cookie-jar cookie-jar) 106 | (is 107 | (equal (length utweet.models::*tweets*) 108 | 3)) 109 | ;; Log out 110 | (response-ok (make-url "signout") 111 | :cookie-jar cookie-jar)) 112 | ;; Bring it down 113 | (lucerne:stop utweet.views:app))) 114 | -------------------------------------------------------------------------------- /t/final.lisp: -------------------------------------------------------------------------------- 1 | (in-package :lucerne-test) 2 | 3 | (defun run-tests () 4 | (run! 'basic) 5 | (run! 'subapps) 6 | (run! 'lucerne-test.examples:examples) 7 | (run! 'lucerne-test.skeleton:skeleton)) 8 | -------------------------------------------------------------------------------- /t/lucerne.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-user) 2 | (defpackage lucerne-test 3 | (:use :cl :lucerne :fiveam) 4 | (:export :+port+ 5 | :make-url 6 | :run-tests)) 7 | (in-package :lucerne-test) 8 | (annot:enable-annot-syntax) 9 | 10 | (defparameter +port+ 4545) 11 | 12 | (defun make-url (rest) 13 | (concatenate 'string 14 | (format nil "http://localhost:~A/" +port+) 15 | rest)) 16 | 17 | (def-suite basic 18 | :description "Basic tests.") 19 | (in-suite basic) 20 | 21 | (defapp app) 22 | 23 | (test define-routes 24 | (finishes 25 | @route app "/" 26 | (defview index () 27 | (respond "

Welcome to Lucerne

"))) 28 | (finishes 29 | @route app "/greet/:name" 30 | (defview greet (name) 31 | (respond (format nil "Hello, ~A!" name)))) 32 | (finishes 33 | @route app "/add/:a/:b" 34 | (defview add-numbers (a b) 35 | (respond (format nil "~A" (+ (parse-integer a) 36 | (parse-integer b)))))) 37 | (finishes 38 | @route app "/unicode" 39 | (defview unicode-test () 40 | (respond "😸"))) 41 | (finishes 42 | @route app "/redirect" 43 | (defview redirect-test () 44 | (redirect (make-url "")))) 45 | (finishes 46 | @route app (:post "/post") 47 | (defview post-test () 48 | (with-params (a b) 49 | (respond (format nil "~A ~A" a b))))) 50 | (finishes 51 | @route app "/binary" 52 | (defview binary-test () 53 | (respond (coerce '(1 2 3) '(vector (unsigned-byte 8))) 54 | :type "application/octet-stream")))) 55 | 56 | (test (bring-up :depends-on define-routes) 57 | (is-true 58 | ;; Starting the server for the first time 59 | (start app :port +port+)) 60 | (is-false 61 | ;; Restarting the server 62 | (start app :port +port+))) 63 | 64 | (test (views-work :depends-on bring-up) 65 | (is 66 | (equal "

Welcome to Lucerne

" 67 | (drakma:http-request (make-url "")))) 68 | (is 69 | (equal "Hello, eudoxia!" 70 | (drakma:http-request (make-url "greet/eudoxia")))) 71 | (is 72 | (equal "2" 73 | (drakma:http-request (make-url "add/1/1")))) 74 | (is 75 | (equal "😸" 76 | (drakma:http-request (make-url "unicode")))) 77 | (is-true 78 | (puri:uri= (puri:uri (make-url "")) 79 | (multiple-value-bind (body status params uri &rest others) 80 | (drakma:http-request (make-url "redirect")) 81 | uri))) 82 | (is 83 | (equal "1 2" 84 | (drakma:http-request (make-url "post") 85 | :method :post 86 | :parameters '(("a" . "1") 87 | ("b" . "2"))))) 88 | (is 89 | (equalp #(1 2 3) 90 | (drakma:http-request (make-url "binary")))) 91 | (is 92 | (equal "Not found" 93 | (drakma:http-request (make-url "no-such-view"))))) 94 | 95 | (test (bring-down :depends-on bring-up) 96 | (is-true 97 | ;; Stop the app 98 | (stop app)) 99 | (is-false 100 | ;; Try to stop it again, should do nothing and return NIL 101 | (stop app))) 102 | 103 | (defapp error-app) 104 | 105 | @route error-app "/" 106 | (defun error-view () 107 | (error "test")) 108 | 109 | (test clack-errors 110 | (is-true 111 | (start error-app :port +port+ :debug t)) 112 | (multiple-value-bind (body status &rest others) 113 | (drakma:http-request (make-url "")) 114 | (declare (ignore body others)) 115 | (is 116 | (equal status 500))) 117 | (is-true 118 | (stop error-app))) 119 | -------------------------------------------------------------------------------- /t/skeleton.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-user) 2 | (defpackage lucerne-test.skeleton 3 | (:use :cl :fiveam) 4 | (:export :skeleton)) 5 | (in-package :lucerne-test.skeleton) 6 | 7 | (def-suite skeleton 8 | :description "Project skeleton tests.") 9 | (in-suite skeleton) 10 | 11 | (defparameter +directory+ 12 | (asdf:system-relative-pathname :lucerne #p"t/")) 13 | 14 | (defparameter +input+ "app 15 | author 16 | email 17 | license 18 | desc 19 | a,b,c 20 | ~A 21 | yes 22 | yes 23 | yes 24 | github-user 25 | ~A 26 | ") 27 | 28 | (defparameter +files+ 29 | (list #p"README.md" 30 | #p".gitignore" 31 | #p"app.asd" 32 | #p"app-test.asd" 33 | #p"src/app.lisp" 34 | #p"t/app.lisp" 35 | #p"templates/base.html" 36 | #p"templates/includes/head.html" 37 | #p"templates/index.html" 38 | #p"docs/manifest.lisp" 39 | #p"docs/manual.scr" 40 | #p"assets/js/scripts.js")) 41 | 42 | (test generate 43 | (loop for sass-option in (list "yes" "no") do 44 | (let ((input (format nil +input+ sass-option +directory+))) 45 | (with-input-from-string (input-stream input) 46 | (let ((*query-io* (make-two-way-stream input-stream *standard-output*)) 47 | (*standard-input* input-stream) 48 | (app-directory (merge-pathnames #p"app/" 49 | +directory+))) 50 | (finishes 51 | (lucerne.skeleton:make-project)) 52 | (loop for file in +files+ do 53 | (is-true 54 | (probe-file (merge-pathnames file app-directory)))) 55 | (is-true 56 | (if (string= sass-option "yes") 57 | (probe-file (merge-pathnames #p"assets/css/style.scss" app-directory)) 58 | (probe-file (merge-pathnames #p"assets/css/style.css" app-directory)))) 59 | (when (probe-file app-directory) 60 | (uiop:delete-directory-tree app-directory :validate t))))))) 61 | -------------------------------------------------------------------------------- /t/subapps.lisp: -------------------------------------------------------------------------------- 1 | (in-package :lucerne-test) 2 | (annot:enable-annot-syntax) 3 | 4 | (def-suite subapps 5 | :description "Application composition tests.") 6 | (in-suite subapps) 7 | 8 | ;;; The structure of the apps looks like this 9 | ;;; 10 | ;;; / : parent 11 | ;;; /s1/ 12 | ;;; / : sub-app 13 | ;;; /s/ : sub-sub-app 14 | ;;; /s2/ 15 | ;;; / : sub-app-2 16 | 17 | (defapp sub-sub-app) 18 | 19 | @route sub-sub-app "/" 20 | (defview sub-sub-app-index () 21 | (respond "sub sub app")) 22 | 23 | (defapp subapp-1 24 | :sub-apps (("/s" sub-sub-app))) 25 | 26 | (defapp subapp-2) 27 | 28 | @route subapp-1 "/" 29 | (defview subapp-1-index () 30 | (respond "sub app 1")) 31 | 32 | @route subapp-2 "/" 33 | (defview subapp-2-index () 34 | (respond "sub app 2")) 35 | 36 | (defapp parent-app 37 | :sub-apps (("/s1" subapp-1) 38 | ("/s2" subapp-2))) 39 | 40 | @route parent-app "/" 41 | (defview parent-index () 42 | (respond "main app")) 43 | 44 | (test bring-up-subapps 45 | (is-true 46 | (start parent-app :port +port+))) 47 | 48 | (test sub-apps-work 49 | (is 50 | (equal "main app" 51 | (drakma:http-request (make-url "")))) 52 | (is 53 | (equal "sub app 1" 54 | (drakma:http-request (make-url "s1/")))) 55 | ;(is 56 | ; (equal "sub app 2" 57 | ; (drakma:http-request (make-url "s2/"))) 58 | ) 59 | 60 | (test bring-down-subapps 61 | (is-true 62 | (stop parent-app))) 63 | --------------------------------------------------------------------------------