├── .gitignore ├── .hlint.yaml ├── .stylish-haskell.yaml ├── LICENSE ├── README.md ├── TODO.md ├── bash └── build ├── cabal.project.local ├── mad-src └── recursion-schemes.mad ├── recursion-scheme-generator.cabal ├── shake.hs ├── src └── Main.hs └── web-src ├── index.html └── styles.css /.gitignore: -------------------------------------------------------------------------------- 1 | dist 2 | dist-newstyle 3 | shake 4 | .shake 5 | target 6 | tags 7 | dist 8 | dist-newstyle 9 | doc 10 | *.o 11 | *.hi 12 | *.chi 13 | *.chs.h 14 | *.dyn_o 15 | *.dyn_hi 16 | .hpc 17 | .hsenv 18 | .cabal-sandbox/ 19 | cabal.sandbox.config 20 | *.prof 21 | *.aux 22 | *.hp 23 | *.eventlog 24 | .stack-work/ 25 | cabal.project.local 26 | .HTF/ 27 | .shake 28 | *.jsexe 29 | -------------------------------------------------------------------------------- /.hlint.yaml: -------------------------------------------------------------------------------- 1 | --- 2 | - functions: 3 | - {name: unsafePerformIO, within: []} # unsafePerformIO can appear nowhere 4 | - {name: error, within: []} # throw real errors 5 | - {name: undefined, within: []} 6 | - {name: fromJust, within: []} # this is hell to track down 7 | - {name: foldl, within: []} # foldl has bad properties 8 | - error: {lhs: "hylo embed", rhs: "ana", name: "Use anamorphism"} 9 | - error: {lhs: "hylo f project", rhs: "cata f", name: "Use catamorphism"} 10 | - error: {lhs: "concat", rhs: "join", name: "Generalize concat"} 11 | - error: {lhs: "concatMap", rhs: "(=<<)", name: "Generalize concatMap"} 12 | - error: {lhs: "f >> pure ()", rhs: "void f", name: "Use void"} 13 | -------------------------------------------------------------------------------- /.stylish-haskell.yaml: -------------------------------------------------------------------------------- 1 | --- 2 | steps: 3 | - simple_align: 4 | cases: true 5 | top_level_patterns: true 6 | records: true 7 | - imports: 8 | align: global 9 | list_align: after_alias 10 | pad_module_names: true 11 | long_list_align: inline 12 | empty_list_align: inherit 13 | list_padding: 4 14 | separate_lists: true 15 | space_surround: false 16 | - language_pragmas: 17 | style: vertical 18 | align: true 19 | remove_redundant: false 20 | 21 | - trailing_whitespace: {} 22 | columns: 80 23 | newline: native 24 | language_extensions: [] 25 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright Vanessa McHale (c) 2017-2019 2 | 3 | Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 4 | 5 | 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 6 | 7 | 2. 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. 8 | 9 | 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. 10 | 11 | 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 HOLDER 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. 12 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # recursion scheme generator 2 | 3 | Try it out [here](http://vmchale.com/recursion-scheme-generator/index.html). 4 | Written using the [miso](https://haskell-miso.org) framework and the 5 | [Madlang](https://github.com/vmchale/madlang) text-generation language. 6 | 7 | ## Testing 8 | 9 | If you would like to edit the Madlang source file, the suggested workflow is: 10 | 11 | ``` 12 | madlang run mad-src/recursion-schemes.mad | cowthink -W 80 13 | ``` 14 | 15 | ## Contents 16 | 17 | ``` 18 | ─────────────────────────────────────────────────────────────────────────────── 19 | Language Files Lines Code Comments Blanks 20 | ─────────────────────────────────────────────────────────────────────────────── 21 | Cabal 1 43 39 0 4 22 | Cabal Project 1 2 2 0 0 23 | CSS 1 32 28 0 4 24 | Haskell 2 150 121 0 29 25 | HTML 1 10 10 0 0 26 | Madlang 1 102 79 1 22 27 | Markdown 2 36 30 0 6 28 | YAML 2 36 35 0 1 29 | ─────────────────────────────────────────────────────────────────────────────── 30 | Total 11 411 344 1 66 31 | ─────────────────────────────────────────────────────────────────────────────── 32 | ``` 33 | -------------------------------------------------------------------------------- /TODO.md: -------------------------------------------------------------------------------- 1 | - [ ] if statements to insert hypens between vowels (?) 2 | - [ ] show full filename incl. relative directory 3 | - [ ] strip duplicates! 4 | - [ ] specify orderings? 5 | -------------------------------------------------------------------------------- /bash/build: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env bash 2 | 3 | "$(fd 'script$' -t x -I)" "$@" 4 | -------------------------------------------------------------------------------- /cabal.project.local: -------------------------------------------------------------------------------- 1 | optimization: 2 2 | constraints: madlang +library 3 | -------------------------------------------------------------------------------- /mad-src/recursion-schemes.mad: -------------------------------------------------------------------------------- 1 | :define both-cata 2 | 1.0 "para" 3 | 1.0 "prepro" 4 | 1.0 "zygo" 5 | 1.0 "histo" 6 | 1.0 "mutu" 7 | 0.5 "synchro" 8 | 0.5 "dendro" 9 | 10 | :define cata-body 11 | 1.0 "cata" 12 | 13 | :define prefix-cata-fn 14 | 1.0 "mono" 15 | 16 | :define prefix-cata 17 | 0.065 prefix-cata-fn 18 | 1.0 both-cata 19 | 20 | :category cata 21 | | cata-body 22 | | both-cata 23 | 24 | :define both-ana 25 | 1.0 "apo" 26 | 1.0 "postpro" 27 | 1.0 "futu" 28 | 0.5 "chema" 29 | 30 | :define ana-body 31 | 1.0 "ana" 32 | 33 | :define prefix-ana-fn 34 | 1.0 "epi" 35 | 36 | :category ana 37 | | ana-body 38 | | both-ana 39 | 40 | :define prefix-ana 41 | 1.0 both-ana 42 | 0.065 prefix-ana-fn 43 | 44 | :define both-hylo 45 | 1.0 "chrono" 46 | 0.5 "meta" 47 | 0.5 "symplecto" 48 | 0.5 "pata" 49 | 0.2 "scolio" 50 | 51 | :define hylo-body 52 | 1.0 "hylo" 53 | 54 | :define prefix-hylo-fn 55 | 1.0 "endo" 56 | 57 | :category hylo 58 | | hylo-body 59 | | both-hylo 60 | 61 | :define prefix-hylo 62 | 1.0 both-hylo 63 | 0.065 prefix-hylo-fn 64 | 65 | :category prefix 66 | | prefix-hylo 67 | | prefix-cata 68 | | prefix-ana 69 | 70 | :define monadic 71 | 0.07 "Mendler-style " 72 | 0.07 "Elgot " 73 | 0.03 "septuafoliate " 74 | 75 | 1.00 "monadic " 76 | 1.75 "generalized " 77 | 0.10 "generalized monadic " 78 | 2.5 "" 79 | 80 | # TODO no duplication 81 | :define scheme 82 | 83 | # three-prefixed morphisms 84 | 1.0 monadic prefix-ana prefix-ana "morphic " ana "morphism" 85 | 1.0 monadic prefix-cata prefix-cata "morphic " cata "morphism" 86 | 1.3 monadic prefix prefix-hylo "morphic " hylo "morphism" 87 | 88 | # twi-prefixed morphisms 89 | 2.0 monadic prefix-cata "morphic " cata "morphism" 90 | 2.0 monadic prefix-ana "morphic " ana "morphism" 91 | 2.6 monadic prefix "morphic " hylo "morphism" 92 | 93 | # one-prefixed morphisms 94 | 0.7 monadic ana "morphism" 95 | 0.7 monadic hylo "morphism" 96 | 0.91 monadic cata "morphism" 97 | 98 | # bullshit for boring people 99 | 0.01 "fold" 100 | 101 | :return 102 | 1.0 scheme 103 | -------------------------------------------------------------------------------- /recursion-scheme-generator.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 1.18 2 | name: recursion-scheme-generator 3 | version: 0.1.0.0 4 | license: BSD3 5 | license-file: LICENSE 6 | copyright: Copyright: (c) 2017-2019 Vanessa McHale 7 | maintainer: vamchale@gmail.com 8 | author: Vanessa McHale 9 | synopsis: Recursion scheme generator 10 | description: 11 | Recursion scheme generator with web frontend, written with Miso and Madlang 12 | category: Web 13 | build-type: Simple 14 | extra-source-files: 15 | mad-src/recursion-schemes.mad 16 | extra-doc-files: README.md 17 | 18 | source-repository head 19 | type: git 20 | location: https://github.com/vmchale/recursion-scheme-generator 21 | 22 | flag development 23 | description: 24 | Enable `-Werror` 25 | default: False 26 | manual: True 27 | 28 | executable recursion-scheme-generator 29 | main-is: Main.hs 30 | hs-source-dirs: src 31 | default-language: Haskell2010 32 | ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall 33 | -Wincomplete-uni-patterns -Wincomplete-record-updates -Wcompat 34 | build-depends: 35 | base >=4.7 && <5, 36 | miso >=0.9.0.0, 37 | madlang >=4.0.0.0, 38 | text -any, 39 | containers -any, 40 | file-embed -any 41 | 42 | if flag(development) 43 | ghc-options: -Werror 44 | -------------------------------------------------------------------------------- /shake.hs: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env cabal 2 | {- cabal: 3 | build-depends: base, shake, shake-cabal, shake-google-closure-compiler, shake-ext, directory, strict, shake-minify-css 4 | default-language: Haskell2010 5 | -} 6 | 7 | import Development.Shake 8 | import Development.Shake.Cabal 9 | import Development.Shake.ClosureCompiler 10 | import Development.Shake.FileDetect 11 | import Development.Shake.Linters 12 | import Development.Shake.MinifyCSS 13 | import System.Directory 14 | import qualified System.IO.Strict as Strict 15 | 16 | main :: IO () 17 | main = shakeArgs shakeOptions { shakeFiles = ".shake", shakeLint = Just LintBasic } $ do 18 | want [ "target/index.html", "README.md" ] 19 | 20 | "deploy" ~> do 21 | need [ "target/index.html", "target/all.min.js" ] 22 | cmd ["bash", "-c", "cp target/* ~/programming/rust/nessa-site/static/recursion-scheme-generator"] 23 | 24 | "clean" ~> do 25 | unit $ cmd ["rm", "-rf", "tags", "build", "mad-src/tags"] 26 | removeFilesAfter "target" ["//*"] 27 | removeFilesAfter "dist" ["//*"] 28 | removeFilesAfter "dist-newstyle" ["//*"] 29 | removeFilesAfter ".shake" ["//*"] 30 | 31 | "README.md" %> \out -> do 32 | let getThisDirectory = getDirectoryFiles "" 33 | hs <- getHs ["src"] 34 | yaml <- getYml 35 | mad <- getMadlang 36 | cabal <- getThisDirectory ["//*.cabal"] 37 | html <- getThisDirectory ["web-src//*.html"] 38 | css <- getThisDirectory ["web-src//*.css"] 39 | need $ hs <> yaml <> cabal <> mad <> html <> css 40 | (Stdout out') <- cmd ["poly", "-c"] 41 | file <- liftIO $ Strict.readFile "README.md" 42 | let header = takeWhile (/= replicate 79 '─') $ lines file 43 | let new = unlines header ++ out' ++ "```\n" 44 | liftIO $ writeFile out new 45 | 46 | "dist-newstyle/build/x86_64-linux/ghcjs-8.6.0.1/recursion-scheme-generator-0.1.0.0/x/recursion-scheme-generator/opt/build/recursion-scheme-generator/recursion-scheme-generator.jsexe/all.js" %> \_ -> do 47 | need ["cabal.project.local"] 48 | need . snd =<< getCabalDepsA "recursion-scheme-generator.cabal" 49 | madlang =<< getMadlang 50 | cmd ["cabal", "new-build", "--ghcjs"] 51 | 52 | googleClosureCompiler ["dist-newstyle/build/x86_64-linux/ghcjs-8.6.0.1/recursion-scheme-generator-0.1.0.0/x/recursion-scheme-generator/opt/build/recursion-scheme-generator/recursion-scheme-generator.jsexe/all.js"] "target/all.min.js" 53 | 54 | minifyCSSRules "web-src/styles.css" "target/styles.css" 55 | 56 | "target/index.html" %> \out -> do 57 | need ["target/all.min.js", "target/styles.css"] 58 | copyFile' "web-src/index.html" out 59 | -------------------------------------------------------------------------------- /src/Main.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | {-# LANGUAGE QuasiQuotes #-} 3 | {-# LANGUAGE RecordWildCards #-} 4 | {-# LANGUAGE TemplateHaskell #-} 5 | 6 | module Main 7 | ( main 8 | ) where 9 | 10 | 11 | import qualified Data.Map as M 12 | import qualified Data.Set as S 13 | import Data.Text (Text) 14 | import Miso hiding (Key) 15 | import Miso.String 16 | import Numeric (showHex) 17 | import Text.Madlibs (madFile, run) 18 | 19 | randomText :: IO Text 20 | randomText = run $(madFile "mad-src/recursion-schemes.mad") 21 | 22 | type Key = Int 23 | 24 | type PreAttribute = (MisoString, MisoString) 25 | 26 | type Model = Text 27 | 28 | data Action 29 | = Regenerate 30 | | Write Text 31 | | NoOp 32 | 33 | main :: IO () 34 | main = startApp App {..} 35 | where 36 | mountPoint = Nothing 37 | initialAction = NoOp 38 | model = "" 39 | update = updateModel 40 | view = viewModel 41 | events = defaultEvents 42 | subs = [ keyboardSub keypress ] 43 | 44 | backgroundStyle :: [Attribute action] 45 | backgroundStyle = [ style_ $ M.fromList [ color 0x4d4d4d, leftMargin 15, topMargin 15 ] ] 46 | where leftMargin :: Int -> PreAttribute 47 | leftMargin i = ("margin-left", showMiso i <> "%") 48 | topMargin :: Int -> PreAttribute 49 | topMargin i = ("margin-top", showMiso i <> "%") 50 | color :: Int -> PreAttribute 51 | color c = ("color", "#" <> toMisoString (showHex c mempty)) 52 | 53 | defaultFonts :: MisoString 54 | defaultFonts = "\"Comic Sans MS\", Helvetica, sans-serif" 55 | 56 | showMiso :: Show a => a -> MisoString 57 | showMiso = toMisoString . show 58 | 59 | sizedFont :: Int -> [Attribute action] 60 | sizedFont i = [ style_ $ M.singleton "font" (showMiso i <> "px " <> defaultFonts) ] 61 | 62 | buttonTraits :: [Attribute action] 63 | buttonTraits = class_ "button" : sizedFont 50 64 | 65 | updateModel :: Action -> Model -> Effect Action Model 66 | updateModel Regenerate m = m <# fmap Write randomText 67 | updateModel (Write t) _ = noEff t 68 | updateModel NoOp m = noEff m 69 | 70 | keypress :: S.Set Key -> Action 71 | keypress keys = if keyR `elem` S.toList keys then Regenerate else NoOp 72 | where keyR = 82 73 | 74 | viewModel :: Model -> View Action 75 | viewModel x = div_ backgroundStyle 76 | [ 77 | p_ largeFont [ text "Press 'another' or push 'r' for a new recursion scheme" ] 78 | , p_ [] [ div_ (onClick Regenerate : buttonTraits) [ text "another" ] ] 79 | , p_ fontStyles [ text (toMisoString x) ] 80 | , p_ [] [ footer ] 81 | ] 82 | 83 | where largeFont = sizedFont 20 84 | fontStyles = sizedFont 30 85 | 86 | footerParagraph :: [Attribute action] 87 | footerParagraph = [ style_ $ M.fromList [("align", "bottom"), ("position", "absolute"), ("bottom", "200px")] ] 88 | 89 | footer :: View Action 90 | footer = footer_ [ class_ "info" ] 91 | [ p_ footerParagraph 92 | [ a_ [ href_ "https://github.com/vmchale/recursion-schemata" ] [ text "source" ] ] ] 93 | -------------------------------------------------------------------------------- /web-src/index.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | Recursion-scheme-generator 5 | 6 | 7 | 8 | 9 | 10 | 11 | -------------------------------------------------------------------------------- /web-src/styles.css: -------------------------------------------------------------------------------- 1 | body { 2 | background-color: #f5f5f5 3 | } 4 | 5 | a { 6 | color: #4d4d4d; 7 | text-decoration: none; 8 | font: 15px "Comic Sans MS", Helvetica, sans-serif; 9 | } 10 | 11 | a:hover { 12 | color: #003d99; 13 | } 14 | 15 | .button:hover { 16 | color: #800000; 17 | } 18 | 19 | .button { 20 | -webkit-user-select: none; 21 | -moz-user-select: none; 22 | -ms-user-select: none; 23 | background-color: #f5f5f5; 24 | border: none; 25 | color: #4d4d4d; 26 | padding: 0px 0px; 27 | text-decoration: none; 28 | display: inline-block; 29 | font-size: 30px; 30 | margin: 0px 0px; 31 | cursor: pointer; 32 | } 33 | --------------------------------------------------------------------------------