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