1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
|
{-# LANGUAGE OverloadedStrings #-}
module Main where
import Control.Monad (replicateM)
import Control.Monad.IO.Class (liftIO)
import qualified Data.ByteString.Char8 as BC
import Data.Text.Encoding (decodeUtf8, encodeUtf8)
import qualified Data.Text.Lazy as TL
import qualified Database.Redis as R
import Network.URI (URI, parseURI)
import qualified System.Random as SR
import Web.Scotty
alphaNum :: String
alphaNum = ['A'..'Z'] ++ ['0'..'9']
randomElement :: String -> IO Char
randomElement xs = do
let maxIndex :: Int
maxIndex = length xs - 1
-- Right of arrow is IO Int,
-- so randomDigit is Int
randomDigit <- SR.randomRIO (0, maxIndex)
return (xs !! randomDigit)
shortyGen :: IO [Char]
shortyGen =
replicateM 7 (randomElement alphaNum)
saveURI :: R.Connection
-> BC.ByteString
-> BC.ByteString
-> IO (Either R.Reply R.Status)
saveURI conn shortURI uri = R.runRedis conn $ R.set shortURI uri
getURI :: R.Connection
-> BC.ByteString
-> IO (Either R.Reply (Maybe BC.ByteString))
getURI conn shortURI = R.runRedis conn $ R.get shortURI
linkShorty :: String -> String
linkShorty shorty =
concat
[ "<a href=\""
, shorty
, "\">Copy and paste your short URL</a>"
]
-- TL.concat :: [TL.Text] -> TL.Text
shortyCreated :: Show a
=> a
-> String
-> TL.Text
shortyCreated resp shawty =
TL.concat [ TL.pack (show resp)
, " shorty is: "
, TL.pack (linkShorty shawty)
]
shortyAintUri :: TL.Text -> TL.Text
shortyAintUri uri =
TL.concat
[ uri
, " wasn't a url,"
, " did you forget http://?"
]
shortyFound :: TL.Text -> TL.Text
shortyFound tbs =
TL.concat
[ "<a href=\""
, tbs, "\">"
, tbs, "</a>"
]
app :: R.Connection
-> ScottyM ()
app rConn = do
get "/" $ do
uri <- param "uri"
let parsedUri :: Maybe URI
parsedUri = parseURI (TL.unpack uri)
case parsedUri of
Just _ -> do
shawty <- liftIO shortyGen
let shorty = BC.pack shawty
uri' = encodeUtf8 (TL.toStrict uri)
resp <- liftIO (saveURI rConn shorty uri')
html (shortyCreated resp shawty)
Nothing -> text (shortyAintUri uri)
get "/:short" $ do
short <- param "short"
uri <- liftIO (getURI rConn short)
case uri of
Left reply -> text (TL.pack (show reply))
Right mbBS -> case mbBS of
Nothing -> text "uri not found"
Just bs -> html (shortyFound tbs)
where tbs :: TL.Text
tbs = TL.fromStrict (decodeUtf8 bs)
main :: IO ()
main = do
rConn <- R.connect R.defaultConnectInfo
scotty 3000 (app rConn)
|
