Request.hs

   1 -- This file is part of Diohsc
   2 -- Copyright (C) 2020 Martin Bays <mbays@sdf.org>
   3 --
   4 -- This program is free software: you can redistribute it and/or modify
   5 -- it under the terms of version 3 of the GNU General Public License as
   6 -- published by the Free Software Foundation, or any later version.
   7 --
   8 -- You should have received a copy of the GNU General Public License
   9 -- along with this program.  If not, see http://www.gnu.org/licenses/.
  10
  11 {-# LANGUAGE Safe #-}
  12
  13 module Request where
  14
  15 import           Data.List  (elemIndices)
  16 import           Data.Maybe (fromMaybe)
  17 import           Safe       (lastMay, readMay)
  18
  19 import           URI        (URI, escapePathString, nullUri, parseAbsoluteUri)
  20
  21 data Host = Host {hostName :: String, hostPort :: Int}
  22     deriving (Eq,Ord,Show)
  23
  24 showHost :: Host -> String
  25 showHost (Host name port) = name ++ ":" ++ show port
  26
  27 parseHost :: String -> Maybe Host
  28 parseHost s = do
  29     i <- lastMay $ elemIndices ':' s
  30     (hostname, ':':portStr) <- return $ splitAt i s
  31     Host hostname <$> readMay portStr
  32
  33
  34 data Request
  35     = NetworkRequest {requestHost :: Host, networkRequestUri :: URI}
  36     | LocalFileRequest {requestPath :: FilePath}
  37     deriving (Eq,Ord,Show)
  38
  39 requestUri :: Request -> URI
  40 requestUri (NetworkRequest _ uri) = uri
  41 requestUri (LocalFileRequest abspath) =
  42     fromMaybe nullUri . parseAbsoluteUri $ "file://" <> escapePathString abspath