├── .github
    └── ISSUE_TEMPLATE
    │   └── plugin-idea.md
├── .gitignore
├── .stylish-haskell.yaml
├── .travis.yml
├── ChangeLog.md
├── DEVELOPERS.md
├── LICENSE
├── README.md
├── Setup.hs
├── app
    └── Main.hs
├── examples
    ├── git.md
    ├── python.md
    ├── template.html
    └── thut.md
├── integration-test
    ├── IntegrationTest
    │   └── ThutSpec.hs
    ├── PythonSpec.hs
    └── Spec.hs
├── package.yaml
├── sh
    └── rholang
├── shell.nix
├── src
    ├── Frost.hs
    ├── Frost
    │   ├── DefaultsMandatoryPlugin.hs
    │   ├── Effects
    │   │   ├── FileProvider.hs
    │   │   ├── Git.hs
    │   │   ├── Github.hs
    │   │   ├── Python.hs
    │   │   ├── Rholang.hs
    │   │   ├── Stack.hs
    │   │   ├── Sys.hs
    │   │   └── Thut.hs
    │   ├── PandocRun.hs
    │   ├── Plugin.hs
    │   ├── Plugins
    │   │   ├── GitContributorsPlugin.hs
    │   │   ├── LatestIssuesPlugin.hs
    │   │   ├── RholangPlugin.hs
    │   │   ├── StackPlugins.hs
    │   │   └── ThutPlugin.hs
    │   ├── PythonPlugin.hs
    │   └── TimestampPlugin.hs
    ├── FrostError.hs
    └── PolysemyContrib.hs
├── stack.yaml
└── test
    ├── Effects
        ├── GithubSpec.hs
        └── RholangSpec.hs
    ├── Frost
        └── Plugins
        │   └── GitContributorsPluginSpec.hs
    ├── Plugins
        └── LatestIssuesPluginSpec.hs
    ├── PythonSpec.hs
    ├── RunInputPandocSpec.hs
    ├── Spec.hs
    ├── StackSpec.hs
    └── TransformSpec.hs


/.github/ISSUE_TEMPLATE/plugin-idea.md:
--------------------------------------------------------------------------------
 1 | ---
 2 | name: Plugin Idea
 3 | about: Suggest an idea for another plugin
 4 | title: 'Plugin: <<name>>'
 5 | labels: plugin idea
 6 | assignees: ''
 7 | 
 8 | ---
 9 | 
10 | # Suggest plugin name
11 | Suggest a name for the plugin
12 | 
13 | # Overview
14 | A clear and concise description of how the plugin should work
15 | 
16 | # Example usage
17 | 
18 | ## Input
19 | Provide example input data
20 | 
21 | ## Output
22 | Provide desired output
23 | 


--------------------------------------------------------------------------------
/.gitignore:
--------------------------------------------------------------------------------
1 | .stack-work/
2 | frost.cabal
3 | *~
4 | stack.yaml.lock


--------------------------------------------------------------------------------
/.stylish-haskell.yaml:
--------------------------------------------------------------------------------
  1 | # stylish-haskell configuration file
  2 | # ==================================
  3 | 
  4 | # The stylish-haskell tool is mainly configured by specifying steps. These steps
  5 | # are a list, so they have an order, and one specific step may appear more than
  6 | # once (if needed). Each file is processed by these steps in the given order.
  7 | steps:
  8 |   # Convert some ASCII sequences to their Unicode equivalents. This is disabled
  9 |   # by default.
 10 |   # - unicode_syntax:
 11 |   #     # In order to make this work, we also need to insert the UnicodeSyntax
 12 |   #     # language pragma. If this flag is set to true, we insert it when it's
 13 |   #     # not already present. You may want to disable it if you configure
 14 |   #     # language extensions using some other method than pragmas. Default:
 15 |   #     # true.
 16 |   #     add_language_pragma: true
 17 | 
 18 |   # Align the right hand side of some elements.  This is quite conservative
 19 |   # and only applies to statements where each element occupies a single
 20 |   # line. All default to true.
 21 |   - simple_align:
 22 |       cases: true
 23 |       top_level_patterns: true
 24 |       records: true
 25 | 
 26 |   # Import cleanup
 27 |   - imports:
 28 |       # There are different ways we can align names and lists.
 29 |       #
 30 |       # - global: Align the import names and import list throughout the entire
 31 |       #   file.
 32 |       #
 33 |       # - file: Like global, but don't add padding when there are no qualified
 34 |       #   imports in the file.
 35 |       #
 36 |       # - group: Only align the imports per group (a group is formed by adjacent
 37 |       #   import lines).
 38 |       #
 39 |       # - none: Do not perform any alignment.
 40 |       #
 41 |       # Default: global.
 42 |       align: global
 43 | 
 44 |       # The following options affect only import list alignment.
 45 |       #
 46 |       # List align has following options:
 47 |       #
 48 |       # - after_alias: Import list is aligned with end of import including
 49 |       #   'as' and 'hiding' keywords.
 50 |       #
 51 |       #   > import qualified Data.List      as List (concat, foldl, foldr, head,
 52 |       #   >                                          init, last, length)
 53 |       #
 54 |       # - with_alias: Import list is aligned with start of alias or hiding.
 55 |       #
 56 |       #   > import qualified Data.List      as List (concat, foldl, foldr, head,
 57 |       #   >                                 init, last, length)
 58 |       #
 59 |       # - with_module_name: Import list is aligned `list_padding` spaces after
 60 |       #   the module name.
 61 |       #
 62 |       #   > import qualified Data.List      as List (concat, foldl, foldr, head,
 63 |       #                          init, last, length)
 64 |       #
 65 |       #   This is mainly intended for use with `pad_module_names: false`.
 66 |       #
 67 |       #   > import qualified Data.List as List (concat, foldl, foldr, head,
 68 |       #                          init, last, length, scanl, scanr, take, drop,
 69 |       #                          sort, nub)
 70 |       #
 71 |       # - new_line: Import list starts always on new line.
 72 |       #
 73 |       #   > import qualified Data.List      as List
 74 |       #   >     (concat, foldl, foldr, head, init, last, length)
 75 |       #
 76 |       # Default: after_alias
 77 |       list_align: after_alias
 78 | 
 79 |       # Right-pad the module names to align imports in a group:
 80 |       #
 81 |       # - true: a little more readable
 82 |       #
 83 |       #   > import qualified Data.List       as List (concat, foldl, foldr,
 84 |       #   >                                           init, last, length)
 85 |       #   > import qualified Data.List.Extra as List (concat, foldl, foldr,
 86 |       #   >                                           init, last, length)
 87 |       #
 88 |       # - false: diff-safe
 89 |       #
 90 |       #   > import qualified Data.List as List (concat, foldl, foldr, init,
 91 |       #   >                                     last, length)
 92 |       #   > import qualified Data.List.Extra as List (concat, foldl, foldr,
 93 |       #   >                                           init, last, length)
 94 |       #
 95 |       # Default: true
 96 |       pad_module_names: true
 97 | 
 98 |       # Long list align style takes effect when import is too long. This is
 99 |       # determined by 'columns' setting.
100 |       #
101 |       # - inline: This option will put as much specs on same line as possible.
102 |       #
103 |       # - new_line: Import list will start on new line.
104 |       #
105 |       # - new_line_multiline: Import list will start on new line when it's
106 |       #   short enough to fit to single line. Otherwise it'll be multiline.
107 |       #
108 |       # - multiline: One line per import list entry.
109 |       #   Type with constructor list acts like single import.
110 |       #
111 |       #   > import qualified Data.Map as M
112 |       #   >     ( empty
113 |       #   >     , singleton
114 |       #   >     , ...
115 |       #   >     , delete
116 |       #   >     )
117 |       #
118 |       # Default: inline
119 |       long_list_align: inline
120 | 
121 |       # Align empty list (importing instances)
122 |       #
123 |       # Empty list align has following options
124 |       #
125 |       # - inherit: inherit list_align setting
126 |       #
127 |       # - right_after: () is right after the module name:
128 |       #
129 |       #   > import Vector.Instances ()
130 |       #
131 |       # Default: inherit
132 |       empty_list_align: inherit
133 | 
134 |       # List padding determines indentation of import list on lines after import.
135 |       # This option affects 'long_list_align'.
136 |       #
137 |       # - <integer>: constant value
138 |       #
139 |       # - module_name: align under start of module name.
140 |       #   Useful for 'file' and 'group' align settings.
141 |       #
142 |       # Default: 4
143 |       list_padding: 4
144 | 
145 |       # Separate lists option affects formatting of import list for type
146 |       # or class. The only difference is single space between type and list
147 |       # of constructors, selectors and class functions.
148 |       #
149 |       # - true: There is single space between Foldable type and list of it's
150 |       #   functions.
151 |       #
152 |       #   > import Data.Foldable (Foldable (fold, foldl, foldMap))
153 |       #
154 |       # - false: There is no space between Foldable type and list of it's
155 |       #   functions.
156 |       #
157 |       #   > import Data.Foldable (Foldable(fold, foldl, foldMap))
158 |       #
159 |       # Default: true
160 |       separate_lists: true
161 | 
162 |       # Space surround option affects formatting of import lists on a single
163 |       # line. The only difference is single space after the initial
164 |       # parenthesis and a single space before the terminal parenthesis.
165 |       #
166 |       # - true: There is single space associated with the enclosing
167 |       #   parenthesis.
168 |       #
169 |       #   > import Data.Foo ( foo )
170 |       #
171 |       # - false: There is no space associated with the enclosing parenthesis
172 |       #
173 |       #   > import Data.Foo (foo)
174 |       #
175 |       # Default: false
176 |       space_surround: false
177 | 
178 |   # Language pragmas
179 |   - language_pragmas:
180 |       # We can generate different styles of language pragma lists.
181 |       #
182 |       # - vertical: Vertical-spaced language pragmas, one per line.
183 |       #
184 |       # - compact: A more compact style.
185 |       #
186 |       # - compact_line: Similar to compact, but wrap each line with
187 |       #   `{-#LANGUAGE #-}'.
188 |       #
189 |       # Default: vertical.
190 |       style: vertical
191 | 
192 |       # Align affects alignment of closing pragma brackets.
193 |       #
194 |       # - true: Brackets are aligned in same column.
195 |       #
196 |       # - false: Brackets are not aligned together. There is only one space
197 |       #   between actual import and closing bracket.
198 |       #
199 |       # Default: true
200 |       align: true
201 | 
202 |       # stylish-haskell can detect redundancy of some language pragmas. If this
203 |       # is set to true, it will remove those redundant pragmas. Default: true.
204 |       remove_redundant: true
205 | 
206 |   # Replace tabs by spaces. This is disabled by default.
207 |   # - tabs:
208 |   #     # Number of spaces to use for each tab. Default: 8, as specified by the
209 |   #     # Haskell report.
210 |   #     spaces: 8
211 | 
212 |   # Remove trailing whitespace
213 |   - trailing_whitespace: {}
214 | 
215 |   # Squash multiple spaces between the left and right hand sides of some
216 |   # elements into single spaces. Basically, this undoes the effect of
217 |   # simple_align but is a bit less conservative.
218 |   # - squash: {}
219 | 
220 | # A common setting is the number of columns (parts of) code will be wrapped
221 | # to. Different steps take this into account. Default: 80.
222 | columns: 80
223 | 
224 | # By default, line endings are converted according to the OS. You can override
225 | # preferred format here.
226 | #
227 | # - native: Native newline format. CRLF on Windows, LF on other OSes.
228 | #
229 | # - lf: Convert to LF ("\n").
230 | #
231 | # - crlf: Convert to CRLF ("\r\n").
232 | #
233 | # Default: native.
234 | newline: native
235 | 
236 | # Sometimes, language extensions are specified in a cabal file or from the
237 | # command line instead of using language pragmas in the file. stylish-haskell
238 | # needs to be aware of these, so it can parse the file correctly.
239 | #
240 | # No language extensions are enabled by default.
241 | # language_extensions:
242 |   # - TemplateHaskell
243 |   # - QuasiQuotes
244 | 
245 | # Attempt to find the cabal file in ancestors of the current directory, and
246 | # parse options (currently only language extensions) from that.
247 | #
248 | # Default: true
249 | cabal: true
250 | 


--------------------------------------------------------------------------------
/.travis.yml:
--------------------------------------------------------------------------------
 1 | # This is the simple Travis configuration, which is intended for use
 2 | # on applications which do not require cross-platform and
 3 | # multiple-GHC-version support. For more information and other
 4 | # options, see:
 5 | #
 6 | # https://docs.haskellstack.org/en/stable/travis_ci/
 7 | #
 8 | # Copy these contents into the root directory of your Github project in a file
 9 | # named .travis.yml
10 | 
11 | # Choose a build environment
12 | dist: xenial
13 | 
14 | language: nix
15 | nix: 2.3.1
16 | 
17 | sudo: required
18 | 
19 | cache:
20 |   directories:
21 |   - $HOME/.stack
22 |   - /nix
23 | 
24 | before_install:
25 | - nix-env -i stack
26 | - nix-env -i hlint
27 | 
28 | install:
29 | # Build dependencies
30 | - stack --no-terminal --install-ghc test --only-dependencies
31 | 
32 | script:
33 | # Build the package, its tests, and its docs and run the tests
34 | - stack --no-terminal test
35 | - hlint --ignore "Parse error" .
36 | 


--------------------------------------------------------------------------------
/ChangeLog.md:
--------------------------------------------------------------------------------
1 | # Changelog for frost
2 | 
3 | ## Unreleased changes
4 | 


--------------------------------------------------------------------------------
/DEVELOPERS.md:
--------------------------------------------------------------------------------
 1 | ## Developing frost
 2 | 
 3 | ### Development Setup
 4 | We use [Stack](https://docs.haskellstack.org/en/stable/README/) for development.
 5 | Simply cloning the repo and running `stack test` should be enough to start hacking on the project.
 6 | 
 7 | [ghcid](https://github.com/ndmitchell/ghcid) is another useful tool. Just type `ghcid -c 'stack repl'` in the root dir and enjoy.
 8 | 
 9 | ### Known problems
10 | Stack installed via `nix-env` is known to cause problems while building.
11 | 
12 | ## Running frost
13 | `stack run path/to/file.md` runs frost and feeds it with the supplied markdown file. The resulting html is going to be written to `path/to/file.md.html`
14 | 


--------------------------------------------------------------------------------
/LICENSE:
--------------------------------------------------------------------------------
 1 | Copyright Author name here (c) 2019
 2 | 
 3 | All rights reserved.
 4 | 
 5 | Redistribution and use in source and binary forms, with or without
 6 | modification, are permitted provided that the following conditions are met:
 7 | 
 8 |     * Redistributions of source code must retain the above copyright
 9 |       notice, this list of conditions and the following disclaimer.
10 | 
11 |     * Redistributions in binary form must reproduce the above
12 |       copyright notice, this list of conditions and the following
13 |       disclaimer in the documentation and/or other materials provided
14 |       with the distribution.
15 | 
16 |     * Neither the name of Author name here nor the names of other
17 |       contributors may be used to endorse or promote products derived
18 |       from this software without specific prior written permission.
19 | 
20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
31 | 


--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
 1 | # Frost
 2 | 
 3 | ## Installation
 4 | 
 5 | ### Via Stack
 6 | Build the latest executable via `stack install`.
 7 | After stack has done it's job the executable should be availabe as `frost`
 8 | 
 9 | ### From hackage
10 | TODO - obtaining from hackage
11 | 
12 | ## Usage
13 | Running `frost examples/git.md` should create a `git.md.html` file in the `examples/` directory.
14 | 
15 | ## Development
16 | See [DEVELOPERS.md](DEVELOPERS.md)
17 | 
18 | ## Plugin prerequisites
19 | 
20 | ### Rholang
21 | TODO - nixify
22 | 
23 | If you intend to use the Rholang plugin, you'll need to make sure that Frost is able to use the Rholang CLI. Follow the next steps to make this happen:
24 | 1. Follow the instructions under https://github.com/rchain/rchain/tree/dev/rholang#building-from-source to build the CLI
25 | 2. Copy the resulting jar to your ~/bin directory and rename it to rholangCLI.jar
26 | 3. Copy the script in ~/sh/rholang to your ~/bin dir and make it executable
27 | 


--------------------------------------------------------------------------------
/Setup.hs:
--------------------------------------------------------------------------------
1 | import Distribution.Simple
2 | main = defaultMain
3 | 


--------------------------------------------------------------------------------
/app/Main.hs:
--------------------------------------------------------------------------------
 1 | {-# LANGUAGE FlexibleInstances #-}
 2 | {-# LANGUAGE OverloadedStrings #-}
 3 | module Main where
 4 | 
 5 | import           Frost
 6 | import           Frost.DefaultsMandatoryPlugin
 7 | import           Frost.Effects.FileProvider
 8 | import           Frost.Effects.Git
 9 | import           Frost.Effects.Python
10 | import           Frost.Effects.Rholang
11 | import           Frost.Effects.Stack
12 | import           Frost.Effects.Sys
13 | import           Frost.Effects.Thut
14 | import           Frost.PandocRun                     (runInputPandoc,
15 |                                                       runOutputPandoc)
16 | import           Frost.Plugin
17 | import           Frost.Plugins.GitContributorsPlugin
18 | import           Frost.Plugins.RholangPlugin
19 | import           Frost.Plugins.StackPlugins
20 | import           Frost.Plugins.ThutPlugin
21 | import           Frost.PythonPlugin
22 | import           Frost.TimestampPlugin
23 | import           FrostError
24 | 
25 | import           Data.Foldable                       (find)
26 | import           Data.Function                       ((&))
27 | import qualified Data.Text                           as T
28 | import           Options.Generic
29 | import           Polysemy
30 | import           Polysemy.Error
31 | import           Polysemy.Trace
32 | import           PolysemyContrib
33 | import           System.Environment                  (getArgs)
34 | import           System.Exit
35 | import           System.IO
36 | import           Text.Pandoc                         (PandocError)
37 | 
38 | data Config a = Config
39 |   { input    :: a ::: [FilePath]       <?> "Files from which documentation is generated. Accepts multiple values"
40 |   , template :: a ::: Maybe FilePath   <?> "(optional) HTML template used to generate the documentation"
41 |   , output   :: a ::: FilePath         <?> "Path to a file that will hold generated documentation"
42 |   } deriving Generic
43 | 
44 | instance ParseRecord (Config Wrapped)
45 | deriving instance Show (Config Unwrapped)
46 | 
47 | main :: IO ()
48 | main = do
49 |   config <- unwrapRecord "Frost - automatically generates documentation from your source code"
50 |   exitCode <- generate config >>= handleEithers
51 |   exit exitCode
52 |   where
53 |     exit ExitSuccess     = exitSuccess
54 |     exit (ExitFailure 1) = exitFailure
55 |     generate (Config inputPaths templatePath outputPath) = generateDocs (transform plugins)
56 |       & runInputPandoc inputPaths
57 |       & runOutputPandoc outputPath templatePath
58 |       & runFileProviderIO
59 |       & runPython
60 |       & runRholang
61 |       & runStackSys
62 |       & runThutIO
63 |       & runSysIO
64 |       & runGitIO
65 |       & traceToIO
66 |       & runError @FrostError
67 |       & runError @PandocError
68 |       & runM
69 |     handleEithers = either handle (either handle (const $ return ExitSuccess))
70 |     handle error = hPrint stderr error >> return (ExitFailure 1)
71 | 
72 | plugins :: Members [Git, Python, Rholang, Sys, Stack, Thut] r  => [Plugin r]
73 | plugins = [ timestampPlugin
74 |           , timestampMetaPlugin
75 |           , defaultsMandatoryPlugin
76 |           , gitContributorsPlugin
77 |           , pythonPlugin
78 |           , rholangPlugin
79 |           ] ++ stackPlugins ++ thutPlugins
80 | 


--------------------------------------------------------------------------------
/examples/git.md:
--------------------------------------------------------------------------------
1 | # Example
2 | 
3 | ## Getting the list of developers from git
4 | ```frost:git:devs
5 | ```
6 | 


--------------------------------------------------------------------------------
/examples/python.md:
--------------------------------------------------------------------------------
 1 | # Example
 2 | 
 3 | ## Interpreting simple python
 4 | ```frost:python
 5 | def msg():
 6 |   return "Hello world!"
 7 | 
 8 | print(msg())
 9 | print(1 + 1 * 3)
10 | ```
11 | 


--------------------------------------------------------------------------------
/examples/template.html:
--------------------------------------------------------------------------------
 1 | <!DOCTYPE html>
 2 | <html $if(lang)$ lang="$lang$" $endif$ dir="ltr">
 3 | 
 4 |     <head>
 5 |         <meta charset="utf-8">
 6 |         <meta name="viewport" content="width=device-width, initial-scale=1">
 7 |         <title>$if(title)$$title$$endif$</title>
 8 |         <link rel="shortcut icon" href="images/favicon.ico" type="image/x-icon">
 9 |         <link rel="apple-touch-icon-precomposed" href="images/apple-touch-icon.png">
10 | 
11 | $if(template_css)$
12 | <link rel="stylesheet" href="$template_css$">
13 | $else$
14 | <link rel="stylesheet" href="https://cdnjs.cloudflare.com/ajax/libs/uikit/2.26.4/css/uikit.gradient.css">
15 | $endif$
16 | 
17 |         <link rel="stylesheet" href="style.css">
18 |         <script src="https://code.jquery.com/jquery-2.2.1.min.js"></script>
19 |         <script src="uikit.js"></script>
20 |         <script src="scripts.js"></script>
21 |         <script src="jquery.sticky-kit.js"></script>
22 | 
23 |         <meta name="generator" content="pandoc-uikit" />
24 |         $for(author-meta)$
25 |         <meta name="author" content="$author-meta$" />
26 |         $endfor$
27 |         $if(date-meta)$
28 |         <meta name="date" content="$date-meta$" />
29 |         $endif$
30 |         <title>$if(title-prefix)$$title-prefix$ - $endif$$pagetitle$</title>
31 |         <style type="text/css">code{white-space: pre;}</style>
32 |         $if(quotes)$
33 |         <style type="text/css">q { quotes: "“" "”" "‘" "’"; }</style>
34 |         $endif$
35 |         $if(highlighting-css)$
36 |         <style type="text/css">
37 |             $highlighting-css$
38 |         </style>
39 |         $endif$
40 |         $for(css)$
41 |         <link rel="stylesheet" href="$css$" $if(html5)$$else$type="text/css" $endif$/>
42 |               $endfor$
43 |               $if(math)$
44 |               $math$
45 |               $endif$
46 |               $for(header-includes)$
47 |               $header-includes$
48 |               $endfor$
49 |     </head>
50 | 
51 |     <body>
52 | 
53 | 
54 |         <div class="uk-container uk-container-center uk-margin-top uk-margin-large-bottom">
55 | 
56 |             $if(title)$
57 |             <div class="uk-grid" data-uk-grid-margin>
58 |                 <div class="uk-width-1-1">
59 |                     <h1 class="uk-heading-large">$title$</h1>
60 |                     $if(date)$
61 |                     <h3 class="uk-heading-large">$date$</p></h3>
62 |                     $endif$
63 |                     $for(author)$
64 |                     <p class="uk-text-large">$author$</p>
65 |                     $endfor$
66 |                 </div>
67 |             </div>
68 |             $endif$
69 | 
70 |             <div class="uk-grid" data-uk-grid-margin >
71 |                 <div class="uk-width-medium-1-4">
72 |                     <div class="uk-overflow-container" data-uk-sticky="{top:25,media: 768}">
73 |                         <div class="uk-panel uk-panel-box menu-begin" >
74 | 
75 |                             $if(toc)$
76 |                             $toc$
77 |                             $endif$
78 | 
79 |                         </div>
80 |                     </div>
81 |                 </div>
82 | 
83 |                 <div class="uk-width-medium-3-4">
84 | $body$
85 |                 </div>
86 |             </div>
87 |         </div>
88 |     </body>
89 | </html>
90 | 


--------------------------------------------------------------------------------
/examples/thut.md:
--------------------------------------------------------------------------------
 1 | # Example
 2 | 
 3 | 
 4 | Hello world!
 5 | 
 6 | ```frost:thut:eval
 7 | 5 + 5 :: Int
 8 | ```
 9 | 
10 | ```frost:thut:passthrough
11 | putStrLn "hello, world!"
12 | ```
13 | 


--------------------------------------------------------------------------------
/integration-test/IntegrationTest/ThutSpec.hs:
--------------------------------------------------------------------------------
 1 | {-# LANGUAGE OverloadedStrings #-}
 2 | module IntegrationTest.ThutSpec where
 3 | 
 4 | import           Frost.Effects.Thut
 5 | import           FrostError
 6 | 
 7 | import           Polysemy
 8 | import           Polysemy.Error
 9 | 
10 | import           Data.Function      ((&))
11 | import           Test.Hspec
12 | 
13 | spec :: Spec
14 | spec =
15 |   describe "Frost.Effects.Thut runThutIO" $
16 |     it "should execute thut:passthrough" $ do
17 |       pendingWith "make it work"
18 |       result <- runThutIO (passthrough "putStrLn \"Hello world!\"")
19 |                 & runError @FrostError
20 |                 & runM
21 |       result `shouldBe` Right "Hello world!\n"
22 | 


--------------------------------------------------------------------------------
/integration-test/PythonSpec.hs:
--------------------------------------------------------------------------------
 1 | module PythonSpec where
 2 | 
 3 | import           Frost.Effects.Python
 4 | import           Frost.Effects.Sys
 5 | import           FrostError
 6 | 
 7 | import           Polysemy
 8 | import           Polysemy.Error
 9 | 
10 | import           Data.Function        ((&))
11 | import           Test.Hspec
12 | 
13 | spec :: Spec
14 | spec =
15 |   describe "Frost.Effects.Python runPython" $
16 |     it "should execute python" $ do
17 |       result <- runPython (exec "print(1+3)")
18 |                 & runSysIO
19 |                 & runError @FrostError
20 |                 & runM
21 |       result `shouldBe` Right "4\n"
22 | 


--------------------------------------------------------------------------------
/integration-test/Spec.hs:
--------------------------------------------------------------------------------
1 | {-# OPTIONS_GHC -F -pgmF hspec-discover #-}
2 | 


--------------------------------------------------------------------------------
/package.yaml:
--------------------------------------------------------------------------------
  1 | name:                frost
  2 | version:             0.0.1.0
  3 | synopsis:            Frost
  4 | description:         |
  5 |   Please see the documentation at <https://github.com/frost-org/frost/blob/master/README.md>
  6 |   for usage information
  7 | category:            Documentation
  8 | github:              "frost-org/frost"
  9 | license:             BSD3
 10 | author:              "Paweł Szulc"
 11 | maintainer:          "paul.szulc@gmail.com"
 12 | copyright:           "2019 Paweł Szulc"
 13 | 
 14 | extra-source-files:
 15 | - README.md
 16 | - ChangeLog.md
 17 | 
 18 | ghc-options:
 19 | - -fplugin=Polysemy.Plugin
 20 | 
 21 | # This condition is added to make MacOS users happy. It's apparently known bug in
 22 | # cabal (https://github.com/haskell/cabal/issues/4739) that the whole Haskell
 23 | # community is aware of.
 24 | # Below is a workaround to make code work on Mac.
 25 | when:
 26 |   - condition: os(darwin)
 27 |     ghc-options:
 28 |     - -optP-Wno-nonportable-include-path
 29 | 
 30 | default-extensions:
 31 | - OverloadedStrings
 32 | - DataKinds
 33 | - FlexibleContexts
 34 | - GADTs
 35 | - DeriveGeneric
 36 | - StandaloneDeriving
 37 | - LambdaCase
 38 | - PolyKinds
 39 | - RankNTypes
 40 | - ScopedTypeVariables
 41 | - TypeApplications
 42 | - TypeOperators
 43 | - TypeFamilies
 44 | 
 45 | dependencies:
 46 | - base >= 4.7 && < 5
 47 | - polysemy
 48 | - polysemy-plugin
 49 | - pandoc
 50 | - optparse-generic
 51 | - text
 52 | - containers
 53 | - thut
 54 | - time
 55 | - simple-cmd
 56 | - MissingH
 57 | - process
 58 | - time-compat
 59 | - binary-orphans
 60 | - binary-instances
 61 | - github
 62 | - vector
 63 | - split
 64 | 
 65 | library:
 66 |   source-dirs: src
 67 | 
 68 | executables:
 69 |   frost:
 70 |     main:                Main.hs
 71 |     source-dirs:         app
 72 |     ghc-options:
 73 |     - -threaded
 74 |     - -rtsopts
 75 |     - -with-rtsopts=-N
 76 |     dependencies:
 77 |     - frost
 78 | 
 79 | tests:
 80 |   frost-test:
 81 |     main:                Spec.hs
 82 |     source-dirs:         test
 83 |     ghc-options:
 84 |     - -threaded
 85 |     - -rtsopts
 86 |     - -with-rtsopts=-N
 87 |     dependencies:
 88 |     - frost
 89 |     - QuickCheck
 90 |     - hspec
 91 |     - raw-strings-qq
 92 | 
 93 |   frost-integration-test:
 94 |     main:                Spec.hs
 95 |     source-dirs:         integration-test
 96 |     ghc-options:
 97 |     - -threaded
 98 |     - -rtsopts
 99 |     - -with-rtsopts=-N
100 |     dependencies:
101 |     - frost
102 |     - QuickCheck
103 |     - hspec
104 |     - raw-strings-qq
105 | 


--------------------------------------------------------------------------------
/sh/rholang:
--------------------------------------------------------------------------------
1 | #!/bin/sh
2 | java -jar $HOME/rholangCLI.jar <<EOF
3 | $1
4 | EOF
5 | 


--------------------------------------------------------------------------------
/shell.nix:
--------------------------------------------------------------------------------
 1 | {ghc}:
 2 | with (import <nixpkgs> {});
 3 | 
 4 | haskell.lib.buildStackProject {
 5 |   inherit ghc;
 6 |   name = "frost";
 7 |   # Stack with Nix enabled does not work on OSX (:shrug:)
 8 |   # Workaround that I found on Idris https://github.com/idris-lang/Idris-dev/pull/2938 fixes the issue
 9 |   buildInputs = [ python3 zlib ghcid ] ++ lib.optionals stdenv.isDarwin (with darwin.apple_sdk.frameworks; [
10 |     Cocoa
11 |     CoreServices
12 |   ]);
13 | }
14 | 


--------------------------------------------------------------------------------
/src/Frost.hs:
--------------------------------------------------------------------------------
 1 | 
 2 | module Frost where
 3 | 
 4 | import           Control.Monad
 5 | import           Frost.Effects.Git
 6 | import           Frost.Effects.Python
 7 | import           Frost.Effects.Rholang
 8 | import           Frost.Effects.Stack
 9 | import           Frost.Effects.Sys
10 | import           Frost.Plugin
11 | import           FrostError
12 | 
13 | import           Data.Foldable          (fold)
14 | import           Data.Functor           ((<&>))
15 | import           Data.List              (find)
16 | import           Data.List.Utils        (split)
17 | import           Data.Map.Strict        hiding (split)
18 | import           Data.Traversable
19 | import           Polysemy
20 | import           Polysemy.Error
21 | import           Polysemy.Input
22 | import           Polysemy.Output
23 | import           Text.Pandoc
24 | import           Text.Pandoc.Extensions
25 | 
26 | {-# ANN module ("HLint: ignore Used otherwise as a pattern" :: String) #-}
27 | 
28 | generateDocs :: ( Member (Input [Pandoc]) r
29 |                 , Member (Output Pandoc) r
30 |                 , Member (Error FrostError) r
31 |                 ) => (Pandoc -> Sem r Pandoc) -> Sem r ()
32 | generateDocs  transform = do
33 |   docs            <- input
34 |   transformedDocs <- traverse transform docs
35 |   output $ fold transformedDocs
36 | 
37 | transform :: Member (Error FrostError) r => [Plugin r] -> Pandoc -> Sem r Pandoc
38 | transform plugins (Pandoc meta blocks) = do
39 |   newMeta <- foldM (flip addToMeta) meta plugins
40 |   newBlocks <- traverse (replaceBlock plugins) blocks
41 |   return $ Pandoc newMeta (join newBlocks)
42 | 
43 | replaceBlock :: Member (Error FrostError) r => [Plugin r] -> Block -> Sem r [Block]
44 | replaceBlock plugins = \case
45 |   Para inlines -> pure . Para . join <$> traverse (replaceInline plugins) inlines
46 |   CodeBlock ("",[name],[]) content -> replace plugins name content <&> fst
47 |   otherwise -> return [otherwise]
48 |   where
49 |     replaceInline :: Member (Error FrostError) r => [Plugin r] -> Inline -> Sem r [Inline]
50 |     replaceInline plugins (Code ("",[],[]) nameAndContent) = do
51 |       let (name:contents) = split " " nameAndContent
52 |       let content = join contents
53 |       replace plugins name content <&> snd
54 |     replaceInline plugins otherwise = return [otherwise]
55 |     replace :: Member (Error FrostError) r => [Plugin r] -> String -> String -> Sem r ([Block], [Inline])
56 |     replace plugins name content = do
57 |       let maybePlugin = find ((name ==) . ("frost:" ++) . pluginName) plugins
58 |       case maybePlugin of
59 |         Just plugin ->  substitute plugin content
60 |         Nothing     -> throw $ PluginNotAvailable name
61 | 


--------------------------------------------------------------------------------
/src/Frost/DefaultsMandatoryPlugin.hs:
--------------------------------------------------------------------------------
 1 | module Frost.DefaultsMandatoryPlugin where
 2 | 
 3 | import           Data.Map.Strict
 4 | import           Frost.Plugin
 5 | import           Polysemy
 6 | import           PolysemyContrib
 7 | import           Text.Pandoc
 8 | 
 9 | defaultsMandatoryPlugin :: Plugin r
10 | defaultsMandatoryPlugin = justMetaPlugin "meta.defaults" (return . Meta . insertTitle . unMeta)
11 |   where
12 |     insertTitle = insert "title" (MetaString "Documentation")
13 | 


--------------------------------------------------------------------------------
/src/Frost/Effects/FileProvider.hs:
--------------------------------------------------------------------------------
 1 | {-# LANGUAGE TemplateHaskell #-}
 2 | module Frost.Effects.FileProvider where
 3 | 
 4 | import           Polysemy
 5 | import           Polysemy.State
 6 | 
 7 | import           Data.Map
 8 | import qualified Data.Text      as T
 9 | import qualified Data.Text.IO   as TIO
10 | 
11 | data FileProvider m a where
12 |   ReadFile :: FilePath -> FileProvider m T.Text
13 |   WriteFile :: FilePath -> T.Text -> FileProvider m ()
14 | 
15 | makeSem ''FileProvider
16 | 
17 | type InMemFileSystem = Map FilePath T.Text
18 | 
19 | runFileProviderPure :: (Member (State InMemFileSystem) r) => Sem (FileProvider ': r) a -> Sem r a
20 | runFileProviderPure = interpret $ \case
21 |   ReadFile path -> do
22 |     m <- get @InMemFileSystem
23 |     pure $ m ! path
24 |   WriteFile path content -> do
25 |     m <- get @InMemFileSystem
26 |     put $ insert path content m
27 | 
28 | runFileProviderIO :: (Member (Embed IO) r) => Sem (FileProvider ': r) a -> Sem r a
29 | runFileProviderIO = interpret $ \case
30 |   ReadFile path -> embed $ TIO.readFile path
31 |   WriteFile path content -> embed $ TIO.writeFile path content
32 | 


--------------------------------------------------------------------------------
/src/Frost/Effects/Git.hs:
--------------------------------------------------------------------------------
 1 | {-# LANGUAGE TemplateHaskell #-}
 2 | module Frost.Effects.Git where
 3 | 
 4 | import           Data.List
 5 | import           Data.String.Utils
 6 | import           Polysemy
 7 | import           SimpleCmd.Git
 8 | 
 9 | import qualified Data.Text         as T
10 | 
11 | data Git m a where
12 |   DevsList :: Git m [String]
13 | 
14 | makeSem ''Git
15 | 
16 | runGitIO :: Member (Embed IO) r => Sem (Git ': r) a -> Sem r a
17 | runGitIO = interpret $ \case
18 |   DevsList -> embed getContributors
19 | 
20 | runGitPure :: [String] -> Sem (Git ': r) a -> Sem r a
21 | runGitPure devs = interpret $ \case
22 |   DevsList -> return devs
23 | 
24 | getContributors :: IO [String]
25 | getContributors  = do
26 |     output <- git "log" ["--pretty=short", "-s"]
27 |     let s = T.split (=='\n') (T.pack output)
28 |     let r = nub $ filter (startswith  "Author:" . T.unpack) s
29 |     let f = fmap (drop (length ("Author: " :: String)) . T.unpack) r
30 |     return f
31 | 


--------------------------------------------------------------------------------
/src/Frost/Effects/Github.hs:
--------------------------------------------------------------------------------
 1 | {-# LANGUAGE OverloadedStrings #-}
 2 | {-# LANGUAGE TemplateHaskell   #-}
 3 | module Frost.Effects.Github where
 4 | 
 5 | import qualified Data.List.Split         as DLS
 6 | import qualified Data.Vector             as DV
 7 | import           FrostError
 8 | import qualified GitHub.Data.Issues      as GHDI
 9 | import qualified GitHub.Data.Options     as GHO
10 | import qualified GitHub.Endpoints.Issues as GHI
11 | import qualified GitHub.Internal.Prelude as GIP
12 | import           Polysemy
13 | import           Polysemy.Error
14 | import           PolysemyContrib
15 | 
16 | type Issue = String
17 | 
18 | data Github m a where
19 |   Issues :: String -> Github m [Issue]
20 | 
21 | makeSem ''Github
22 | 
23 | runGithubPure :: [Issue] -> Sem (Github ': r) a -> Sem r a
24 | runGithubPure issues = interpret $ \case
25 |   Issues _ -> return issues
26 | 
27 | runGithubIO :: (Member (Embed IO) r, Member (Error FrostError) r) => Sem (Github ': r) a  -> Sem r a
28 | runGithubIO = interpret $ \case
29 |   Issues repo -> do
30 |     (username, reponame) <- either throw return (parseRepo repo)
31 |     fromEitherSem $ embed $ issuesForFrost username reponame
32 |   where
33 |     issuesForFrost username reponame = do
34 |       mis <- GHI.issuesForRepo username reponame GHO.optionsAnyMilestone
35 |       return $ either (Left . FrostError . show) (Right . fmap (GIP.unpack . GHDI.issueTitle) . DV.toList) mis
36 |     parseRepo :: String -> Either FrostError (GHI.Name GHI.Owner, GHI.Name GHI.Repo)
37 |     parseRepo d = case DLS.splitOn "/" d of
38 |         [username, reponame] -> Right (GHI.mkOwnerName $ GIP.pack username, GHI.mkRepoName $ GIP.pack reponame)
39 |         other -> Left $ FrostError $ show other
40 | 


--------------------------------------------------------------------------------
/src/Frost/Effects/Python.hs:
--------------------------------------------------------------------------------
 1 | {-# LANGUAGE TemplateHaskell #-}
 2 | module Frost.Effects.Python where
 3 | 
 4 | import           Frost.Effects.Sys
 5 | import           Polysemy
 6 | 
 7 | data Python m a where
 8 |   Exec :: String -> Python m String
 9 | 
10 | makeSem ''Python
11 | 
12 | runPython :: Member Sys r => Sem (Python ': r) a -> Sem r a
13 | runPython = interpret $ \case
14 |   Exec script -> showStdOut (cmd $ "python -c '" ++ script ++ "'")
15 |   where
16 |     showStdOut :: Sem r (String, String) -> Sem r String
17 |     showStdOut = fmap fst
18 | 


--------------------------------------------------------------------------------
/src/Frost/Effects/Rholang.hs:
--------------------------------------------------------------------------------
 1 | {-# LANGUAGE TemplateHaskell #-}
 2 | module Frost.Effects.Rholang where
 3 | 
 4 | import           Frost.Effects.Sys
 5 | import           Polysemy
 6 | 
 7 | data Rholang m a where
 8 |   Exec :: String -> Rholang m String
 9 | 
10 | makeSem ''Rholang
11 | 
12 | runRholang :: Member Sys r => Sem (Rholang ': r) a -> Sem r a
13 | runRholang = interpret $ \case
14 |   Exec script -> showStdOut (cmd $ "rholang '" ++ script ++"'")
15 |   where
16 |     showStdOut :: Sem r (String, String) -> Sem r String
17 |     showStdOut = fmap fst
18 | 


--------------------------------------------------------------------------------
/src/Frost/Effects/Stack.hs:
--------------------------------------------------------------------------------
 1 | {-# LANGUAGE TemplateHaskell #-}
 2 | module Frost.Effects.Stack where
 3 | 
 4 | import           Frost.Effects.Sys
 5 | import           FrostError
 6 | 
 7 | import           Polysemy
 8 | import           Polysemy.Error
 9 | 
10 | type SpecName = String
11 | type TestName = String
12 | type FileName = String
13 | 
14 | data Stack m a where
15 |   Clean :: Stack m String
16 |   Build :: Stack m String
17 |   Exec :: String -> Stack m String
18 |   Test :: Stack m String
19 |   TestMatch :: FileName -> SpecName -> TestName -> Stack m String
20 | 
21 | makeSem ''Stack
22 | 
23 | runStackSys :: Member Sys r => Sem (Stack ': r) a -> Sem r a
24 | runStackSys = interpret $ \case
25 |   Clean                       -> showStdErr $ stack "clean"
26 |   Build                       -> showStdErr $ stack "build"
27 |   Exec what                   -> showStdErr $ stack $ "exec " ++ what
28 |   Test                        -> showStdOut $ stack "test"
29 |   TestMatch fileName specName testName -> do
30 |     let p = "/"++ fileName ++ "/" ++ specName ++ "/" ++ testName ++ "/"
31 |     showStdOut $ stack $ "test --match " ++ show p
32 |   where
33 |     stack :: Member Sys r => String -> Sem r (StdOut, StdErr)
34 |     stack arg = cmd $ "stack --no-terminal " ++ arg
35 | 
36 |     showStdOut :: Sem r (StdOut, StdErr) -> Sem r StdOut
37 |     showStdOut = fmap fst
38 | 
39 |     showStdErr :: Sem r (StdOut, StdErr) -> Sem r StdErr
40 |     showStdErr = fmap snd
41 | 


--------------------------------------------------------------------------------
/src/Frost/Effects/Sys.hs:
--------------------------------------------------------------------------------
 1 | {-# LANGUAGE TemplateHaskell #-}
 2 | module Frost.Effects.Sys where
 3 | 
 4 | import           FrostError
 5 | 
 6 | import           Data.Functor
 7 | import           Data.Time.Clock
 8 | import           Polysemy
 9 | import           Polysemy.Error
10 | import           System.Exit     (ExitCode (..))
11 | import           System.IO       (hGetContents)
12 | import           System.Process  (runInteractiveCommand, waitForProcess)
13 | 
14 | type StdOut = String
15 | type StdErr = String
16 | 
17 | data Sys m a where
18 |   CurrentTime :: Sys m UTCTime
19 |   Cmd :: String -> Sys m (StdOut, StdErr)
20 | 
21 | makeSem ''Sys
22 | 
23 | runSysPure :: UTCTime -> (String -> (StdOut, StdErr)) -> Sem (Sys ': r) a -> Sem r a
24 | runSysPure ct cmdFun = interpret $ \case
25 |   CurrentTime -> return ct
26 |   Cmd command -> return $ cmdFun command
27 | 
28 | runSysIO :: ( Member (Embed IO) r
29 |           , Member (Error FrostError) r
30 |           ) => Sem (Sys ': r) a -> Sem r a
31 | runSysIO = interpret $ \case
32 |   CurrentTime -> embed getCurrentTime
33 |   Cmd command -> executeCommand command >>= \case
34 |     Left error -> throw error
35 |     Right output -> return output
36 |   where
37 |     executeCommand command = embed (getProcessOutput command <&> \case
38 |       (_, _, ExitFailure i) -> Left $ ExitedWithFailure i
39 |       (stdOut, stdErr, ExitSuccess) -> Right (stdOut, stdErr))
40 | 
41 | getProcessOutput :: String -> IO (StdOut, StdErr, ExitCode)
42 | getProcessOutput command =
43 |   do (_pIn, pOut, pErr, handle) <- runInteractiveCommand command
44 |      exitCode <- waitForProcess handle
45 |      stdOut   <- hGetContents pOut
46 |      stdErr   <- hGetContents pErr
47 |      return (stdOut, stdErr, exitCode)
48 | 


--------------------------------------------------------------------------------
/src/Frost/Effects/Thut.hs:
--------------------------------------------------------------------------------
 1 | {-# LANGUAGE OverloadedStrings #-}
 2 | {-# LANGUAGE TemplateHaskell   #-}
 3 | 
 4 | module Frost.Effects.Thut where
 5 | 
 6 | import           Data.Text
 7 | import           Polysemy
 8 | import           Thut        as T
 9 | import           Thut.Render as T
10 | 
11 | data Thut m a where
12 |   Eval :: Text -> Thut m String
13 |   Passthrough :: Text -> Thut m String
14 | 
15 | makeSem ''Thut
16 | 
17 | runThutIO :: Member (Embed IO) r => Sem (Thut ': r) a -> Sem r a
18 | runThutIO = interpret $ \case
19 |   Eval contents -> embed $ process contents "eval"
20 |   Passthrough contents -> embed $ process contents "passthrough"
21 |   where
22 |     filePath = "irrelevant"
23 |     process contents mode = do
24 |       doc <- T.evalText' config filePath ("```thut:" <> mode <> "\n" <> contents <> "\n```")
25 |       pure $ unpack $ renderDocument doc
26 |     config = InterpreterConfig "stack repl" False Plain verboseGhcid
27 |     verboseGhcid = False
28 | 


--------------------------------------------------------------------------------
/src/Frost/PandocRun.hs:
--------------------------------------------------------------------------------
 1 | module Frost.PandocRun where
 2 | 
 3 | import           Frost.Effects.FileProvider
 4 | 
 5 | import           Data.Text                  (unpack)
 6 | import           Polysemy
 7 | import           Polysemy.Error
 8 | import           Polysemy.Input
 9 | import           Polysemy.Output
10 | import           PolysemyContrib
11 | import           Prelude                    hiding (readFile, writeFile)
12 | import           Text.Pandoc
13 | 
14 | runInputPandoc :: (
15 |     Member (Embed IO) r
16 |   , Member FileProvider r
17 |   , Member (Error PandocError) r
18 |   ) => [FilePath] -> Sem (Input [Pandoc] ': r) a -> Sem r a
19 | runInputPandoc filePaths = interpret $ \case
20 |   Input -> do
21 |     contents <- traverse readFile filePaths
22 |     traverse (fromPandocIO . readMarkdown settings) contents
23 |   where
24 |     settings = def { readerExtensions = extensionsFromList [Ext_yaml_metadata_block, Ext_backtick_code_blocks]}
25 | 
26 | runOutputPandoc :: (
27 |     Member (Embed IO) r
28 |   , Member FileProvider r
29 |   , Member (Error PandocError) r
30 |   ) => FilePath -> Maybe FilePath -> Sem (Output Pandoc ': r) a -> Sem r a
31 | runOutputPandoc outputPath templatePath = interpret $ \case
32 |   Output pandoc -> do
33 |     template <- traverse readFile templatePath
34 |     let options = mkOptions template
35 |     content <- fromPandocIO $ writeHtml4String options pandoc
36 |     writeFile outputPath content
37 |   where
38 |     mkOptions template = def
39 |       { writerTableOfContents = True
40 |       , writerTemplate = fmap unpack template
41 |       }
42 | 
43 | fromPandocIO :: (
44 |     PandocMonad PandocIO
45 |   , Member (Error PandocError) r
46 |   , Member (Embed IO) r
47 |   ) => PandocIO a -> Sem r a
48 | fromPandocIO pioa = fromEitherSem $ embed $ runIO pioa
49 | 


--------------------------------------------------------------------------------
/src/Frost/Plugin.hs:
--------------------------------------------------------------------------------
 1 | module Frost.Plugin where
 2 | 
 3 | import           Polysemy
 4 | import           Text.Pandoc
 5 | 
 6 | data Plugin r = Plugin {
 7 |                      pluginName :: String,
 8 |                      substitute :: String -> Sem r ([Block], [Inline]),
 9 |                      addToMeta  :: Meta -> Sem r Meta
10 |                      }
11 | 
12 | justContentPlugin :: String -> (String -> Sem r ([Block], [Inline])) -> Plugin r
13 | justContentPlugin pluginName substitute = Plugin pluginName substitute return
14 | 
15 | justMetaPlugin :: String -> (Meta -> Sem r Meta) -> Plugin r
16 | justMetaPlugin pluginName = Plugin pluginName (\_ -> return ([], []))
17 | 


--------------------------------------------------------------------------------
/src/Frost/Plugins/GitContributorsPlugin.hs:
--------------------------------------------------------------------------------
 1 | module Frost.Plugins.GitContributorsPlugin where
 2 | 
 3 | import           Frost.Effects.Git
 4 | import           Frost.Plugin
 5 | 
 6 | import           Data.Map.Strict
 7 | import           Polysemy
 8 | import           PolysemyContrib
 9 | import           Text.Pandoc
10 | 
11 | gitContributorsPlugin :: Member Git r => Plugin r
12 | gitContributorsPlugin = justContentPlugin "git:devs" (\_ -> render <$> devsList)
13 |   where
14 |     render devs = (renderContent devs, renderText devs)
15 |     renderContent devs = [BulletList $ fmap (\d -> [Plain [Str d]]) devs]
16 |     renderText = fmap Str
17 | 


--------------------------------------------------------------------------------
/src/Frost/Plugins/LatestIssuesPlugin.hs:
--------------------------------------------------------------------------------
 1 | 
 2 | module Frost.Plugins.LatestIssuesPlugin where
 3 | 
 4 | import           Data.List
 5 | import           Data.Map.Strict
 6 | import           Frost.Effects.Github
 7 | import           Frost.Plugin
 8 | import           Polysemy
 9 | import           PolysemyContrib
10 | import           Text.Pandoc
11 | 
12 | latestIssuesPlugin :: (Member Github r) => Plugin r
13 | latestIssuesPlugin = justContentPlugin "issues:latest" (\repo -> do
14 |       is <- issues repo
15 |       return (renderBlock is, renderInline is))
16 |   where
17 |     renderBlock is = [BulletList (fmap (wrap . Plain . wrap . Str) is)]
18 |     renderInline = fmap Str
19 |     wrap :: c -> [c]
20 |     wrap = return
21 | 


--------------------------------------------------------------------------------
/src/Frost/Plugins/RholangPlugin.hs:
--------------------------------------------------------------------------------
 1 | module Frost.Plugins.RholangPlugin where
 2 | 
 3 | import           Frost.Effects.Rholang
 4 | import           Frost.Effects.Sys
 5 | import           Frost.Plugin
 6 | 
 7 | import           Data.Map.Strict
 8 | import           Polysemy
 9 | import           PolysemyContrib
10 | import           Text.Pandoc
11 | 
12 | rholangPlugin :: Member Rholang r => Plugin r
13 | rholangPlugin = justContentPlugin "rholang" (fmap render . exec)
14 |   where
15 |     render out = ([Plain [Str out]], [Str out])
16 | 


--------------------------------------------------------------------------------
/src/Frost/Plugins/StackPlugins.hs:
--------------------------------------------------------------------------------
 1 | module Frost.Plugins.StackPlugins where
 2 | 
 3 | import           Frost.Effects.Stack
 4 | import           Frost.Plugin
 5 | import           Polysemy
 6 | import           Text.Pandoc
 7 | 
 8 | stackPlugin :: (Member Stack r) => String -> Sem r String -> Plugin r
 9 | stackPlugin pluginName stackCommand =
10 |   justContentPlugin pluginName (\_ -> do
11 |     output <- stackCommand
12 |     return (renderBlock output, []))
13 |   where
14 |     renderBlock output = [CodeBlock ("", [], []) output]
15 | 
16 | stackBuildPlugin :: (Member Stack r) => Plugin r
17 | stackBuildPlugin = stackPlugin "stack:build" build
18 | 
19 | stackTestPlugin :: (Member Stack r) => Plugin r
20 | stackTestPlugin = stackPlugin "stack:test" test
21 | 
22 | stackPlugins :: (Member Stack r) => [Plugin r]
23 | stackPlugins = [stackBuildPlugin, stackTestPlugin]
24 | 


--------------------------------------------------------------------------------
/src/Frost/Plugins/ThutPlugin.hs:
--------------------------------------------------------------------------------
 1 | {-# LANGUAGE OverloadedStrings #-}
 2 | module Frost.Plugins.ThutPlugin where
 3 | 
 4 | import           Data.Text
 5 | import           Frost.Effects.Thut
 6 | import           Frost.Plugin
 7 | import           Polysemy
 8 | import           Text.Pandoc
 9 | 
10 | thutPlugin :: Member Thut r => String -> (Text -> Sem r String) -> Plugin r
11 | thutPlugin mode command = justContentPlugin mode (\text -> render <$> command (pack text) )
12 |   where
13 |     render out = ([Plain [Str out]], [Str out])
14 | 
15 | thutPlugins :: Member Thut r => [Plugin r]
16 | thutPlugins = [thutPlugin "thut:eval" eval, thutPlugin "thut:passthrough" passthrough]
17 | 


--------------------------------------------------------------------------------
/src/Frost/PythonPlugin.hs:
--------------------------------------------------------------------------------
 1 | module Frost.PythonPlugin where
 2 | 
 3 | import           Frost.Effects.Python
 4 | import           Frost.Effects.Sys
 5 | import           Frost.Plugin
 6 | 
 7 | import           Data.Map.Strict
 8 | import           Polysemy
 9 | import           PolysemyContrib
10 | import           Text.Pandoc
11 | 
12 | pythonPlugin :: Member Python r => Plugin r
13 | pythonPlugin = justContentPlugin "python" (fmap render . exec)
14 |   where
15 |     render out = ([Plain [Str out]], [Str out])
16 | 


--------------------------------------------------------------------------------
/src/Frost/TimestampPlugin.hs:
--------------------------------------------------------------------------------
 1 | module Frost.TimestampPlugin where
 2 | 
 3 | import           Frost.Effects.Sys
 4 | import           Frost.Plugin
 5 | 
 6 | import           Data.Functor
 7 | import           Data.Map.Strict
 8 | import           Polysemy
 9 | import           Text.Pandoc
10 | 
11 | timestampMetaPlugin :: Member Sys r => Plugin r
12 | timestampMetaPlugin = justMetaPlugin "timestamp:meta" (\meta -> do
13 |   time <- currentTime
14 |   return $ Meta $ insertTimestamp time $ unMeta meta)
15 |   where
16 |     insertTimestamp t= insert "creation" (MetaString $ show t)
17 | 
18 | timestampPlugin :: Member Sys r => Plugin r
19 | timestampPlugin = justContentPlugin "timestamp" (\_ -> currentTime <&> render)
20 |   where
21 |     render t = ([Plain [Str $ show t]], [Str $ show t])
22 | 


--------------------------------------------------------------------------------
/src/FrostError.hs:
--------------------------------------------------------------------------------
1 | module FrostError where
2 | 
3 | data FrostError = PluginNotAvailable String | ExitedWithFailure Int | FrostError String
4 |   deriving (Eq, Show)
5 | 


--------------------------------------------------------------------------------
/src/PolysemyContrib.hs:
--------------------------------------------------------------------------------
1 | module PolysemyContrib where
2 | 
3 | import           Polysemy
4 | import           Polysemy.Error
5 | 
6 | fromEitherSem :: Member (Error e) r => Sem r (Either e a) -> Sem r a
7 | fromEitherSem sem = sem >>= either throw return
8 | 


--------------------------------------------------------------------------------
/stack.yaml:
--------------------------------------------------------------------------------
 1 | resolver: lts-14.27
 2 | 
 3 | packages:
 4 | - .
 5 | 
 6 | extra-deps:
 7 | - github-0.22
 8 | - binary-instances-1
 9 | - binary-orphans-1.0.1
10 | - time-compat-1.9.2.2
11 | - git: https://github.com/felixmulder/thut.git
12 |   commit: baa88f25f3b615d202b5dd36ef65d12acb55f837
13 | 
14 | nix:
15 |   enable: true
16 |   shell-file: shell.nix
17 | 


--------------------------------------------------------------------------------
/test/Effects/GithubSpec.hs:
--------------------------------------------------------------------------------
 1 | module Effects.GithubSpec where
 2 | 
 3 | import qualified Frost.Effects.Github as FEG
 4 | 
 5 | import           Data.Function        ((&))
 6 | import           Polysemy
 7 | import           Polysemy.Error
 8 | import           Test.Hspec
 9 | 
10 | spec :: Spec
11 | spec =
12 |   describe "Github effect" $
13 |     it "should fetch a list of issues from a passed repo" $ do
14 |   pendingWith "fails randomly due to a GH request rate limit (see issue #39)"
15 |   res <- FEG.issues "dzajkowski/frost-issues-test"
16 |         & FEG.runGithubIO
17 |         & runError
18 |         & runM
19 |   res `shouldBe` Right ["Test issue three"]
20 | 


--------------------------------------------------------------------------------
/test/Effects/RholangSpec.hs:
--------------------------------------------------------------------------------
 1 | {-# LANGUAGE TupleSections #-}
 2 | module Effects.RholangSpec where
 3 | 
 4 | import           Frost.Effects.Rholang
 5 | import           Frost.Effects.Sys
 6 | 
 7 | import           Polysemy
 8 | 
 9 | import           Data.Function         ((&))
10 | import           Test.Hspec
11 | 
12 | spec :: Spec
13 | spec =
14 |   describe "Frost.Effects.Rholang runRholang" $
15 |     it "run script should call 'rholang script'" $ do
16 |   let result = runRholang (exec "script")
17 |              & runCmd ("rholang 'script'", withStdOut "executed a rholang script")
18 |              & run
19 |   result `shouldBe` "executed a rholang script"
20 | 
21 | runCmd :: (String, (StdOut, StdErr)) -> Sem (Sys ': r) a -> Sem r a
22 | runCmd (arg, response) = runSysPure ts func
23 |   where
24 |     ts = undefined
25 |     func str = if str == arg then response else ("", "")
26 | 
27 | withStdOut :: String -> (StdOut, StdErr)
28 | withStdOut = (, "")
29 | 


--------------------------------------------------------------------------------
/test/Frost/Plugins/GitContributorsPluginSpec.hs:
--------------------------------------------------------------------------------
 1 | module Frost.Plugins.GitContributorsPluginSpec where
 2 | 
 3 | import           Frost
 4 | import           Frost.Effects.Git
 5 | import           Frost.Plugin
 6 | import           Frost.Plugins.GitContributorsPlugin
 7 | 
 8 | import           Data.Function                       ((&))
 9 | import           Polysemy
10 | import           Test.Hspec
11 | import           Text.Pandoc
12 | 
13 | spec :: Spec
14 | spec =
15 |   describe "GitContributorsPlugin" $
16 |     it "should substitute frost code blocks with content from the git plugin" $ do
17 |   -- when
18 |   let res = substitute gitContributorsPlugin ""
19 |         & runGitPure ["Dev1", "Dev2"]
20 |         & run
21 |   -- then
22 |   fst res `shouldBe` [BulletList [ [Plain [Str "Dev1"]], [Plain [Str "Dev2"]]]]
23 |   snd res `shouldBe` [Str "Dev1", Str "Dev2"]
24 | 


--------------------------------------------------------------------------------
/test/Plugins/LatestIssuesPluginSpec.hs:
--------------------------------------------------------------------------------
 1 | module Plugins.LatestIssuesPluginSpec where
 2 | 
 3 | import           Frost
 4 | import           Frost.Effects.Github
 5 | import           Frost.Plugin
 6 | import           Frost.Plugins.LatestIssuesPlugin
 7 | 
 8 | import           Data.Function                    ((&))
 9 | import           Polysemy
10 | import           Test.Hspec
11 | import           Text.Pandoc
12 | 
13 | spec :: Spec
14 | spec =
15 |   describe "LatestIssuesPlugin" $
16 |     it "should substitute frost code blocks with content from the github effect" $ do
17 |   let res = substitute latestIssuesPlugin ""
18 |         & runGithubPure ["The best issue ever", "The second best issue ever", "One other issue", "YAI"]
19 |         & run
20 |   fst res `shouldBe` [BulletList [ [Plain [Str "The best issue ever"]], [Plain [Str "The second best issue ever"]], [Plain [Str "One other issue"]], [Plain [Str "YAI"]] ]]
21 |   snd res `shouldBe` [Str "The best issue ever", Str "The second best issue ever", Str "One other issue", Str "YAI"]
22 | 


--------------------------------------------------------------------------------
/test/PythonSpec.hs:
--------------------------------------------------------------------------------
 1 | {-# LANGUAGE TupleSections #-}
 2 | module PythonSpec where
 3 | 
 4 | import           Frost.Effects.Python
 5 | import           Frost.Effects.Sys
 6 | 
 7 | import           Polysemy
 8 | 
 9 | import           Data.Function        ((&))
10 | import           Test.Hspec
11 | 
12 | spec :: Spec
13 | spec =
14 |   describe "Frost.Effects.Python runPython" $
15 |     it "run script should call 'python -c script'" $ do
16 |   let result = runPython (exec "script")
17 |              & runCmd ("python -c 'script'", withStdOut "executed a python script")
18 |              & run
19 |   result `shouldBe` "executed a python script"
20 | 
21 | runCmd :: (String, (StdOut, StdErr)) -> Sem (Sys ': r) a -> Sem r a
22 | runCmd (arg, response) = runSysPure ts func
23 |   where
24 |     ts = undefined
25 |     func str = if str == arg then response else ("", "")
26 | 
27 | withStdOut :: String -> (StdOut, StdErr)
28 | withStdOut = (, "")
29 | 


--------------------------------------------------------------------------------
/test/RunInputPandocSpec.hs:
--------------------------------------------------------------------------------
 1 | {-# LANGUAGE QuasiQuotes #-}
 2 | module RunInputPandocSpec where
 3 | 
 4 | import           Frost.Effects.FileProvider
 5 | import           Frost.PandocRun
 6 | 
 7 | import           Polysemy
 8 | import           Polysemy.Error
 9 | import           Polysemy.Input
10 | import           Polysemy.State
11 | import           PolysemyContrib
12 | 
13 | import           Data.Function              ((&))
14 | import           Data.Map
15 | import qualified Data.Text                  as T
16 | import           Test.Hspec
17 | import           Text.Pandoc
18 | import           Text.RawString.QQ
19 | 
20 | fetch :: String -> IO (Either PandocError Pandoc)
21 | fetch content = do
22 |   res <- input
23 |     & runInputPandoc ["documentation.md"]
24 |     & runFileProviderPure
25 |     & runState (singleton "documentation.md" (T.pack content))
26 |     & runError
27 |     & runM
28 |   return $ fmap (head . snd) res
29 | 
30 | pluginAsCodeBlock = [r|
31 | ```frost:plugin
32 | ```
33 | |]
34 | 
35 | pluginAsCodeBlockWithContent = [r|
36 | ```frost:plugin
37 | some content here
38 | ```
39 | |]
40 | 
41 | pluginInlined = [r|
42 | `frost:plugin`
43 | |]
44 | 
45 | pluginInlinedSurroundedByText = [r|
46 | The value is: `frost:plugin` ... wow!
47 | |]
48 | 
49 | spec :: Spec
50 | spec =
51 |   describe "Frost.PandocRun runInputPandoc" $ do
52 |     it "with plugin as code block" $ do
53 |       Right(Pandoc _ blocks) <- fetch pluginAsCodeBlock
54 |       blocks `shouldBe` [CodeBlock ("",["frost:plugin"],[]) ""]
55 | 
56 |     it "with plugin as code block with content" $ do
57 |       Right(Pandoc _ blocks) <- fetch pluginAsCodeBlockWithContent
58 |       blocks `shouldBe` [CodeBlock ("",["frost:plugin"],[]) "some content here"]
59 | 
60 |     it "with plugin as inlined code" $ do
61 |       Right(Pandoc _ blocks) <- fetch pluginInlined
62 |       blocks `shouldBe` [Para [Code ("",[],[]) "frost:plugin"]]
63 | 
64 |     it "with plugin as inlined code surrounded by text" $ do
65 |       Right(Pandoc _ blocks) <- fetch pluginInlinedSurroundedByText
66 |       blocks `shouldBe` [Para [ Str "The"
67 |                               , Space
68 |                               , Str "value"
69 |                               , Space
70 |                               , Str "is:"
71 |                               , Space
72 |                               , Code ("",[],[]) "frost:plugin"
73 |                               , Space
74 |                               , Str "..."
75 |                               , Space
76 |                               , Str "wow!"]]
77 | 


--------------------------------------------------------------------------------
/test/Spec.hs:
--------------------------------------------------------------------------------
1 | {-# OPTIONS_GHC -F -pgmF hspec-discover #-}
2 | 


--------------------------------------------------------------------------------
/test/StackSpec.hs:
--------------------------------------------------------------------------------
 1 | {-# LANGUAGE TupleSections #-}
 2 | module StackSpec where
 3 | 
 4 | import           Frost.Effects.Stack
 5 | import           Frost.Effects.Sys
 6 | 
 7 | import           Polysemy
 8 | 
 9 | import           Data.Function       ((&))
10 | import           Test.Hspec
11 | 
12 | spec :: Spec
13 | spec =
14 |   describe "Frost.Effects.Stack runStack" $ do
15 |     it "clean should call stack --no-terminal clean" $ do
16 |       let result = runStackSys clean
17 |                  & runCmd ("stack --no-terminal clean", withStdErr "cleaned")
18 |                  & run
19 |       result `shouldBe` "cleaned"
20 |     it "build should call stack --no-terminal build" $ do
21 |       let result = runStackSys build
22 |                  & runCmd ("stack --no-terminal build", withStdErr "built")
23 |                  & run
24 |       result `shouldBe` "built"
25 |     it "exec should call stack --no-terminal exec <<program_name>>" $ do
26 |       let result = runStackSys (exec "foo-exe")
27 |                  & runCmd ("stack --no-terminal exec foo-exe", withStdErr "result of exec")
28 |                  & run
29 |       result `shouldBe` "result of exec"
30 |     it "test should call stack --no-terminal test" $ do
31 |       let result = runStackSys test
32 |                  & runCmd ("stack --no-terminal test", withStdOut "result of test")
33 |                  & run
34 |       result `shouldBe` "result of test"
35 |     it "testMatch should call stack --no-terminal test --match \"/<<filename>>/<<specname>>/<<testname>>/\"" $ do
36 |       let result = runStackSys (testMatch "boo" "foo" "bar")
37 |                  & runCmd ("stack --no-terminal test --match \"/boo/foo/bar/\"", withStdOut "result of test")
38 |                  & run
39 |       result `shouldBe` "result of test"
40 | 
41 | runCmd :: (String, (StdOut, StdErr)) -> Sem (Sys ': r) a -> Sem r a
42 | runCmd (arg, response) = runSysPure ts func
43 |   where
44 |     ts = undefined
45 |     func str = if str == arg then response else ("", "")
46 | 
47 | withStdOut :: String -> (StdOut, StdErr)
48 | withStdOut = (, "")
49 | 
50 | withStdErr :: String -> (StdOut, StdErr)
51 | withStdErr = ("", )
52 | 


--------------------------------------------------------------------------------
/test/TransformSpec.hs:
--------------------------------------------------------------------------------
  1 | module TransformSpec where
  2 | 
  3 | import           Frost
  4 | import           Frost.Plugin
  5 | import           FrostError
  6 | 
  7 | import           Data.Function  ((&))
  8 | import           Data.Map
  9 | import qualified Data.Text      as T
 10 | import           Polysemy
 11 | import           Polysemy.Error
 12 | import           Test.Hspec
 13 | import           Text.Pandoc
 14 | 
 15 | {-# ANN module ("HLint: ignore Reduce duplication" :: String) #-}
 16 | 
 17 | purgePlugin :: Plugin r
 18 | purgePlugin = Plugin { pluginName = "null"
 19 |                      , substitute = \_ -> return ([], [])
 20 |                      , addToMeta = \m -> return nullMeta
 21 |                      }
 22 | 
 23 | textPlugin :: String -> Plugin r
 24 | textPlugin text = justContentPlugin "text:insert" (\_ -> return ([Plain [Str text]], [Str text]))
 25 | 
 26 | doublePlugin ::  Plugin r
 27 | doublePlugin= justContentPlugin "double" (\i -> return ([Plain [Str $ show $ 2 * read i]], [Str $ show $ 2 * read i]))
 28 | 
 29 | addEntryMetaPlugin :: String -> String -> Plugin r
 30 | addEntryMetaPlugin key value = justMetaPlugin "meta:plugin" (return . Meta . insert key (MetaString value) . unMeta )
 31 | 
 32 | appendEntryMetaPlugin :: String -> String -> Plugin r
 33 | appendEntryMetaPlugin key value = justMetaPlugin "meta:plugin" (return . Meta . insertWith concat key (MetaString value) . unMeta )
 34 |   where
 35 |     concat (MetaString m2) (MetaString m1) = MetaString(m1 ++ m2)
 36 | 
 37 | 
 38 | spec :: Spec
 39 | spec =
 40 |   describe "Frost.Plugins transform" $ do
 41 |     it "should keep document as is, if no frost code blocks in it" $ do
 42 |       -- given
 43 |       let blocks = [ HorizontalRule
 44 |                    , Plain [Str "test"]]
 45 |       let pandoc = Pandoc nullMeta blocks
 46 |       -- when
 47 |       let Right transformed =  run $ runError $ transform [purgePlugin] pandoc
 48 |       -- then
 49 |       transformed `shouldBe` pandoc
 50 | 
 51 |     it "should substitute frost code blocks with content from plugin" $ do
 52 |       -- given
 53 |       let blocks = [ CodeBlock ("",["frost:text:insert"],[]) ""]
 54 |       let pandoc = Pandoc nullMeta blocks
 55 |       -- when
 56 |       let Right(Pandoc _ transformedBlocks) =
 57 |             run $ runError $ transform [textPlugin "hello world!"] pandoc
 58 |       -- then
 59 |       transformedBlocks `shouldBe` [ Plain [Str "hello world!"]]
 60 | 
 61 |     it "should modify document with multiple plugins" $ do
 62 |       -- given
 63 |       let blocks = [ CodeBlock ("",["frost:text:insert"],[]) ""
 64 |                    , CodeBlock ("",["frost:double"],[]) "2"]
 65 |       let pandoc = Pandoc nullMeta blocks
 66 |       let plugs = [doublePlugin, textPlugin "hello world!"]
 67 |       -- when
 68 |       let Right(Pandoc _ transformedBlocks) =  run $ runError $ transform plugs pandoc
 69 |       -- then
 70 |       transformedBlocks `shouldBe` [ Plain [Str "hello world!"]
 71 |                                    , Plain [Str "4"]]
 72 | 
 73 |     it "should modify document with multiple plugins" $ do
 74 |       -- given
 75 |       let blocks = [Para [ Str "The"
 76 |                               , Space
 77 |                               , Str "value:"
 78 |                               , Space
 79 |                               , Code ("",[],[]) "frost:text:insert"
 80 |                               , Space
 81 |                               , Code ("",[],[]) "frost:double 5"
 82 |                          ]
 83 |                    ]
 84 |       let pandoc = Pandoc nullMeta blocks
 85 |       let plugs = [doublePlugin, textPlugin "hello world!"]
 86 |       -- when
 87 |       let Right(Pandoc _ transformedBlocks) =  run $ runError $ transform plugs pandoc
 88 |       -- then
 89 |       transformedBlocks `shouldBe` [Para [ Str "The"
 90 |                                          , Space
 91 |                                          , Str "value:"
 92 |                                          , Space
 93 |                                          , Str "hello world!"
 94 |                                          , Space
 95 |                                          , Str "10"
 96 |                                          ]
 97 |                                    ]
 98 | 
 99 |     it "should modify a document with multiple meta plugins" $ do
100 |       -- given
101 |       let pandoc = Pandoc nullMeta [Null]
102 |       let plugs = [addEntryMetaPlugin "key1" "value1", addEntryMetaPlugin "key2" "value2"]
103 |       -- when
104 |       let Right(Pandoc transformedMeta _) =  run $ runError $ transform plugs pandoc
105 |       -- then
106 |       transformedMeta `shouldBe` Meta (fromList [("key1", MetaString"value1"),("key2", MetaString"value2")])
107 | 
108 |     it "should respect the order of execution of meta plugins" $ do
109 |       -- given
110 |       let pandoc = Pandoc nullMeta [Null]
111 |       let key = "key1"
112 |       let plugs = [
113 |             appendEntryMetaPlugin key "value1",
114 |             appendEntryMetaPlugin key "value2",
115 |             appendEntryMetaPlugin key "value3"
116 |             ]
117 |       -- when
118 |       let Right(Pandoc transformedMeta _) =  run $ runError $ transform plugs pandoc
119 |       -- then
120 |       transformedMeta `shouldBe` Meta (fromList [("key1", MetaString"value1value2value3")])
121 | 
122 |     it "should stop with error if plugin not found for given frost block" $ do
123 |       -- given
124 |       let blocks = [CodeBlock ("",["frost:text:insert"],[]) ""]
125 |       let pandoc = Pandoc nullMeta blocks
126 |       let plugs = [purgePlugin]
127 |       -- when
128 |       let Left error =  run $ runError $ transform plugs pandoc
129 |       -- then
130 |       error `shouldBe` PluginNotAvailable "frost:text:insert"
131 | 


--------------------------------------------------------------------------------