New website prototype

4 files changed, 171 insertions, 0 deletions

diff --git a/src/Id.hs b/src/Id.hs
new file mode 100644
index 0000000..adc7e2e
--- /dev/null
+++ b/src/Id.hs
@@ -0,0 +1,19 @@
+module Id
+( newId,
+  nextId
+) where
+
+{- 
+ -
+ - Écrit par Hédy GIRAUDEAU
+ - 27/07/17
+ -
+-}
+
+import Data.IORef
+import Data.Functor
+
+type Id_number a = IORef a
+
+newId = (newIORef 0)
+nextId cnt = modifyIORef cnt (+1) >> (+0) <$> readIORef cnt
diff --git a/src/Secret.hs b/src/Secret.hs
new file mode 100644
index 0000000..7b428ce
--- /dev/null
+++ b/src/Secret.hs
@@ -0,0 +1,46 @@
+module Secret
+( to_secret
+) where
+
+
+{- 
+ -
+ - Écrit par Hédy GIRAUDEAU
+ - 27/07/17
+ -
+-}
+
+
+
+import Text.Pandoc
+import Text.Pandoc.JSON
+
+
+firstLine :: [Inline] -> ([Inline],[Inline])
+firstLine [] = ([],[])
+firstLine ((SoftBreak) : x) = ([], x)
+firstLine (x:q) = ([x] ++ y, z) where (y,z) = (firstLine q)
+
+
+
+
+to_secret (BlockQuote (Para (Str(first) : inlines) : blocks)) = 
+    Div
+            ("", ["secret"], [])
+            ([
+                 RawBlock (Format "html")
+                     (start_detail ++ start_summary)
+             ] ++ [Plain $ fLine] ++ [
+                     RawBlock (Format "html")
+                     (end_summary)
+                  ] ++ [ Plain rest ]++ blocks ++ [
+                     RawBlock (Format "html")
+                     (end_detail)
+                  ]
+            )
+            where start_detail = "<details>"
+                  start_summary = "<summary>"
+                  end_detail = "</details>"
+                  end_summary = "</summary>"
+                  (fLine, rest) = firstLine inlines
+
diff --git a/src/articleFilter.hs b/src/articleFilter.hs
new file mode 100644
index 0000000..a94cd3d
--- /dev/null
+++ b/src/articleFilter.hs
@@ -0,0 +1,55 @@
+import Text.Pandoc
+import Text.Pandoc.JSON
+import Control.Monad.State
+import Id
+
+
+{- 
+ - Écrit par Hédy GIRAUDEAU
+ - 27/07/17
+-}
+extractStart :: [Inline] -> ([Inline],[Inline])
+extractStart [] = ([],[])
+extractStart ((SoftBreak):q) = ((SoftBreak):y, z) where (y,z) = (extractStart q)
+extractStart ((LineBreak):q) = ((LineBreak):y, z) where (y,z) = (extractStart q)
+extractStart (img@(Image _ _ _):q) = (img: y, z) where (y,z) = (extractStart q)
+extractStart x = ([],x)
+
+
+
+
+transformBlock cnt ( hdF@(Header 1 _ inlines) : paraF@(Para inlinesP) : blocks ) = 
+    return (( (RawBlock (Format "html")
+                     ( start_header )
+                    ) : hdF :
+           (RawBlock (Format "html")
+                     ( end_header )
+                    ) : (Plain inlinesP) :
+             (RawBlock (Format "html")
+                     ( end_intro )
+                    ) : blocks
+             ) ++ [ (RawBlock (Format "html")
+                     (end_article) )
+                  ])
+            where start_header = "<header>"
+                  end_header = "</header><section class=\"entry-content clearfix\" >"
+                  end_intro = ""
+                  end_article = "</section>"
+
+--transformBlock _ ((Para inlines):tl) =
+--    return ((Plain plainInline):(Para paraInline:tl))
+--           where (plainInline, paraInline) = extractStart(inlines)
+
+
+transformBlock _ x = return x
+
+
+bar :: Pandoc -> IO Pandoc
+bar x = do cnt <- newId
+           bottomUpM (transformBlock cnt) x
+
+main :: IO()
+main = toJSONFilter bar
+
+
+-- vim:set et:
diff --git a/src/introFilter.hs b/src/introFilter.hs
new file mode 100644
index 0000000..93603c0
--- /dev/null
+++ b/src/introFilter.hs
@@ -0,0 +1,51 @@
+import Text.Pandoc
+import Text.Pandoc.JSON
+import Control.Monad.State
+import Id
+
+
+{- 
+ - Écrit par Hédy GIRAUDEAU
+ - 27/07/17
+-}
+firstPara :: [Block] -> [Block]
+firstPara [] = []
+firstPara (p@(Para x):blocks) = [(Para x)]
+firstPara (x:blocks) = (firstPara blocks)
+
+setMignature (id, classes, mapsAttrib) = (id, "miniature":classes, mapsAttrib)
+
+
+purgePara (Para (Image x y (trgt,title):_)) = (Para [(Image (setMignature x) y ("article/" ++ trgt, title))])
+purgePara (Para (x:t)) = purgePara (Para t)
+purgePara (Para []) = (Para [])
+
+transformBlock cnt ( hdF@(Header 1 _ inlines) : paraF@(Para inlinesP) : blocks ) = 
+    return (( (RawBlock (Format "html")
+                     ( start_header )
+                    ) : hdF :
+           (RawBlock (Format "html")
+                     ( end_header )
+                    ) : purgePara(paraF) : firstPara(blocks)
+             ) ++ [ (RawBlock (Format "html")
+                     (end_article) )
+                  ])
+            where start_header = "<header>"
+                  end_header = "</header><section class=\"entry-content clearfix\" >"
+                  end_intro = ""
+                  end_article = "</section>"
+
+
+
+transformBlock _ x = return x
+
+
+bar :: Pandoc -> IO Pandoc
+bar x = do cnt <- newId
+           bottomUpM (transformBlock cnt) x
+
+main :: IO()
+main = toJSONFilter bar
+
+
+-- vim:set et: