From 5c530e67256f8ecbd93336ba4e876acbba73f716 Mon Sep 17 00:00:00 2001 From: Miguel Date: Tue, 19 Feb 2019 12:25:40 +0100 Subject: cleaning up more.. --- .../00040_Graham-Scan-(Haskell)/index.md | 128 +++++++++++++++ .../00065_Base64-Encoder-(Haskell)/index.md | 51 ++++++ .../00120_Lambda-Calculus-(Haskell)/index.md | 38 +++++ .../index.md | 29 ++++ .../SimpleSvg.hs | 179 +++++++++++++++++++++ .../index.md | 31 ++++ .../svg.png | Bin 0 -> 13130 bytes .../100_Static-Page-Maker-in-Haskell/index.md | 121 ++++++++++++++ 080_blog/00040_Haskell-Projects/index.md | 4 + 9 files changed, 581 insertions(+) create mode 100644 080_blog/00040_Haskell-Projects/00040_Graham-Scan-(Haskell)/index.md create mode 100644 080_blog/00040_Haskell-Projects/00065_Base64-Encoder-(Haskell)/index.md create mode 100644 080_blog/00040_Haskell-Projects/00120_Lambda-Calculus-(Haskell)/index.md create mode 100644 080_blog/00040_Haskell-Projects/00130_Calculator-on-Parsec-and-GTK-(Haskell)/index.md create mode 100644 080_blog/00040_Haskell-Projects/00140_Minimalistic-SVG-Generator-(Haskell)/SimpleSvg.hs create mode 100644 080_blog/00040_Haskell-Projects/00140_Minimalistic-SVG-Generator-(Haskell)/index.md create mode 100644 080_blog/00040_Haskell-Projects/00140_Minimalistic-SVG-Generator-(Haskell)/svg.png create mode 100644 080_blog/00040_Haskell-Projects/100_Static-Page-Maker-in-Haskell/index.md create mode 100644 080_blog/00040_Haskell-Projects/index.md (limited to '080_blog/00040_Haskell-Projects') diff --git a/080_blog/00040_Haskell-Projects/00040_Graham-Scan-(Haskell)/index.md b/080_blog/00040_Haskell-Projects/00040_Graham-Scan-(Haskell)/index.md new file mode 100644 index 0000000..195dbe1 --- /dev/null +++ b/080_blog/00040_Haskell-Projects/00040_Graham-Scan-(Haskell)/index.md @@ -0,0 +1,128 @@ +Haskell – Convex Hull – Graham Scan +=================================== + +December 16, 2017 + +Playing with Convex Hulls (via Graham Scan) and SVG Export in Haskell: + +This is an embedded SVG generated by the Haskell programm below: + + + +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ {.haskell .numberLines} +--------------------------------------------------------------------------------------------- +-- +-- GRAHAM SCAN IMPLEMENTATION +-- +-- This little haskell programm calulates the Convex Hull for a set of 2D points. +-- It ships wit a main function that feeds the Graham Scan algorithm with some +-- random points and generates a simple SVG of the input points and resulting envelope. +-- A simple SVG encoder is included. +-- +-- Alogrithm used: https://en.wikipedia.org/wiki/Graham_scan +-- +-- CREDITS -- +-- +-- Michal Idziorek +-- 16 December 2017 +-- +--------------------------------------------------------------------------------------------- + +import Data.List +import System.Random + +--------------------------------------------------------------------------------------------- + +-- GRAHAM SCAN -- + +-- Three points are clockwise if ccw < 0. +ccw (p1x,p1y) (p2x,p2y) (p3x,p3y) = (p2x - p1x)*(p3y - p1y) - (p2y - p1y)*(p3x - p1x) + +-- Calculate the slope defined by 2 points. (return Infinity, if points are identical). +slope (ax,ay) (bx,by) | (ax,ay ) == (bx,by) = 1/0 -- Infinity + | otherwise = (bx-ax)/(by-ay) + +-- Comparison function to sort points counterclockwise (given a reference point). +slope_cmp a b c = compare (slope a c) (slope a b) + +-- Comparison function using the y and x coordinates for ordering. +graham_cmp (ax,ay) (bx,by) | ay /= by = compare ay by + | otherwise = compare ax bx + +-- Graham scan on prepared data. this will calculate the convex hull. +graham_calc [] hs = hs +graham_calc (x1:xs) hh | length(hh) < 2 = graham_calc xs (x1:hh) +graham_calc xx@(x1:xs) hh@(h1:h2:hs) | ccw x1 h1 h2 < 0 = graham_calc xs (x1:hh) + | otherwise = graham_calc xx (h2:hs) + +-- Find the starting point, sort all points counterclockwise and perform the graham scan. +graham xs = graham_calc sortedPoints [] + where minPoint = minimumBy graham_cmp xs + sortedPoints = sortBy (slope_cmp minPoint) xs + +--------------------------------------------------------------------------------------------- + +-- XML ENCODING-- + +xml_attr (x:xs) = x++"=\""++(head xs)++"\" " +xml_enc tag attrs body = "<"++tag++" "++xml_attrs++">"++body++"" + where xml_attrs = unlines $ map xml_attr attrs + +-- SVG ENCODING -- + +-- hardcoded scaling and panning function +svg_transf x = x*30+5 + +line_to_svg ((x1,y1),(x2,y2)) = xml_enc "line" [["x1",show lx1],["y1",show ly1], + ["x2",show lx2],["y2",show ly2], + ["style", "stroke:rgb(255,0,0);stroke-width:2"]] "" + where lx1=svg_transf x1 + lx2=svg_transf x2 + ly1=svg_transf y1 + ly2=svg_transf y2 + +point_to_svg (x,y) = xml_enc "circle" [["cx",show cx],["cy",show cy],["r","5"], + ["fill","rgb(30,150,"++(show (floor dist))++")"]] "" + where cx=svg_transf x + cy=svg_transf y + dist= (sqrt ((x-5)*(x-5) + (y-5)*(y-5)))*255/8 + + + +-- draws SVG points and lines (in hardcoded sizes and colors) +svg_draw p l = xml_enc "svg" [style,["width","330"],["height","330"]] body + where style = ["style", + "background-color:black;border:3px solid green;margin:2px;"] + body = (unlines (map point_to_svg p )) ++ + (unlines (map line_to_svg l )) + +-- calculate convex hull and generate svg +svg_graham xs = svg_draw xs (zip hull hull_open) + where hull_open = graham xs + hull = (last hull_open) : hull_open + +-- RANDOMIZING -- + +randomPoints g cnt = take cnt (zip r10a r10b) + where r5 = randomRs (0,5) g :: [Double] + r10a =zipWith (+) r5 (drop cnt r5) + r10b =zipWith (+) (drop (2*cnt) r5) (drop (3*cnt) r5) + +--------------------------------------------------------------------------------------------- + +-- MAIN -- + +-- Note that this is the only place of impurity in this source-file. +-- Is is subject to side effects due to I/O (we are writng to stdout) +-- and the random number generator. +main = do + g <- newStdGen + putStr (svg_graham (randomPoints g 25)) + putStr (svg_graham (randomPoints g 50)) + putStr (svg_graham (randomPoints g 100)) + putStr (svg_graham (randomPoints g 250)) + putStr (svg_graham (randomPoints g 500)) + putStr (svg_graham (randomPoints g 1500)) + +--------------------------------------------------------------------------------------------- +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ diff --git a/080_blog/00040_Haskell-Projects/00065_Base64-Encoder-(Haskell)/index.md b/080_blog/00040_Haskell-Projects/00065_Base64-Encoder-(Haskell)/index.md new file mode 100644 index 0000000..830ed8d --- /dev/null +++ b/080_blog/00040_Haskell-Projects/00065_Base64-Encoder-(Haskell)/index.md @@ -0,0 +1,51 @@ +Miguel's Naive Base64 Encoder +============================== + February 19, 2018 + +Coded on a winter afterfnoon on 19th Feb 2018 A.D. to fully understand +base64 encoding and play with haskell, which is always an indisputable +pleasure. + +The following lines were written in full awareness that 'libraries' for +this very purpose, which perform way better, are in existence. + +Coded in big anger due to nick's stories about saving his binary format, +encrypted passwords in an ascii config file, featuring +strange letters and characters. + +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ {.haskell .numberLines} +-- File: base64.hs -- + +import Data.Char +import Text.Printf +import qualified Data.List as L +import qualified Data.List.Split as T + +toBase64 x = maskBase64 x . toBase64core . asciiToBin . binFill $ x +toBase64core = map base64toDigit . map binToDec . T.chunksOf 6 + +base64toDigit x = (['A'..'Z']++['a'..'z']++['0'..'9']++['+','/']) !! x +binToDec = sum . map (2^) . L.findIndices (=='1') . reverse +asciiToBin = concat . map (\y -> printf "%08b" y) . map ord +binFill x = x ++ (take (fill64length x) $ cycle "\000") + +maskBase64 o x = take (length x - l ) x ++ (take l $ cycle "=") + where l = (fill64length o) + +fill64length x | m==0 = 0 + | otherwise = 3-m + where m=mod (length x) 3 + +main = do + line <- getLine + putStrLn $ toBase64 line +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +Example usage, with decoding via `base64 -d` + +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ {.bash} +miguel@megaloman:~$ echo -n "secret haskell" | runghc base64.hs +c2VjcmV0IGhhc2tlbGw= +miguel@megaloman:~$ echo -n "c2VjcmV0IGhhc2tlbGw=" | base64 -d # decode to check +secret haskell +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ diff --git a/080_blog/00040_Haskell-Projects/00120_Lambda-Calculus-(Haskell)/index.md b/080_blog/00040_Haskell-Projects/00120_Lambda-Calculus-(Haskell)/index.md new file mode 100644 index 0000000..25c6b83 --- /dev/null +++ b/080_blog/00040_Haskell-Projects/00120_Lambda-Calculus-(Haskell)/index.md @@ -0,0 +1,38 @@ +Lambda Calculus +=============== + + May 2, 2018 + +Playing with Type Quantifiers and Haskell's Rank 2 Type Polymorphsim, +implementing Boolean logic from scratch. We use the conventional +definitions for `True` an `False` also known as Church booleans, after Alonzo Church, who +intruced them along Lambda Calculus in the 1930s [1]. + +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ {.haskell .numberLines} +{-# LANGUAGE Rank2Types #-} + +fTrue :: forall a. a->a->a +fTrue x y = x + +fFalse :: forall a. a->a->a +fFalse x y = y + +fAnd :: (forall a. a->a->a)->(forall a. a->a->a)->(forall a. a->a->a) +fAnd p q = p q p + +fOr :: (forall a. a->a->a)->(forall a. a->a->a)->(forall a. a->a->a) +fOr p q = p p q + +fNot :: (forall a. a->a->a)->(forall a. a->a->a) +fNot p = p fFalse fTrue + +ifThenElse :: (forall a. a->a->a)->(forall a. a->a->a) + ->(forall a. a->a->a)->(forall a. a->a->a) +ifThenElse p a b = p a b + +-- Example -- + +main = print $ (ifThenElse fFalse fFalse $ fAnd fTrue $ fNot fFalse) "T" "F" +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + + [1] https://en.wikipedia.org/wiki/Lambda_calculus 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-(Haskell)/index.md new file mode 100644 index 0000000..9701481 --- /dev/null +++ b/080_blog/00040_Haskell-Projects/00130_Calculator-on-Parsec-and-GTK-(Haskell)/index.md @@ -0,0 +1,29 @@ +Simple Calculator on Parsec and GTK +=================================== + + May 3, 2018 + +![](/DATA/haskell/calc/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] - +an interactive user interface designer. + +Source Files +------------ + +* [calc.hs](/DATA/haskell/calc/calc.hs) +* [calc.glade](/DATA/haskell/calc/calc.glade) + +calc.hs Listing +--------------- + +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ {.haskell .numberLines} +{BEGIN:SOURCE} +./DATA/haskell/calc/calc.hs +{END:SOURCE} +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + + [1] https://hackage.haskell.org/package/parsec + [2] https://hackage.haskell.org/package/gtk3 + [3] https://glade.gnome.org/ 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-(Haskell)/SimpleSvg.hs new file mode 100644 index 0000000..7b44557 --- /dev/null +++ b/080_blog/00040_Haskell-Projects/00140_Minimalistic-SVG-Generator-(Haskell)/SimpleSvg.hs @@ -0,0 +1,179 @@ +-- +-- Miguel's Simple SVG Generator +-- +-- Author: Michal Idziorek +-- Last Update: May 11th, 2018 +-- + +{-# LANGUAGE ExistentialQuantification #-} + +module SimpleSvg ( + + svgExample1 -- predefined example canvas + -- you can generate the output string via: + -- putStr $ svgGenerate svgExample1 + + ,svgGenerate -- canvas to svg + + ,svgEmpty -- empty canvas + ,svgAdd -- add to canvas (single) + ,svgAddList -- add to canvas (list) + + ,svgCircle -- circle + ,svgLine -- line + ,svgTriangle -- trianvle + + ,svgFilledCircle -- filled circle + ,svgFilledLine -- filled line + ,svgFilledTriangle -- filled trianvle + + ,svgColor -- colors and shades of gray + ,svgRed + ,svgGreen + ,svgBlue + ,svgWhite + ,svgBlack + ,svgShGray + + + ,svgRedLine -- red line + ,svgBluePoint -- small blue circle + ,svgGreenTriangle -- green triangle + + + ) where + +-- CONFIG -- + +svgStrokeWidth = 2 + +-- EXAMPLE CANVAS -- + +-- Demonstrating how to add a few objects to a light gray 300x200 canvas + +svgExample1 = svgAddList (svgEmpty (svgShGray 200) 300 200) $ + [ svgRedLine (0,0) (200,200) + ,svgRedLine (300,0) (100,200) + ,svgBluePoint (33,133) + ,svgBluePoint (33,22) + ,svgBluePoint (66,25) + ,svgFilledTriangle svgBlack svgWhite (20,20) (100,100) (10,90) + ,svgFilledCircle svgWhite svgGreen (150,120) 30 + ]++ + map (svgBluePoint . (,) 250) [50,60..150] + + +-- SHAPES -- + +-- A few predefined shapes easing a quickstart as well as serving as an +-- example, for how to define them in your own code. + +svgRedLine = svgLine svgRed +svgBluePoint pos = svgCircle svgBlue pos 2 +svgGreenTriangle = svgTriangle svgGreen + + +-- Shape construction + +svgLine c (x1,y1) (x2,y2) = + svgShape c (SvgLine (svgCoord x1 y1) (svgCoord x2 y2)) + +svgCircle c (x,y) r = + svgShape c (SvgCircle (svgCoord x y) r) + +svgTriangle c (x1,y1) (x2,y2) (x3,y3)= + svgShape c (SvgTriangle (svgCoord x1 y1) (svgCoord x2 y2) (svgCoord x3 y3)) + +svgFilledLine c1 c2 (x1,y1) (x2,y2) = + svgFilledShape c1 c2 (SvgLine (svgCoord x1 y1) (svgCoord x2 y2)) + +svgFilledCircle c1 c2 (x,y) r = + svgFilledShape c1 c2 (SvgCircle (svgCoord x y) r) + +svgFilledTriangle c1 c2 (x1,y1) (x2,y2) (x3,y3)= + svgFilledShape c1 c2 (SvgTriangle (svgCoord x1 y1) (svgCoord x2 y2) (svgCoord x3 y3)) + +svgShape c1 = SvgPrim c1 (svgNoFill) +svgFilledShape c1 c2 = SvgPrim c1 (svgFill c2) + +-- CANVAS -- + +data SvgCanvas = SvgCanvas SvgColor Int Int [SvgPrim] + +svgEmpty c w h = SvgCanvas c w h [] +svgAdd (SvgCanvas c w h xs) x = SvgCanvas c w h (x:xs) +svgAddList (SvgCanvas c w h xs) ys = SvgCanvas c w h (reverse ys++xs) + +svgGenerate (SvgCanvas col width height prims) = + xml_enc "svg" [("height",show height),("width", show width), + ("style","background-color:"++svgGenColor col)] + body + where body = foldl f "" prims + f a x = primToSvg x++a + +-- COLORS -- + +-- color type along with a few predefined colors to work with + +newtype SvgColor = SvgColor (Int,Int,Int) +svgColor r g b = SvgColor (r,g,b) +svgRed = svgColor 255 0 0 +svgBlue = svgColor 0 0 255 +svgGreen = svgColor 0 255 0 +svgShGray v = svgColor v v v +svgBlack = svgShGray 0 +svgWhite = svgShGray 255 + +svgGenColor (SvgColor (r,g,b)) = "rgb("++show r++","++show g++","++show b++")" + +-- the fill color is wrapped inside a Maybe type, since it is optional + +newtype SvgFill = SvgFill (Maybe SvgColor) +svgFill col = SvgFill (Just col) +svgNoFill = SvgFill Nothing + +-- SHAPES -- + +-- A class for shapes that we want to transform into SVG +-- We define instances for circle, line and triangle +-- The 2D coordinates are wrapped inside a newtype SvgCoord + +newtype SvgCoord = SvgCoord (Double,Double) +svgCoord x y = SvgCoord (x,y) + +data SvgPrim = forall a.SvgPrimClass a => SvgPrim SvgColor SvgFill a + +class SvgPrimClass a where + getSvg :: a->(String,[(String,String)]) + +data SvgCircle = SvgCircle SvgCoord Double +instance SvgPrimClass SvgCircle where + getSvg (SvgCircle (SvgCoord (x,y)) r) = + ("circle", [("cx",show x),("cy",show y),("r",show r)]) + +data SvgLine = SvgLine SvgCoord SvgCoord +instance SvgPrimClass SvgLine where + getSvg (SvgLine (SvgCoord (x1,y1)) (SvgCoord (x2,y2))) = + ("line", [("x1",show x1),("y1",show y1), + ("x2",show x2),("y2",show y2)]) + +data SvgTriangle = SvgTriangle SvgCoord SvgCoord SvgCoord +instance SvgPrimClass SvgTriangle where + getSvg (SvgTriangle (SvgCoord (x1,y1)) (SvgCoord (x2,y2)) (SvgCoord (x3,y3))) = + ("polygon", [("points",pts)]) + where pts=show x1++","++show y1++" "++ + show x2++","++show y2++" "++ + show x3++","++show y3 + +-- transform single primitve to SVG +primToSvg (SvgPrim col (SvgFill fill) prim) = xml_enc tag (attrs++attrs2) "" + where (tag, attrs)=getSvg prim + attrs2=[ ("fill",maybe "none" svgGenColor fill) + ,("stroke",svgGenColor col) + ,("stroke-width",show svgStrokeWidth)] + +-- XML ENCODER -- + +xml_enc tag attrs body = "<"++tag++" "++xml_attrs++">"++body++"" + where xml_attrs = unlines $ map xml_attr attrs + xml_attr (a,v) = a++"=\""++v++"\" " 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-(Haskell)/index.md new file mode 100644 index 0000000..8211ba2 --- /dev/null +++ b/080_blog/00040_Haskell-Projects/00140_Minimalistic-SVG-Generator-(Haskell)/index.md @@ -0,0 +1,31 @@ +A Minimalistic SVG Generator +============================ + + May 11, 2018 + + +A minimalistic SVG generator for my humble requirements. +They might grow someday however... + +The SVG in the following screenshot was generated from the following code +to demonstrate a simple use case. + +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ {.haskell .numberLines} +svgExample1 = svgAddList (svgEmpty (svgShGray 200) 300 200) $ + [ svgRedLine (0,0) (200,200) + ,svgRedLine (300,0) (100,200) + ,svgBluePoint (33,133) + ,svgBluePoint (33,22) + ,svgBluePoint (66,25) + ,svgFilledTriangle svgBlack svgWhite (20,20) (100,100) (10,90) + ,svgFilledCircle svgWhite svgGreen (150,120) 30 + ]++ + map (svgBluePoint . (,) 250) [50,60..150] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +![](svg.png){.img-fluid .border} + +Source Files +------------ + +* [SimpleSvg.hs](SimpleSvg.hs) 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-(Haskell)/svg.png new file mode 100644 index 0000000..d679fad Binary files /dev/null and b/080_blog/00040_Haskell-Projects/00140_Minimalistic-SVG-Generator-(Haskell)/svg.png differ 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 new file mode 100644 index 0000000..0619078 --- /dev/null +++ b/080_blog/00040_Haskell-Projects/100_Static-Page-Maker-in-Haskell/index.md @@ -0,0 +1,121 @@ +# 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 +-- + +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=""++replace "_" " " title++"" + +-- 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 = "
  • "++htmlLink (p++s) s ++"
    • "++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", "
    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) +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + diff --git a/080_blog/00040_Haskell-Projects/index.md b/080_blog/00040_Haskell-Projects/index.md new file mode 100644 index 0000000..5a0766d --- /dev/null +++ b/080_blog/00040_Haskell-Projects/index.md @@ -0,0 +1,4 @@ +Haskell +======= + +Some of my small and tiny Haskell creations and notes. -- cgit v1.2.3