Shpadoinkle-disembodied (empty) → 0.0.0.1
raw patch · 6 files changed
+345/−0 lines, 6 filesdep +Shpadoinkledep +Shpadoinkle-backend-staticdep +Shpadoinkle-html
Dependencies added: Shpadoinkle, Shpadoinkle-backend-static, Shpadoinkle-html, Shpadoinkle-router, base, directory, filepath, servant, text, unliftio
Files
- CHANGELOG.md +0/−0
- LICENSE +27/−0
- README.md +31/−0
- Shpadoinkle-disembodied.cabal +42/−0
- Shpadoinkle/Disembodied.hs +197/−0
- Shpadoinkle/Disembodied/Sample.hs +48/−0
+ CHANGELOG.md view
+ LICENSE view
@@ -0,0 +1,27 @@+Shpadoinkle Disembodied aka S11 Disembodied+Copyright © 2020 Isaac Shapira+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 Shpadoinkle nor the names of its 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,31 @@+# Shpadoinkle Disembodied++[](https://gitlab.com/fresheyeball/Shpadoinkle)+[](https://shpadoinkle.org/disembodied)+[](https://opensource.org/licenses/BSD-3-Clause)+[](https://builtwithnix.org)+[](https://hackage.haskell.org/package/Shpadoinkle-disembodied)+[](http://packdeps.haskellers.com/reverse/Shpadoinkle-disembodied)+[](https://matrix.hackage.haskell.org/#/package/Shpadoinkle-disembodied)++This module provides static site generation tools for Html.++## Usage++Lets say you have the following API routes for you SPA application:++```haskell+type Pages m+ = "about" :> View m Int+ :<|> View m ()+```++And you have a view for each. You can now produce a `SiteSpec` mapping these routes to the views.++```haskell+site :: SiteSpec () (Pages m)+site = about 0 :<|> const home+```++Which can be written to static pages with `writeSite`. Each route will become a directory,+and each View will become an `index.html` file in that directory.
+ Shpadoinkle-disembodied.cabal view
@@ -0,0 +1,42 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.33.0.+--+-- see: https://github.com/sol/hpack+--+-- hash: c9dcea41cbf0ee840bc68d0b857f3bf7b71f5d173c808dcd6c800cf9c9c11fc4++name: Shpadoinkle-disembodied+version: 0.0.0.1+synopsis: Shpadoinkle as a static site.+description: Static site backed SPA applications.+category: Web+author: Isaac Shapira+maintainer: fresheyeball@protonmail.com+license: BSD3+license-file: LICENSE+build-type: Simple+extra-source-files:+ README.md+ CHANGELOG.md++library+ exposed-modules:+ Shpadoinkle.Disembodied+ other-modules:+ Shpadoinkle.Disembodied.Sample+ hs-source-dirs:+ ./.+ ghc-options: -Wall -Wcompat -fwarn-redundant-constraints -fwarn-incomplete-uni-patterns -fwarn-tabs -fwarn-incomplete-record-updates -fwarn-identities+ build-depends:+ Shpadoinkle+ , Shpadoinkle-backend-static+ , Shpadoinkle-html+ , Shpadoinkle-router+ , base >=4.12.0 && <4.16+ , directory+ , filepath+ , servant+ , text >=1.2.3 && <1.3+ , unliftio+ default-language: Haskell2010
+ Shpadoinkle/Disembodied.hs view
@@ -0,0 +1,197 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+++{-|+ Static sites are the opposite of headless applications, they are disembodied.+ Shpadoinkle Disembodied is a static site generator for Shpadoinkle applications.+-}+++module Shpadoinkle.Disembodied (+ -- * Site Reification+ Site(..)+ -- * Class+ , Disembodied(..)+ -- * Write Files+ , writeSite+ ) where+++import Control.Monad (void)+import Data.Kind (Type)+import Data.Proxy (Proxy (..))+import Data.Text (unpack)+import Data.Text.IO as T (writeFile)+import Servant.API+import System.Directory (createDirectoryIfMissing)+import System.FilePath ((<.>), (</>))+import UnliftIO.Async (concurrently, forConcurrently_)++import GHC.TypeLits (KnownSymbol, symbolVal)+import Shpadoinkle (Html)+import Shpadoinkle.Backend.Static (renderStatic)+import Shpadoinkle.Router (HTML, View)+++-- | The reification of a static site based on Servant routes.+-- Site takes a context `ctx` which is universal for the static site.+-- This is useful for storing commonly used valus like the site name,+-- site url, copyright date, ect.+data Site ctx where++ -- | A path segment in the URI+ SPath+ :: String+ -- ^ The current URI path segment+ -> Site ctx+ -- ^ The site to be rendered at the path+ -> Site ctx++ -- | Html to be rendered as @index.html@+ SIndex+ :: forall m a ctx+ . (ctx -> Html m a)+ -- ^ Given a context, how can we render a page?+ -> Site ctx++ -- | Capture is the one Servant combinator that can be meaningful in static+ -- site generation, and only if we can generate all possible instances.+ SCapture+ :: (FromHttpApiData x, ToHttpApiData x, Bounded x, Enum x)+ => (x -> Site ctx)+ -- ^ Given a context, provide the remaining site to be generated+ -> Site ctx++ -- | Branch the site at a given point in generation.+ SChoice :: Site ctx -> Site ctx -> Site ctx++++-- | Type class induction for building the site out of a specification+class Disembodied ctx a where+ -- | A type family to represent the relationship between a Servant API+ -- and the 'Html' views to render.+ --+ -- @+ -- type SPA m = "about" :> Html m ()+ -- :\<|\> Html m ()+ --+ -- site :: SiteSpec () (SPA m)+ -- site = const (h1_ [ text "about" ])+ -- :\<|\> const (h1_ [ text "home" ])+ -- @+ type SiteSpec ctx a :: Type++ -- | Construct the site structure out of the associated API+ buildSite :: SiteSpec ctx a -> Site ctx++instance (Disembodied ctx x, Disembodied ctx y)+ => Disembodied ctx (x :<|> y) where++ type SiteSpec ctx (x :<|> y) = SiteSpec ctx x :<|> SiteSpec ctx y++ buildSite :: SiteSpec ctx x :<|> SiteSpec ctx y -> Site ctx+ buildSite (x :<|> y) = SChoice (buildSite @ctx @x x) (buildSite @ctx @y y)+ {-# INLINABLE buildSite #-}++instance (Disembodied ctx sub, KnownSymbol path)+ => Disembodied ctx (path :> sub) where++ type SiteSpec ctx (path :> sub) = SiteSpec ctx sub++ buildSite :: SiteSpec ctx sub -> Site ctx+ buildSite = SPath (symbolVal (Proxy @path)) . buildSite @ctx @sub+ {-# INLINABLE buildSite #-}++instance (Disembodied ctx sub, FromHttpApiData x, ToHttpApiData x, Bounded x, Enum x)+ => Disembodied ctx (Capture sym x :> sub) where++ type SiteSpec ctx (Capture sym x :> sub) = x -> SiteSpec ctx sub++ buildSite :: (x -> SiteSpec ctx sub) -> Site ctx+ buildSite = SCapture . (buildSite @ctx @sub .)+ {-# INLINABLE buildSite #-}++instance Disembodied ctx sub+ => Disembodied ctx (QueryParam sym x :> sub) where++ type SiteSpec ctx (QueryParam sym x :> sub) = Maybe x -> SiteSpec ctx sub++ buildSite :: (Maybe x -> SiteSpec ctx sub) -> Site ctx+ buildSite f = buildSite @ctx @sub $ f Nothing+ {-# INLINABLE buildSite #-}++instance Disembodied ctx sub+ => Disembodied ctx (QueryParam' ms sym x :> sub) where++ type SiteSpec ctx (QueryParam' ms sym x :> sub) = Maybe x -> SiteSpec ctx sub++ buildSite :: (Maybe x -> SiteSpec ctx sub) -> Site ctx+ buildSite f = buildSite @ctx @sub $ f Nothing+ {-# INLINABLE buildSite #-}++instance Disembodied ctx sub+ => Disembodied ctx (QueryParams sym x :> sub) where++ type SiteSpec ctx (QueryParams sym x :> sub) = [x] -> SiteSpec ctx sub++ buildSite :: ([x] -> SiteSpec ctx sub) -> Site ctx+ buildSite f = buildSite @ctx @sub $ f []+ {-# INLINABLE buildSite #-}++instance Disembodied ctx sub+ => Disembodied ctx (QueryFlag sym :> sub) where++ type SiteSpec ctx (QueryFlag sym :> sub) = Bool -> SiteSpec ctx sub++ buildSite :: (Bool -> SiteSpec ctx sub) -> Site ctx+ buildSite f = buildSite @ctx @sub $ f False+ {-# INLINABLE buildSite #-}++instance Disembodied ctx (f '[HTML] (Html m a)) where++ type SiteSpec ctx (f '[HTML] (Html m a)) = ctx -> Html m a++ buildSite :: (ctx -> Html m a) -> Site ctx+ buildSite = SIndex+ {-# INLINABLE buildSite #-}++instance Disembodied ctx (View m a) where++ type SiteSpec ctx (View m a) = ctx -> Html m a++ buildSite :: (ctx -> Html m a) -> Site ctx+ buildSite = SIndex+ {-# INLINABLE buildSite #-}+++-- | Actually write the site to disk. Branches are written in parallel.+writeSite+ :: forall layout ctx. Disembodied ctx layout+ => FilePath+ -- ^ Out path+ -> ctx+ -- ^ Universal context for the static site.+ -> SiteSpec ctx layout+ -- ^ Specification for the pages of the site relative to a Servant API.+ -> IO ()+writeSite fs ctx layout = go fs $ buildSite @ctx @layout layout where++ go :: FilePath -> Site ctx -> IO ()+ go curr (SIndex page) = T.writeFile (curr </> "index" <.> "html") . renderStatic $ page ctx+ go curr (SChoice x y) = void $ go curr x `concurrently` go curr y+ go curr (SCapture f) = forConcurrently_ [ minBound .. maxBound ] $+ \c -> go curr $ SPath (unpack $ toUrlPiece c) $ f c+ go curr (SPath path site) = do+ createDirectoryIfMissing False (curr </> path)+ go (curr </> path) site
+ Shpadoinkle/Disembodied/Sample.hs view
@@ -0,0 +1,48 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeOperators #-}+{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}+++module Shpadoinkle.Disembodied.Sample where+++import Data.Text (Text)+import Servant.API++import Shpadoinkle (Html, JSM, MonadJSM, text)+import Shpadoinkle.Disembodied (Disembodied (SiteSpec), writeSite)+import Shpadoinkle.Html (button, h1_, onClick)+import Shpadoinkle.Router (View)+++type Pages m+ = "about" :> View m Int+ :<|> View m ()+++newtype Context = Context+ { siteName :: Text }+++about :: MonadJSM m => Context -> Html m Int+about ctx =+ h1_ [ text $ "about us at " <> siteName ctx+ , button+ [ onClick (+ 1) ]+ [ "Increment" ]+ ]+++home :: Html m a+home = h1_ [ "home" ]+++site :: MonadJSM m => SiteSpec Context (Pages m)+site = about :<|> const home+++makeSite :: IO ()+makeSite = writeSite @(Pages JSM) "" (Context "Sample") site