From 4b2d1a4571f44f8287888985aa8669b0151e7541 Mon Sep 17 00:00:00 2001 From: Miguel Date: Tue, 19 Feb 2019 16:42:05 +0100 Subject: v0.1 --- .../00040_Graham-Scan-(Haskell)/index.md | 128 --------- .../00040_Graham-Scan/index.md | 128 +++++++++ .../00065_Base64-Encoder-(Haskell)/index.md | 51 ---- .../00065_Base64-Encoder/index.md | 51 ++++ .../00120_Lambda-Calculus-(Haskell)/index.md | 38 --- .../00120_Lambda-Calculus/index.md | 38 +++ .../index.md | 29 -- .../00130_Calculator-on-Parsec-and-GTK/calc.glade | 312 +++++++++++++++++++++ .../00130_Calculator-on-Parsec-and-GTK/calc.hs | 74 +++++ .../00130_Calculator-on-Parsec-and-GTK/calc.png | Bin 0 -> 22734 bytes .../00130_Calculator-on-Parsec-and-GTK/index.md | 23 ++ .../SimpleSvg.hs | 179 ------------ .../index.md | 31 -- .../svg.png | Bin 13130 -> 0 bytes .../00140_Minimalistic-SVG-Generator/SimpleSvg.hs | 179 ++++++++++++ .../00140_Minimalistic-SVG-Generator/index.md | 31 ++ .../00140_Minimalistic-SVG-Generator/svg.png | Bin 0 -> 13130 bytes .../100_Estatico-Page-Maker/index.md | 35 +++ .../100_Static-Page-Maker-in-Haskell/index.md | 121 -------- 19 files changed, 871 insertions(+), 577 deletions(-) delete mode 100644 080_blog/00040_Haskell-Projects/00040_Graham-Scan-(Haskell)/index.md create mode 100644 080_blog/00040_Haskell-Projects/00040_Graham-Scan/index.md delete mode 100644 080_blog/00040_Haskell-Projects/00065_Base64-Encoder-(Haskell)/index.md create mode 100644 080_blog/00040_Haskell-Projects/00065_Base64-Encoder/index.md delete mode 100644 080_blog/00040_Haskell-Projects/00120_Lambda-Calculus-(Haskell)/index.md create mode 100644 080_blog/00040_Haskell-Projects/00120_Lambda-Calculus/index.md delete mode 100644 080_blog/00040_Haskell-Projects/00130_Calculator-on-Parsec-and-GTK-(Haskell)/index.md create mode 100644 080_blog/00040_Haskell-Projects/00130_Calculator-on-Parsec-and-GTK/calc.glade create mode 100644 080_blog/00040_Haskell-Projects/00130_Calculator-on-Parsec-and-GTK/calc.hs create mode 100644 080_blog/00040_Haskell-Projects/00130_Calculator-on-Parsec-and-GTK/calc.png create mode 100644 080_blog/00040_Haskell-Projects/00130_Calculator-on-Parsec-and-GTK/index.md delete mode 100644 080_blog/00040_Haskell-Projects/00140_Minimalistic-SVG-Generator-(Haskell)/SimpleSvg.hs delete mode 100644 080_blog/00040_Haskell-Projects/00140_Minimalistic-SVG-Generator-(Haskell)/index.md delete mode 100644 080_blog/00040_Haskell-Projects/00140_Minimalistic-SVG-Generator-(Haskell)/svg.png create mode 100644 080_blog/00040_Haskell-Projects/00140_Minimalistic-SVG-Generator/SimpleSvg.hs create mode 100644 080_blog/00040_Haskell-Projects/00140_Minimalistic-SVG-Generator/index.md create mode 100644 080_blog/00040_Haskell-Projects/00140_Minimalistic-SVG-Generator/svg.png create mode 100644 080_blog/00040_Haskell-Projects/100_Estatico-Page-Maker/index.md delete mode 100644 080_blog/00040_Haskell-Projects/100_Static-Page-Maker-in-Haskell/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 deleted file mode 100644 index 195dbe1..0000000 --- a/080_blog/00040_Haskell-Projects/00040_Graham-Scan-(Haskell)/index.md +++ /dev/null @@ -1,128 +0,0 @@ -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/00040_Graham-Scan/index.md b/080_blog/00040_Haskell-Projects/00040_Graham-Scan/index.md new file mode 100644 index 0000000..195dbe1 --- /dev/null +++ b/080_blog/00040_Haskell-Projects/00040_Graham-Scan/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 deleted file mode 100644 index 830ed8d..0000000 --- a/080_blog/00040_Haskell-Projects/00065_Base64-Encoder-(Haskell)/index.md +++ /dev/null @@ -1,51 +0,0 @@ -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/00065_Base64-Encoder/index.md b/080_blog/00040_Haskell-Projects/00065_Base64-Encoder/index.md new file mode 100644 index 0000000..830ed8d --- /dev/null +++ b/080_blog/00040_Haskell-Projects/00065_Base64-Encoder/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 deleted file mode 100644 index 25c6b83..0000000 --- a/080_blog/00040_Haskell-Projects/00120_Lambda-Calculus-(Haskell)/index.md +++ /dev/null @@ -1,38 +0,0 @@ -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/00120_Lambda-Calculus/index.md b/080_blog/00040_Haskell-Projects/00120_Lambda-Calculus/index.md new file mode 100644 index 0000000..25c6b83 --- /dev/null +++ b/080_blog/00040_Haskell-Projects/00120_Lambda-Calculus/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 deleted file mode 100644 index 9701481..0000000 --- a/080_blog/00040_Haskell-Projects/00130_Calculator-on-Parsec-and-GTK-(Haskell)/index.md +++ /dev/null @@ -1,29 +0,0 @@ -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/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 @@ + + + + + + False + + + True + False + vertical + True + + + True + False + vertical + + + True + True + in + + + True + True + + + + + True + True + 0 + + + + + True + True + False + False + + + True + True + 1 + + + + + False + True + 0 + + + + + True + False + True + True + + + 1 + True + True + True + + + 0 + 2 + + + + + 2 + True + True + True + + + 1 + 2 + + + + + 3 + True + True + True + + + 2 + 2 + + + + + 4 + True + True + True + + + 0 + 1 + + + + + 5 + True + True + True + + + 1 + 1 + + + + + 6 + True + True + True + + + 2 + 1 + + + + + 7 + True + True + True + + + 0 + 0 + + + + + 8 + True + True + True + + + 1 + 0 + + + + + 9 + True + True + True + + + 2 + 0 + + + + + 0 + True + True + True + + + 0 + 3 + + + + + . + True + True + True + + + 1 + 3 + + + + + = + True + True + True + + + 3 + 0 + + + + + ( + True + True + True + + + 2 + 3 + + + + + + + True + True + True + + + 0 + 4 + + + + + - + True + True + True + + + 1 + 4 + + + + + * + True + True + True + + + 2 + 4 + + + + + / + True + True + True + + + 3 + 4 + + + + + CLR + True + True + True + + + 3 + 1 + + + + + DEL + True + True + True + + + 3 + 2 + + + + + ) + True + True + True + + + 3 + 3 + + + + + True + True + 1 + + + + + + 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 Binary files /dev/null and b/080_blog/00040_Haskell-Projects/00130_Calculator-on-Parsec-and-GTK/calc.png differ diff --git a/080_blog/00040_Haskell-Projects/00130_Calculator-on-Parsec-and-GTK/index.md b/080_blog/00040_Haskell-Projects/00130_Calculator-on-Parsec-and-GTK/index.md new file mode 100644 index 0000000..381b017 --- /dev/null +++ b/080_blog/00040_Haskell-Projects/00130_Calculator-on-Parsec-and-GTK/index.md @@ -0,0 +1,23 @@ +Simple Calculator on Parsec and GTK +=================================== + + May 3, 2018 + +![](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](calc.hs) +* [calc.glade](calc.glade) + +Ref +--- + + [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 deleted file mode 100644 index 7b44557..0000000 --- a/080_blog/00040_Haskell-Projects/00140_Minimalistic-SVG-Generator-(Haskell)/SimpleSvg.hs +++ /dev/null @@ -1,179 +0,0 @@ --- --- 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 deleted file mode 100644 index 8211ba2..0000000 --- a/080_blog/00040_Haskell-Projects/00140_Minimalistic-SVG-Generator-(Haskell)/index.md +++ /dev/null @@ -1,31 +0,0 @@ -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 deleted file mode 100644 index d679fad..0000000 Binary files a/080_blog/00040_Haskell-Projects/00140_Minimalistic-SVG-Generator-(Haskell)/svg.png and /dev/null differ diff --git a/080_blog/00040_Haskell-Projects/00140_Minimalistic-SVG-Generator/SimpleSvg.hs b/080_blog/00040_Haskell-Projects/00140_Minimalistic-SVG-Generator/SimpleSvg.hs new file mode 100644 index 0000000..7b44557 --- /dev/null +++ b/080_blog/00040_Haskell-Projects/00140_Minimalistic-SVG-Generator/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/index.md b/080_blog/00040_Haskell-Projects/00140_Minimalistic-SVG-Generator/index.md new file mode 100644 index 0000000..8211ba2 --- /dev/null +++ b/080_blog/00040_Haskell-Projects/00140_Minimalistic-SVG-Generator/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/svg.png b/080_blog/00040_Haskell-Projects/00140_Minimalistic-SVG-Generator/svg.png new file mode 100644 index 0000000..d679fad Binary files /dev/null and b/080_blog/00040_Haskell-Projects/00140_Minimalistic-SVG-Generator/svg.png 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 --- - -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) -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -- cgit v1.2.3