{-# 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) :: IO Int
return (xs !! randomDigit)
shortyGen :: IO String
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 [ "Copy and paste your short URL"
]
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 ["", tbs, ""]
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)
-- **** Excercise ****
-- Check if it already exists
uri'' <- liftIO (getURI rConn shorty)
case uri'' of
Left reply -> text (TL.pack (show reply))
Right mbBS -> case mbBS of
Nothing -> do
-- It doesn't so save it
resp <- liftIO (saveURI rConn shorty uri')
html (shortyCreated resp shawty)
Just _ -> text "Duplicate short uri created."
-- **** End of Exercise ****
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)