summaryrefslogtreecommitdiff
path: root/080_blog/00040_Haskell-Projects
diff options
context:
space:
mode:
authorMiguel <m.i@gmx.at>2019-02-19 16:42:05 +0100
committerMiguel <m.i@gmx.at>2019-02-19 16:42:05 +0100
commit4b2d1a4571f44f8287888985aa8669b0151e7541 (patch)
tree176142ae4e7d125f303c9e6bae149c1474d0d430 /080_blog/00040_Haskell-Projects
parent5c530e67256f8ecbd93336ba4e876acbba73f716 (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.glade312
-rw-r--r--080_blog/00040_Haskell-Projects/00130_Calculator-on-Parsec-and-GTK/calc.hs74
-rw-r--r--080_blog/00040_Haskell-Projects/00130_Calculator-on-Parsec-and-GTK/calc.pngbin0 -> 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)bin13130 -> 13130 bytes
-rw-r--r--080_blog/00040_Haskell-Projects/100_Estatico-Page-Maker/index.md35
-rw-r--r--080_blog/00040_Haskell-Projects/100_Static-Page-Maker-in-Haskell/index.md121
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
new file mode 100644
index 0000000..7cb35c3
--- /dev/null
+++ b/080_blog/00040_Haskell-Projects/00130_Calculator-on-Parsec-and-GTK/calc.png
Binary files differ
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
-![](/DATA/haskell/calc/calc.png){.img-fluid .border}
+![](calc.png){.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
index 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
Binary files differ
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)
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-