rowdy (empty) → 0.0.1.0

raw patch · 7 files changed

+335/−0 lines, 7 filesdep +basedep +containersdep +dlistsetup-changed

Dependencies added: base, containers, dlist, hspec, mtl, rowdy

Files

ChangeLog.md +3/−0
LICENSE +30/−0
README.md +20/−0
Setup.hs +2/−0
rowdy.cabal +60/−0
src/Rowdy.hs +218/−0
test/Spec.hs +2/−0

+ ChangeLog.md view

@@ -0,0 +1,3 @@+# Changelog for rowdy++## Unreleased changes

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright Matt Parsons (c) 2018++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 Matt Parsons 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.

+ README.md view

@@ -0,0 +1,20 @@+# `rowdy`++The core routing DSL for `rowdy`.+Check the [GitHub repo](https://www.github.com/parsonsmatt/rowdy) for more+information and examples.++```haskell+-- Yesod-style:+routes = do+    get "RootR"+    "users" // do+        resource "UserIndexR" [get, post]+        capture @Int // resource "UserR" [get, put]+    "admin" // "Admin" /: do+        get "PanelR" ! "admin" ! "cool"+        post "PanelR" ! "admin"+    "other-attr" // "safe" /! do+        get "SafeR"+        put "SafeR"+```

+ Setup.hs view

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

+ rowdy.cabal view

@@ -0,0 +1,60 @@+-- This file has been generated from package.yaml by hpack version 0.20.0.+--+-- see: https://github.com/sol/hpack+--+-- hash: 5c5ecdee579e478bab8e04aaa93c637d98d610d3199449d2e522b2703a62b4ad++name:           rowdy+version:        0.0.1.0+synopsis:       An EDSL for web application routes.+description:    Please see the README on Github at <https://github.com/parsonsmatt/rowdy#readme>+category:       Web+homepage:       https://github.com/parsonsmatt/rowdy#readme+bug-reports:    https://github.com/parsonsmatt/rowdy/issues+author:         Matt Parsons+maintainer:     parsonsmatt@gmail.com+copyright:      2018 Matt Parsons+license:        BSD3+license-file:   LICENSE+build-type:     Simple+cabal-version:  >= 1.10++extra-source-files:+    ChangeLog.md+    README.md++source-repository head+  type: git+  location: https://github.com/parsonsmatt/rowdy++library+  hs-source-dirs:+      src+  ghc-options: -Wall -Wcompat+  build-depends:+      base >=4.7 && <5+    , containers+    , dlist+    , mtl+  exposed-modules:+      Rowdy+  other-modules:+      Paths_rowdy+  default-language: Haskell2010++test-suite specs+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  hs-source-dirs:+      test+  ghc-options: -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      base >=4.7 && <5+    , containers+    , dlist+    , hspec+    , mtl+    , rowdy+  other-modules:+      Paths_rowdy+  default-language: Haskell2010

+ src/Rowdy.hs view

@@ -0,0 +1,218 @@+{-# LANGUAGE AllowAmbiguousTypes        #-}+{-# LANGUAGE DeriveFoldable             #-}+{-# LANGUAGE DeriveFunctor              #-}+{-# LANGUAGE FlexibleInstances          #-}+{-# LANGUAGE GADTs                      #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE RankNTypes                 #-}+{-# LANGUAGE ScopedTypeVariables        #-}+{-# LANGUAGE TypeSynonymInstances       #-}++-- | Rowdy is a DSL for defining web routes. The DSL is only a nice syntax for+-- expressing the tree-like structure of routes -- to actually interpret the+-- route into something useful, you'll need another package.+--+-- @rowdy-yesod@ provides a function that converts this representation into the+-- Yesod route format, allowing you to drop the quasiquotater and use a plain+-- Haskell DSL.+--+-- @rowdy-servant@ provides a function that converts the DSL into Servant's type+-- level DSL for defining routes. This allows you to work with a value-level+-- DSL, taking full advantage of Haskell's value level programming, and then+-- promote the DSL to the type level using Template Haskell.+module Rowdy where++import           Control.Monad.Writer+import           Data.DList           (DList (..))+import qualified Data.DList           as DList++-- | A 'RouteDsl' is a type useful for constructing web routes. At it's heart,+-- it is a DSL for constructing a 'RouteTree', and is totally optional.+--+-- Routes are defined by how they handle @nest@ing, what sorts of values are+-- used to represent @capture@s, and what values are used to represent+-- endpoints.+--+-- @since 0.0.1.0+newtype RouteDsl nest capture terminal a = RouteDsl+    { unRouteDsl :: Writer (DForest nest capture terminal) a+    } deriving+    ( Functor, Applicative, Monad+    , MonadWriter (DForest nest capture terminal)+    )++-- | Run the given 'RouteDsl' and convert it into the 'Forest' of routes. If you+-- are defining an interpreter for a web framework, you will want to call this+-- on the 'RouteDsl' value.+--+-- @since 0.0.1.0+runRouteDsl :: RouteDsl n c e a -> Forest n c e+runRouteDsl =+    DList.toList . execWriter . unRouteDsl++-- | Run the given 'RouteDsl' and convert it into a 'DList' of routes. This is+-- useful when implementing combinators.+--+-- @since 0.0.1.0+runRouteDsl' :: RouteDsl n c e a -> DForest n c e+runRouteDsl' = execWriter . unRouteDsl++-- | Introduce a @capture@ into all of the routes defined in the second+-- argument. This function does not introduce nesting, so multiple distinct+-- routes will be created.+--+-- As an example:+--+-- @+-- example :: RouteDsl nest String String ()+-- example =+--     'pathComponent' "hello" $ do+--         'terminal' "first route"+--         'terminal' "second route"+-- @+--+-- Calling @'runRouteDsl' example@ will give a data structure like:+--+-- @+-- [ 'PathComponent' "hello" ('Leaf' "first route")+-- , 'PathComponent' "hello" ('Leaf' "second route")+-- ]+-- @+--+-- @since 0.0.1.0+pathComponent+    :: capture+    -> RouteDsl nest capture endpoint ()+    -> RouteDsl nest capture endpoint ()+pathComponent pp =+    tell . fmap (PathComponent pp) . runRouteDsl'++-- | An infix operator for 'pathComponent'.+--+-- @since 0.0.1.0+(//)+    :: capture+    -> RouteDsl nest capture endpoint ()+    -> RouteDsl nest capture endpoint ()+(//) = pathComponent++infixr 5 //++-- | Introduce a nesting point in the route DSL. While the 'pathComponent'+-- function adds the @capture@ to each route defined in the second argument,+-- this one preserves the tree-like structure of the declaration.+--+-- @+-- example :: 'RouteDsl' String String String ()+-- example =+--     'pathComponent' "thing" $ 'nest' "hello" $ do+--          terminal "first"+--          terminal "second"+-- @+--+-- Calling @'runRouteDsl' example@ would give a data structure like:+--+-- @+-- [ 'PathComponent' "thing" ('Nest'+--     [ Leaf "first"+--     , Leaf "second"+--     ]+--   )+-- ]+-- @+--+-- In constrast, if 'nest' were not called, you would see the 'PathComponent'+-- repeated and distributed to both endpoints.+--+-- @since 0.0.1.0+nest+    :: nest+    -> RouteDsl nest capture endpoint ()+    -> RouteDsl nest capture endpoint ()+nest str = tell . pure . Nest str . runRouteDsl++-- | An infix operator alias for 'nest'.+--+-- @since 0.0.1.0+(/:)+    :: nest+    -> RouteDsl nest capture endpoint ()+    -> RouteDsl nest capture endpoint ()+(/:) = nest++infixr 7 /:++-- | Record the given @endpoint@ as a route.+--+-- @since 0.0.1.0+terminal :: endpoint -> RouteDsl nest capture endpoint ()+terminal = tell . pure . Leaf++-- | Convert a 'RouteTree' into a flattened list of routes. Each @terminal@ is+-- paired with the list of @capture@s that preceeded it.+--+-- @since 0.0.1.0+unnest :: RouteTree nest capture terminal -> [([capture], terminal)]+unnest = go mempty+  where+    go caps (Leaf term) =+        [(DList.toList caps, term)]+    go caps (PathComponent cap next) =+        go (DList.snoc caps cap) next+    go caps (Nest _ xs) =+        concatMap (go caps) xs+++-- | For efficiency's sake, we encode the route DSL as a 'DList' while defining+-- them, and (for convenience's sake) we present them as an ordinary list when+-- you run it. To prevent type complexity, we parameterize the forest on how+-- we're working with it.+--+-- @since 0.0.1.0+type ForestOf f n capture terminal = f (RouteTree n capture terminal)++-- | A difference list ('DList') of 'RouteTree' values.+--+-- @since 0.0.1.0+type DForest n c t = ForestOf DList n c t++-- | A list of 'RouteTree' values.+--+-- @since 0.0.1.0+type Forest n c t = ForestOf [] n c t++-- | The core data type that is produced by the 'RouteDsl'. If you'd prefer+-- a non-monadic interface to creating these, you're welcome to use the+-- constructors directly.+--+-- The DSL defined as @example@ below has the route representation given by+-- @desugared@:+--+-- @+-- example :: 'Forest' String String String+-- example = 'runRouteDsl' $ do+--     "hello" // do+--         'terminal' "world"+--         'terminal' "friend"+--         "nest" /: do+--             'terminal' "nope"+--             'terminal' "yes"+--+-- desugared :: 'Forest' String String String+-- desugared =+--     [ 'PathComponent' "hello" ('Leaf' "world")+--     , 'PathComponent' "hello" ('Leaf' "friend")+--     , 'PathComponent' "hello" ('Nest' "nest"+--         [ 'Leaf' "nope"+--         , 'Leaf' "yes"+--         ]+--       )+--     ]+-- @+--+-- @since 0.0.1.0+data RouteTree nest capture terminal+    = Leaf terminal+    | PathComponent capture (RouteTree nest capture terminal)+    | Nest nest [RouteTree nest capture terminal]+    deriving (Eq, Show, Functor, Foldable)

+ test/Spec.hs view

@@ -0,0 +1,2 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}+