13 files changed, 196 insertions, 0 deletions
diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..4123af9
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,2 @@
+dist-newstyle
+*.save0
+\ No newline at end of file
diff --git a/CHANGELOG.md b/CHANGELOG.md
new file mode 100644
index 0000000..d41f76e
--- /dev/null
+++ b/CHANGELOG.md
@@ -0,0 +1,5 @@
+# Revision history for hask
+
+## 0.1.0.0 -- YYYY-mm-dd
+
+* First version. Released on an unsuspecting world.
diff --git a/Main.hs b/Main.hs
new file mode 100644
index 0000000..1bc06d5
--- /dev/null
+++ b/Main.hs
@@ -0,0 +1,25 @@
+module Main where
+
+import System.IO
+import Response
+import Router
+
+renderTemplate name = do
+  template <- readTemplate name
+  return $ HtmlResponse 200 template
+
+readTemplate name = do
+  handle <- openFile ("templates/" ++ name) ReadMode
+  hGetContents handle
+
+route url method
+  | url == "/"      = renderTemplate "index.html"
+  | url == "/hello" = renderTemplate "hello.html"
+
+table = [
+  Route 
+]
+
+main = do
+  response <- route "/hello" "GET"
+  print $ getContent response
+\ No newline at end of file
diff --git a/Request.hs b/Request.hs
new file mode 100644
index 0000000..a0c18d7
--- /dev/null
+++ b/Request.hs
@@ -0,0 +1,9 @@
+module Request where
+
+data Request = Request String String String
+
+getQuery (Request query _ _) = query
+
+getUrl (Request _ url _) = url
+
+getMethod (Request _ _ method) = method
+\ No newline at end of file
diff --git a/Response.hs b/Response.hs
new file mode 100644
index 0000000..f33777d
--- /dev/null
+++ b/Response.hs
@@ -0,0 +1,15 @@
+module Response where
+
+data Response =
+  HtmlResponse Int String -- Код возврата, содержимое HTML
+  | TextResponse Int String String -- Код возврата, Content-Type, содержимое HTML
+
+
+getStatusCode (HtmlResponse code _) = code
+getStatusCode (TextResponse code _ _) = code
+
+getContentType (HtmlResponse _ _) = "text/html"
+getContentType (TextResponse _ contentType _) = contentType
+
+getContent (HtmlResponse _ content) = content
+getContent (TextResponse _ _ content) = content
+\ No newline at end of file
diff --git a/Router.hs b/Router.hs
new file mode 100644
index 0000000..4798ec1
--- /dev/null
+++ b/Router.hs
@@ -0,0 +1,21 @@
+module Router where
+
+import Control.Exception
+import Response
+import Request
+
+data Route = Route (Request -> IO Response) String String
+
+data RouterError = RouteNotFound
+  deriving Show
+
+instance Exception RouterError
+
+getResponse [] _ = throw RouteNotFound
+getResponse (Route callback routeUrl _ : routerTable) req @ (Request _ url _) =
+  if url == routeUrl then
+    callback req
+  else getResponse routerTable req
+
+router table req =
+  
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
index 0000000..9a994af
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/hask.cabal b/hask.cabal
new file mode 100644
index 0000000..abc15ba
--- /dev/null
+++ b/hask.cabal
@@ -0,0 +1,25 @@
+cabal-version:       >=1.10
+-- Initial package description 'hask.cabal' generated by 'cabal init'.  For
+--  further documentation, see http://haskell.org/cabal/users-guide/
+
+name:                hask
+version:             0.1.0.0
+-- synopsis:
+-- description:
+-- bug-reports:
+-- license:
+license-file:        LICENSE
+author:              Andrew Guschin
+maintainer:          saintruler@gmail.com
+-- copyright:
+-- category:
+build-type:          Simple
+extra-source-files:  CHANGELOG.md
+
+executable hask
+  main-is:             Main.hs
+  -- other-modules:
+  -- other-extensions:
+  build-depends:       base >=4.14 && <4.15
+  -- hs-source-dirs:
+  default-language:    Haskell2010
diff --git a/hie.yaml b/hie.yaml
new file mode 100644
index 0000000..142e69f
--- /dev/null
+++ b/hie.yaml
@@ -0,0 +1,2 @@
+cradle:
+  stack:
+\ No newline at end of file
diff --git a/net/client.hs b/net/client.hs
new file mode 100644
index 0000000..863df6e
--- /dev/null
+++ b/net/client.hs
@@ -0,0 +1,30 @@
+{-# LANGUAGE OverloadedStrings #-}
+-- Echo client program
+module Main (main) where
+
+import qualified Control.Exception as E
+import qualified Data.ByteString.Char8 as C
+import Network.Socket
+import Network.Socket.ByteString (recv, sendAll)
+
+main :: IO ()
+main = runTCPClient "127.0.0.1" "3000" $ \s -> do
+    sendAll s "Hello, world!"
+    msg <- recv s 1024
+    putStr "Received: "
+    C.putStrLn msg
+
+-- from the "network-run" package.
+runTCPClient :: HostName -> ServiceName -> (Socket -> IO a) -> IO a
+runTCPClient host port client = withSocketsDo $ do
+    addr <- resolve
+    E.bracket (open addr) close client
+  where
+    resolve = do
+        let hints = defaultHints { addrSocketType = Stream }
+        head <$> getAddrInfo (Just hints) (Just host) (Just port)
+    open addr = do
+        sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)
+        connect sock $ addrAddress addr
+        return sock
+
diff --git a/net/server.hs b/net/server.hs
new file mode 100644
index 0000000..a9bec82
--- /dev/null
+++ b/net/server.hs
@@ -0,0 +1,42 @@
+-- Echo server program
+module Main (main) where
+
+import Control.Concurrent (forkFinally)
+import qualified Control.Exception as E
+import Control.Monad (unless, forever, void)
+import qualified Data.ByteString as S
+import Network.Socket
+import Network.Socket.ByteString (recv, sendAll)
+
+main :: IO ()
+main = runTCPServer Nothing "3000" talk
+  where
+    talk s = do
+        msg <- recv s 1024
+        unless (S.null msg) $ do
+          sendAll s msg
+          talk s
+
+-- from the "network-run" package.
+runTCPServer :: Maybe HostName -> ServiceName -> (Socket -> IO a) -> IO a
+runTCPServer mhost port server = withSocketsDo $ do
+    addr <- resolve
+    E.bracket (open addr) close loop
+  where
+    resolve = do
+        let hints = defaultHints {
+                addrFlags = [AI_PASSIVE]
+              , addrSocketType = Stream
+              }
+        head <$> getAddrInfo (Just hints) mhost (Just port)
+    open addr = do
+        sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)
+        setSocketOption sock ReuseAddr 1
+        withFdSocket sock $ setCloseOnExecIfNeeded
+        bind sock $ addrAddress addr
+        listen sock 1024
+        return sock
+    loop sock = forever $ do
+        (conn, _peer) <- accept sock
+        void $ forkFinally (server conn) (const $ gracefulClose conn 5000)
+
diff --git a/templates/hello.html b/templates/hello.html
new file mode 100644
index 0000000..cb0681d
--- /dev/null
+++ b/templates/hello.html
@@ -0,0 +1,9 @@
+<html lang="en">
+<head>
+    <meta charset="UTF-8">
+    <title>Document</title>
+</head>
+<body>
+    Hello!    
+</body>
+</html>
+\ No newline at end of file
diff --git a/templates/index.html b/templates/index.html
new file mode 100644
index 0000000..2f82895
--- /dev/null
+++ b/templates/index.html
@@ -0,0 +1,9 @@
+<html lang="en">
+<head>
+    <meta charset="UTF-8">
+    <title>Document</title>
+</head>
+<body>
+    This is index page
+</body>
+</html>
+\ No newline at end of file