Skip to content
Snippets Groups Projects
Commit 9c5ed1bd authored by Hugo Hörnquist's avatar Hugo Hörnquist
Browse files

Add network.lhs.

parent 500a9382
No related branches found
No related tags found
No related merge requests found
\begin{code}
{-# LANGUAGE OverloadedStrings #-}
module Network where
\end{code}
\chapter{Testande av nätverk}
\begin{code}
import Network.Simple.TCP
import qualified Data.ByteString.Lazy as B
import qualified Data.ByteString as StrictB
import Data.Encoding
import Data.Encoding.ISO88591
import Data.Binary.Put -- runPut
import Data.Int
import Data.ByteString.Lazy.Char8 (pack)
import Data.String
\end{code}
\begin{code}
-- main :: IO ()
-- main = do
-- -- Bytesink
-- let bs = encode ISO88591 "Hörnquist"
\end{code}
telnet kom.lysator.liu.se 4894
A26Hbyers%kajsa.lysator.liu.se
\begin{code}
data Hollerith = Hollerith Int64 B.ByteString
deriving (Show, Eq)
instance IsString Hollerith where
fromString = makeHoll
makeHoll :: String -> Hollerith
makeHoll str = Hollerith (B.length bs) bs
where bs = runPut $ encode ISO88591 str
\end{code}
\begin{code}
fmtHoll :: Hollerith -> B.ByteString
fmtHoll (Hollerith n s) = (pack . show $ n) `B.append` "H" `B.append` s
\end{code}
A limit with network-simple's TCP sockets are that they only accept strict
bytestrings. And apparently this is one of the best ways to go from a lazy
to a strict bytestring.
\begin{code}
unLazy :: B.ByteString -> StrictB.ByteString
unLazy = StrictB.concat . B.toChunks
\end{code}
\begin{code}
komconnect :: IO (Socket)
komconnect = do
(sock, addr) <- connectSock "kom.lysator.liu.se" "4894"
send sock $ unLazy $ "A" `B.append` (fmtHoll "hugo%claptrap")
return sock
\end{code}
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment