diff options
| author | Miguel <m.i@gmx.at> | 2019-02-19 16:42:05 +0100 |
|---|---|---|
| committer | Miguel <m.i@gmx.at> | 2019-02-19 16:42:05 +0100 |
| commit | 4b2d1a4571f44f8287888985aa8669b0151e7541 (patch) | |
| tree | 176142ae4e7d125f303c9e6bae149c1474d0d430 /080_blog/00040_Haskell-Projects | |
| parent | 5c530e67256f8ecbd93336ba4e876acbba73f716 (diff) | |
v0.1
Diffstat (limited to '080_blog/00040_Haskell-Projects')
| -rw-r--r-- | 080_blog/00040_Haskell-Projects/00040_Graham-Scan/index.md (renamed from 080_blog/00040_Haskell-Projects/00040_Graham-Scan-(Haskell)/index.md) | 0 | ||||
| -rw-r--r-- | 080_blog/00040_Haskell-Projects/00065_Base64-Encoder/index.md (renamed from 080_blog/00040_Haskell-Projects/00065_Base64-Encoder-(Haskell)/index.md) | 0 | ||||
| -rw-r--r-- | 080_blog/00040_Haskell-Projects/00120_Lambda-Calculus/index.md (renamed from 080_blog/00040_Haskell-Projects/00120_Lambda-Calculus-(Haskell)/index.md) | 0 | ||||
| -rw-r--r-- | 080_blog/00040_Haskell-Projects/00130_Calculator-on-Parsec-and-GTK/calc.glade | 312 | ||||
| -rw-r--r-- | 080_blog/00040_Haskell-Projects/00130_Calculator-on-Parsec-and-GTK/calc.hs | 74 | ||||
| -rw-r--r-- | 080_blog/00040_Haskell-Projects/00130_Calculator-on-Parsec-and-GTK/calc.png | bin | 0 -> 22734 bytes | |||
| -rw-r--r-- | 080_blog/00040_Haskell-Projects/00130_Calculator-on-Parsec-and-GTK/index.md (renamed from 080_blog/00040_Haskell-Projects/00130_Calculator-on-Parsec-and-GTK-(Haskell)/index.md) | 16 | ||||
| -rw-r--r-- | 080_blog/00040_Haskell-Projects/00140_Minimalistic-SVG-Generator/SimpleSvg.hs (renamed from 080_blog/00040_Haskell-Projects/00140_Minimalistic-SVG-Generator-(Haskell)/SimpleSvg.hs) | 0 | ||||
| -rw-r--r-- | 080_blog/00040_Haskell-Projects/00140_Minimalistic-SVG-Generator/index.md (renamed from 080_blog/00040_Haskell-Projects/00140_Minimalistic-SVG-Generator-(Haskell)/index.md) | 0 | ||||
| -rw-r--r-- | 080_blog/00040_Haskell-Projects/00140_Minimalistic-SVG-Generator/svg.png (renamed from 080_blog/00040_Haskell-Projects/00140_Minimalistic-SVG-Generator-(Haskell)/svg.png) | bin | 13130 -> 13130 bytes | |||
| -rw-r--r-- | 080_blog/00040_Haskell-Projects/100_Estatico-Page-Maker/index.md | 35 | ||||
| -rw-r--r-- | 080_blog/00040_Haskell-Projects/100_Static-Page-Maker-in-Haskell/index.md | 121 |
12 files changed, 426 insertions, 132 deletions
diff --git a/080_blog/00040_Haskell-Projects/00040_Graham-Scan-(Haskell)/index.md b/080_blog/00040_Haskell-Projects/00040_Graham-Scan/index.md index 195dbe1..195dbe1 100644 --- a/080_blog/00040_Haskell-Projects/00040_Graham-Scan-(Haskell)/index.md +++ b/080_blog/00040_Haskell-Projects/00040_Graham-Scan/index.md diff --git a/080_blog/00040_Haskell-Projects/00065_Base64-Encoder-(Haskell)/index.md b/080_blog/00040_Haskell-Projects/00065_Base64-Encoder/index.md index 830ed8d..830ed8d 100644 --- a/080_blog/00040_Haskell-Projects/00065_Base64-Encoder-(Haskell)/index.md +++ b/080_blog/00040_Haskell-Projects/00065_Base64-Encoder/index.md diff --git a/080_blog/00040_Haskell-Projects/00120_Lambda-Calculus-(Haskell)/index.md b/080_blog/00040_Haskell-Projects/00120_Lambda-Calculus/index.md index 25c6b83..25c6b83 100644 --- a/080_blog/00040_Haskell-Projects/00120_Lambda-Calculus-(Haskell)/index.md +++ b/080_blog/00040_Haskell-Projects/00120_Lambda-Calculus/index.md diff --git a/080_blog/00040_Haskell-Projects/00130_Calculator-on-Parsec-and-GTK/calc.glade b/080_blog/00040_Haskell-Projects/00130_Calculator-on-Parsec-and-GTK/calc.glade new file mode 100644 index 0000000..db09761 --- /dev/null +++ b/080_blog/00040_Haskell-Projects/00130_Calculator-on-Parsec-and-GTK/calc.glade @@ -0,0 +1,312 @@ +<?xml version="1.0" encoding="UTF-8"?> +<!-- Generated with glade 3.20.0 --> +<interface> + <requires lib="gtk+" version="3.20"/> + <object class="GtkWindow" id="mainWindow"> + <property name="can_focus">False</property> + <child> + <object class="GtkBox"> + <property name="visible">True</property> + <property name="can_focus">False</property> + <property name="orientation">vertical</property> + <property name="homogeneous">True</property> + <child> + <object class="GtkBox"> + <property name="visible">True</property> + <property name="can_focus">False</property> + <property name="orientation">vertical</property> + <child> + <object class="GtkScrolledWindow" id=" "> + <property name="visible">True</property> + <property name="can_focus">True</property> + <property name="shadow_type">in</property> + <child> + <object class="GtkTextView" id="hist"> + <property name="visible">True</property> + <property name="can_focus">True</property> + </object> + </child> + </object> + <packing> + <property name="expand">True</property> + <property name="fill">True</property> + <property name="position">0</property> + </packing> + </child> + <child> + <object class="GtkTextView" id="output"> + <property name="visible">True</property> + <property name="can_focus">True</property> + <property name="editable">False</property> + <property name="cursor_visible">False</property> + </object> + <packing> + <property name="expand">True</property> + <property name="fill">True</property> + <property name="position">1</property> + </packing> + </child> + </object> + <packing> + <property name="expand">False</property> + <property name="fill">True</property> + <property name="position">0</property> + </packing> + </child> + <child> + <object class="GtkGrid"> + <property name="visible">True</property> + <property name="can_focus">False</property> + <property name="row_homogeneous">True</property> + <property name="column_homogeneous">True</property> + <child> + <object class="GtkButton" id="1"> + <property name="label" translatable="yes">1</property> + <property name="visible">True</property> + <property name="can_focus">True</property> + <property name="receives_default">True</property> + </object> + <packing> + <property name="left_attach">0</property> + <property name="top_attach">2</property> + </packing> + </child> + <child> + <object class="GtkButton" id="2"> + <property name="label" translatable="yes">2</property> + <property name="visible">True</property> + <property name="can_focus">True</property> + <property name="receives_default">True</property> + </object> + <packing> + <property name="left_attach">1</property> + <property name="top_attach">2</property> + </packing> + </child> + <child> + <object class="GtkButton" id="3"> + <property name="label" translatable="yes">3</property> + <property name="visible">True</property> + <property name="can_focus">True</property> + <property name="receives_default">True</property> + </object> + <packing> + <property name="left_attach">2</property> + <property name="top_attach">2</property> + </packing> + </child> + <child> + <object class="GtkButton" id="4"> + <property name="label" translatable="yes">4</property> + <property name="visible">True</property> + <property name="can_focus">True</property> + <property name="receives_default">True</property> + </object> + <packing> + <property name="left_attach">0</property> + <property name="top_attach">1</property> + </packing> + </child> + <child> + <object class="GtkButton" id="5"> + <property name="label" translatable="yes">5</property> + <property name="visible">True</property> + <property name="can_focus">True</property> + <property name="receives_default">True</property> + </object> + <packing> + <property name="left_attach">1</property> + <property name="top_attach">1</property> + </packing> + </child> + <child> + <object class="GtkButton" id="6"> + <property name="label" translatable="yes">6</property> + <property name="visible">True</property> + <property name="can_focus">True</property> + <property name="receives_default">True</property> + </object> + <packing> + <property name="left_attach">2</property> + <property name="top_attach">1</property> + </packing> + </child> + <child> + <object class="GtkButton" id="7"> + <property name="label" translatable="yes">7</property> + <property name="visible">True</property> + <property name="can_focus">True</property> + <property name="receives_default">True</property> + </object> + <packing> + <property name="left_attach">0</property> + <property name="top_attach">0</property> + </packing> + </child> + <child> + <object class="GtkButton" id="8"> + <property name="label" translatable="yes">8</property> + <property name="visible">True</property> + <property name="can_focus">True</property> + <property name="receives_default">True</property> + </object> + <packing> + <property name="left_attach">1</property> + <property name="top_attach">0</property> + </packing> + </child> + <child> + <object class="GtkButton" id="9"> + <property name="label" translatable="yes">9</property> + <property name="visible">True</property> + <property name="can_focus">True</property> + <property name="receives_default">True</property> + </object> + <packing> + <property name="left_attach">2</property> + <property name="top_attach">0</property> + </packing> + </child> + <child> + <object class="GtkButton" id="0"> + <property name="label" translatable="yes">0</property> + <property name="visible">True</property> + <property name="can_focus">True</property> + <property name="receives_default">True</property> + </object> + <packing> + <property name="left_attach">0</property> + <property name="top_attach">3</property> + </packing> + </child> + <child> + <object class="GtkButton" id="."> + <property name="label" translatable="yes">.</property> + <property name="visible">True</property> + <property name="can_focus">True</property> + <property name="receives_default">True</property> + </object> + <packing> + <property name="left_attach">1</property> + <property name="top_attach">3</property> + </packing> + </child> + <child> + <object class="GtkButton" id="="> + <property name="label" translatable="yes">=</property> + <property name="visible">True</property> + <property name="can_focus">True</property> + <property name="receives_default">True</property> + </object> + <packing> + <property name="left_attach">3</property> + <property name="top_attach">0</property> + </packing> + </child> + <child> + <object class="GtkButton" id="("> + <property name="label" translatable="yes">(</property> + <property name="visible">True</property> + <property name="can_focus">True</property> + <property name="receives_default">True</property> + </object> + <packing> + <property name="left_attach">2</property> + <property name="top_attach">3</property> + </packing> + </child> + <child> + <object class="GtkButton" id="+"> + <property name="label" translatable="yes">+</property> + <property name="visible">True</property> + <property name="can_focus">True</property> + <property name="receives_default">True</property> + </object> + <packing> + <property name="left_attach">0</property> + <property name="top_attach">4</property> + </packing> + </child> + <child> + <object class="GtkButton" id="-"> + <property name="label" translatable="yes">-</property> + <property name="visible">True</property> + <property name="can_focus">True</property> + <property name="receives_default">True</property> + </object> + <packing> + <property name="left_attach">1</property> + <property name="top_attach">4</property> + </packing> + </child> + <child> + <object class="GtkButton" id="*"> + <property name="label" translatable="yes">*</property> + <property name="visible">True</property> + <property name="can_focus">True</property> + <property name="receives_default">True</property> + </object> + <packing> + <property name="left_attach">2</property> + <property name="top_attach">4</property> + </packing> + </child> + <child> + <object class="GtkButton" id="/"> + <property name="label" translatable="yes">/</property> + <property name="visible">True</property> + <property name="can_focus">True</property> + <property name="receives_default">True</property> + </object> + <packing> + <property name="left_attach">3</property> + <property name="top_attach">4</property> + </packing> + </child> + <child> + <object class="GtkButton" id="CLR"> + <property name="label" translatable="yes">CLR</property> + <property name="visible">True</property> + <property name="can_focus">True</property> + <property name="receives_default">True</property> + </object> + <packing> + <property name="left_attach">3</property> + <property name="top_attach">1</property> + </packing> + </child> + <child> + <object class="GtkButton" id="DEL"> + <property name="label" translatable="yes">DEL</property> + <property name="visible">True</property> + <property name="can_focus">True</property> + <property name="receives_default">True</property> + </object> + <packing> + <property name="left_attach">3</property> + <property name="top_attach">2</property> + </packing> + </child> + <child> + <object class="GtkButton" id=")"> + <property name="label" translatable="yes">)</property> + <property name="visible">True</property> + <property name="can_focus">True</property> + <property name="receives_default">True</property> + </object> + <packing> + <property name="left_attach">3</property> + <property name="top_attach">3</property> + </packing> + </child> + </object> + <packing> + <property name="expand">True</property> + <property name="fill">True</property> + <property name="position">1</property> + </packing> + </child> + </object> + </child> + </object> +</interface> diff --git a/080_blog/00040_Haskell-Projects/00130_Calculator-on-Parsec-and-GTK/calc.hs b/080_blog/00040_Haskell-Projects/00130_Calculator-on-Parsec-and-GTK/calc.hs new file mode 100644 index 0000000..ec47e05 --- /dev/null +++ b/080_blog/00040_Haskell-Projects/00130_Calculator-on-Parsec-and-GTK/calc.hs @@ -0,0 +1,74 @@ +-- Simple Stupid Calculator demonstrating basic gtk/glade and parsec parser usage -- +-- Hacked togeter by Miguel on May 3, 2018 + +{-# LANGUAGE PackageImports #-} +import "gtk3" Graphics.UI.Gtk +import Control.Monad.IO.Class +import Data.ByteString.Char8 (pack,unpack) +import Numeric +import Text.Parsec +import Text.Parsec.Expr +import Text.Parsec.Language +import Text.Parsec.Number (fractional2) +import Text.Parsec.Token + +-- parse calculation -- +calc s = case parse expr "" s of Right x -> showFFloat Nothing x "" + _ -> "?" + +table = [ [binary "*" (*) AssocLeft, binary "/" (/) AssocLeft ] + , [binary "+" (+) AssocLeft, binary "-" (-) AssocLeft ] ] + +lexer = makeTokenParser haskellDef +expr = buildExpressionParser table term <?> "expression" +term = parens lexer expr <|> fractional2 False <?> "simple expression" + +binary name fun assoc = Infix (do{ reservedOp lexer name; return fun }) assoc + +-- gui for the calculator -- +main = do initGUI + builder <- builderNew + builderAddFromFile builder "calc.glade" + window <- builderGetObject builder castToWindow "mainWindow" + output <- builderGetObject builder castToTextView "output" + outputBuff <- textViewGetBuffer output + hist <- builderGetObject builder castToTextView "hist" + histBuff <- textViewGetBuffer hist + end<-textBufferGetEndIter histBuff + histMark <- textBufferCreateMark histBuff Nothing end True + + let conn = connBtn builder outputBuff + connA = connBtnAct builder outputBuff + + -- connecting buttons -- + sequence_ $ conn <$> map show [0..9] ++ ["+","-","/","*","(",")","."] + + connA "CLR" $ textBufferSetByteString outputBuff (pack "") + connA "DEL" $ manipTextBuff outputBuff (\x -> case x of [] -> []; xs -> init xs) + connA "=" $ do txt<-getTextBuff outputBuff + manipTextBuff outputBuff calc + res<-getTextBuff outputBuff + manipTextBuff histBuff (\x -> x++txt++" = "++res++"\n") + end<-textBufferGetEndIter histBuff + textBufferMoveMark histBuff histMark end + textViewScrollToMark hist histMark 0 $ Just (0,1) + return () + + -- handler to run on window destruction + window `on` deleteEvent $ do liftIO mainQuit + return False + widgetShowAll window + mainGUI + +getTextBuff outputBuff = do start<-textBufferGetStartIter outputBuff + end<-textBufferGetEndIter outputBuff + unpack <$> textBufferGetByteString outputBuff start end True + +manipTextBuff outputBuff action = do txt<-getTextBuff outputBuff + textBufferSetByteString outputBuff (pack $ action $ txt) + +connBtn builder buff label = connBtnAct builder buff label $ + textBufferInsertByteStringAtCursor buff (pack label) + +connBtnAct builder buff label act = do btn <- builderGetObject builder castToButton label + btn `on` buttonActivated $ act diff --git a/080_blog/00040_Haskell-Projects/00130_Calculator-on-Parsec-and-GTK/calc.png b/080_blog/00040_Haskell-Projects/00130_Calculator-on-Parsec-and-GTK/calc.png Binary files differnew file mode 100644 index 0000000..7cb35c3 --- /dev/null +++ b/080_blog/00040_Haskell-Projects/00130_Calculator-on-Parsec-and-GTK/calc.png diff --git a/080_blog/00040_Haskell-Projects/00130_Calculator-on-Parsec-and-GTK-(Haskell)/index.md b/080_blog/00040_Haskell-Projects/00130_Calculator-on-Parsec-and-GTK/index.md index 9701481..381b017 100644 --- a/080_blog/00040_Haskell-Projects/00130_Calculator-on-Parsec-and-GTK-(Haskell)/index.md +++ b/080_blog/00040_Haskell-Projects/00130_Calculator-on-Parsec-and-GTK/index.md @@ -3,7 +3,7 @@ Simple Calculator on Parsec and GTK May 3, 2018 -{.img-fluid .border} +{.img-fluid .border} Today I implemented this simple stupid calulator as a side effect of playing around with parsec [1] and haskells gtk3 [2] bindings, as well as glade [3] - @@ -12,17 +12,11 @@ an interactive user interface designer. Source Files ------------ -* [calc.hs](/DATA/haskell/calc/calc.hs) -* [calc.glade](/DATA/haskell/calc/calc.glade) +* [calc.hs](calc.hs) +* [calc.glade](calc.glade) -calc.hs Listing ---------------- - -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ {.haskell .numberLines} -{BEGIN:SOURCE} -./DATA/haskell/calc/calc.hs -{END:SOURCE} -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Ref +--- [1] https://hackage.haskell.org/package/parsec [2] https://hackage.haskell.org/package/gtk3 diff --git a/080_blog/00040_Haskell-Projects/00140_Minimalistic-SVG-Generator-(Haskell)/SimpleSvg.hs b/080_blog/00040_Haskell-Projects/00140_Minimalistic-SVG-Generator/SimpleSvg.hs index 7b44557..7b44557 100644 --- a/080_blog/00040_Haskell-Projects/00140_Minimalistic-SVG-Generator-(Haskell)/SimpleSvg.hs +++ b/080_blog/00040_Haskell-Projects/00140_Minimalistic-SVG-Generator/SimpleSvg.hs diff --git a/080_blog/00040_Haskell-Projects/00140_Minimalistic-SVG-Generator-(Haskell)/index.md b/080_blog/00040_Haskell-Projects/00140_Minimalistic-SVG-Generator/index.md index 8211ba2..8211ba2 100644 --- a/080_blog/00040_Haskell-Projects/00140_Minimalistic-SVG-Generator-(Haskell)/index.md +++ b/080_blog/00040_Haskell-Projects/00140_Minimalistic-SVG-Generator/index.md diff --git a/080_blog/00040_Haskell-Projects/00140_Minimalistic-SVG-Generator-(Haskell)/svg.png b/080_blog/00040_Haskell-Projects/00140_Minimalistic-SVG-Generator/svg.png Binary files differindex d679fad..d679fad 100644 --- a/080_blog/00040_Haskell-Projects/00140_Minimalistic-SVG-Generator-(Haskell)/svg.png +++ b/080_blog/00040_Haskell-Projects/00140_Minimalistic-SVG-Generator/svg.png diff --git a/080_blog/00040_Haskell-Projects/100_Estatico-Page-Maker/index.md b/080_blog/00040_Haskell-Projects/100_Estatico-Page-Maker/index.md new file mode 100644 index 0000000..04bb46a --- /dev/null +++ b/080_blog/00040_Haskell-Projects/100_Estatico-Page-Maker/index.md @@ -0,0 +1,35 @@ +# Estático - A Static Website Genertor coded in Haskell + + April 12, 2018 + +About two weeks ago, for personal reasons, I decided to switch my website +from a well known PHP driven CMS solution, to a light and static set +of html pages. + +I used this fact to write my own simple static website generator. +And, Yes... I know there are already hundereds of such genertors +out there, but I wanted to practice Haskell and my masturbatory solution +fits in about 200 lines of code, including comments and type signatures. + +I use pandoc for all the heavy work, as syntax highlighting and parsing +of the markdown files, anyway. + +## Features + +* No Database +* Static Content +* Sitemap derived from Directory Tree +* Simple Markdown Files + +## Try It +You can find the most recent version here and build it with _stack_. + +* [https://gitweb.softwarefools.com/?p=miguel/staticuswww.git](https://gitweb.softwarefools.com/?p=miguel/staticuswww.git) + +__Do not forget to adapt the Makefile to your requirements__ + +## Examples +The only example I know of, is this very page: _idziorek.net_ +You can find it's sources here: + +* [https://gitweb.softwarefools.com/?p=miguel/idziorek\_net.git](https://gitweb.softwarefools.com/?p=miguel/idziorek_net.git) diff --git a/080_blog/00040_Haskell-Projects/100_Static-Page-Maker-in-Haskell/index.md b/080_blog/00040_Haskell-Projects/100_Static-Page-Maker-in-Haskell/index.md deleted file mode 100644 index 0619078..0000000 --- a/080_blog/00040_Haskell-Projects/100_Static-Page-Maker-in-Haskell/index.md +++ /dev/null @@ -1,121 +0,0 @@ -# Static Haskell Website Creator - Miguel's Lair - - April 12, 2018 - -About two weeks ago, for personal reasons, I decided to switch my homepage -from a well known PHP driven CMS solution, to a light and static set -of html pages. - -I used this fact as a pretence to write my own simple static website -generator. And, Yes.. I know there are already hundereds of such genertors -out there, but I wanted to practice haskell and my masturbatory solution -fits in under 100 lines of code. (Including comments and type signatures) - -I use pandoc for all the heavy work, as syntax highlighting and conversion of -markdown to html, anyway. - -## Features - -* No Documentation -* No Database -* Sitemap derived from Directory Tree -* Simple Markdown Files for Content - -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ {.haskell .numberLines} --- --- Staticus WWW - A minimalistic yet undocumented static website generator --- coded in April 2018 by Michal Idziorek <m.i@gmx.at> --- - -module StaticusWWW where - -import Control.Exception -import Control.Monad.Reader -import Data.List -import Data.List.Split -import Data.List.Utils -import Data.Maybe -import Data.Text(pack,unpack) -import Data.Tree -import System.Directory -import Text.Pandoc - --- generate a HTML link from a href & title -htmlLink :: String -> String -> String -htmlLink href title="<a href='"++href++"'>"++replace "_" " " title++"</a>" - --- generate HTML breadcrumbs from a list of page titles -genBrc :: [String] -> String -genBrc b | length b < 2 = "" - | otherwise = fst $ foldl lnk ("",0) b - where lnk (a,c) v = (a++" / "++html c v,c+1) - html c = htmlLink (concat (replicate (length b-c-1) "../")) - --- pure function that generates a single HTML page from: --- a html template, description, keywords, breadcrumbs, topMenue & submenue -genPage :: String->String->String->[String]->[String]->[String]->String->String -genPage tmpl dsc kw brc top chld md = - foldr rplc tmpl (replacers content (menu "/" top) (menu "./" chld) (genBrc brc) title dsc kw) - where content = either (const "error") unpack res - where res = runPure $ do doc <- readMarkdown def{readerExtensions=(enableExtension Ext_raw_html pandocExtensions )} $ pack md - writeHtml5String def doc - rplc v = replace ("##" ++ fst v ++ "##") (snd v) - title = if null brc then "Home" else replace "_" " " $ last brc - menu p = foldr (fm p) "" - fm p s a = "<li>"++htmlLink (p++s) s ++"</li>"++a - replacers c m m2 b t d k= - [("CONTENT", c) - ,("LOGO", "/DATA/logo.png") - ,("STYLESHEET", "/DATA/style.css") - ,("SITE_TITLE", "Miguel's Lair") - ,("SITE_SUBTITLE", "<br />where information sleepzzZZZzz ...") - ,("TITLE", t) - ,("DESCRIPTION", d) - ,("KEYWORDS", k) - ,("AUTHOR", "Michal Idziorek") - ,("MENU", m) - ,("SUB_MENU", m2) - ,("BREADCRUMBS", b) - ,("FOOTER", "(c) by Miguel 2018")] - --- get list of subdirectories in given directory, with full relative path -getDirList :: FilePath -> IO [FilePath] -getDirList d = map ((d++"/")++) <$> listDirectory d - >>= filterM doesDirectoryExist - --- sequence IO Action 'f' for each subdirectory of 'fp' recursively -trvDirTree :: FilePath -> (FilePath -> [FilePath] -> IO()) -> IO () -trvDirTree fp f = unfoldTreeM unf fp >>= sequence_ - where unf p = getDirList p >>= \s -> f p s >>= \l -> - return (return l, s) - --- write the HTML page generated from current diectory by 'genPage' -wrtPage :: FilePath -> FilePath -> String -> [FilePath] -> FilePath -> [FilePath] -> IO () -wrtPage idx out tmpl top p chld = do - - when (not home) (createDirectory outdir) - - md <- readFile $ p ++ "/index.md" - cfg <- (map ((\(x:xs) -> (x,unwords xs)).words).lines) - <$> catch (readFile $ p++"/config") - ((\_ -> return "") :: IOException -> IO String) - - writeFile (outdir++"/index.html") - (genPage tmpl (lkp cfg "dsc") (lkp cfg "kwd") - brc (menu top) (if home then [] else menu chld) md) - - where home = outdir==out++"/" - remUnder = filter (not.null) . map (dropWhile(=='_').dropWhile(/='_')) - lkp cfg k = fromMaybe "" (lookup k cfg) - menu = remUnder . filter (not . isPrefixOf "00_") . map (last.splitOn "/") . sort - outdir = out ++ "/" ++ intercalate "/" brc - brc = remUnder $ splitOn "/" (drop (length idx) p) - --- Main IO action: traverses index recursively and calls wrtPage in each --- subdir, which in turn generates the output directories and html pages -main :: IO () -main = do tmpl <- readFile "./DATA/template.html" - top <- getDirList "./INDEX" - trvDirTree "./INDEX" (wrtPage "./INDEX" "./OUT" tmpl top) -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - |
