diff --git a/Haskell/blog/Markup.hs b/Haskell/blog/Markup.hs
new file mode 100644
--- /dev/null
+++ b/Haskell/blog/Markup.hs
@@ -0,0 +1,69 @@
+module Markup
+  ( Document
+  , Structure(..)
+  )
+where
+
+import Numeric.Natural
+import Data.Maybe (maybeToList)
+
+type Document = [Structure]
+
+data Structure =
+  Heading Natural String
+  | Paragraph String
+  | UnorderedList [String]
+  | OrderedList [String]
+  | CodeBlock [String]
+  deriving (Eq, Show)
+
+parse :: String -> Document
+parse = parseLines Nothing . lines
+
+parseLines :: Maybe Structure -> [String] -> Document
+parseLines context txts =
+  case txts of
+    [] -> maybeToList context
+
+    ('*' : ' ' : line) : rest  ->
+      maybe id (:) context (Heading 1 (trim line) : parseLines Nothing rest)
+
+    ('-' : ' ' : line) : rest  ->
+      case context of
+        Just (UnorderedList list) ->
+          parseLines (Just (UnorderedList (list <> [trim line]))) rest
+        _ -> 
+          maybe id (:) context (parseLines (Just (UnorderedList [trim line])) rest)
+
+    ('#' : ' ' : line) : rest  ->
+      case context of
+        Just (OrderedList list) ->
+          parseLines (Just (OrderedList (list <> [trim line]))) rest
+        _ -> 
+          maybe id (:) context (parseLines (Just (OrderedList [trim line])) rest)
+
+    ('>' : ' ' : line) : rest  ->
+      case context of
+        Just (CodeBlock list) ->
+          parseLines (Just (CodeBlock (list <> [trim line]))) rest
+        _ -> 
+          maybe id (:) context (parseLines (Just (CodeBlock [trim line])) rest)
+
+    currentLine : rest ->
+      let
+        line = trim currentLine
+      in
+        if line == ""
+        then
+          maybe id (:) context (parseLines Nothing rest)
+        else
+          case context of
+            Just (Paragraph paragraph) ->
+              parseLines (Just (Paragraph (unwords [paragraph, line]))) rest
+            _ -> maybe id (:) context (parseLines (Just (Paragraph line)) rest)
+
+trim :: String -> String
+trim = unwords . words
+
+print :: Show a => a -> IO ()
+print = putStrLn . show