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 import System.FilePath (FilePath)
  19
  20 import URI (URI, escapeUriString, nullUri, parseAbsoluteUri)
  21
  22 data Host = Host {hostName :: String, hostPort :: Int}
  23     deriving (Eq,Ord,Show)
  24
  25 showHost :: Host -> String
  26 showHost (Host name port) = name ++ ":" ++ show port
  27
  28 parseHost :: String -> Maybe Host
  29 parseHost s = do
  30     i <- lastMay $ elemIndices ':' s
  31     (hostname, ':':portStr) <- return $ splitAt i s
  32     Host hostname <$> readMay portStr
  33
  34
  35 data Request
  36     = NetworkRequest {requestHost :: Host, networkRequestUri :: URI}
  37     | LocalFileRequest {requestPath :: FilePath}
  38     deriving (Eq,Ord,Show)
  39
  40 requestUri :: Request -> URI
  41 requestUri (NetworkRequest _ uri) = uri
  42 requestUri (LocalFileRequest abspath) =
  43     fromMaybe nullUri . parseAbsoluteUri $ "file://" <> escapeUriString abspath