franz-0.5: src/Database/Franz/Internal/URI.hs

{-# LANGUAGE OverloadedStrings #-}
module Database.Franz.Internal.URI
  ( FranzPath(..)
  , toFranzPath
  , fromFranzPath
  ) where

import Data.List (stripPrefix)
import Data.String
import Network.Socket (HostName, PortNumber)
import Text.Read (readMaybe)

data FranzPath = FranzPath
  { franzHost :: !HostName
  , franzPort :: !PortNumber
  , franzDir :: !FilePath
  -- ^ Prefix of franz directories
  }
  | LocalFranzPath !FilePath
  deriving (Show, Eq, Ord)

localPrefix :: IsString a => a
localPrefix = "franz-local:"

remotePrefix :: IsString a => a
remotePrefix = "franz://"

-- | Parse a franz URI (franz://host:port/path or franz-local:path).
toFranzPath :: String -> Either String FranzPath
toFranzPath uri | Just path <- stripPrefix localPrefix uri = Right $ LocalFranzPath path
toFranzPath uri = do
  hostnamePath <- maybe (Left $ "Expecting " <> remotePrefix) Right $ stripPrefix remotePrefix uri
  (host, path) <- case break (== '/') hostnamePath of
    (h, '/' : p) -> Right (h, p)
    _ -> Left "Expecting /"
  case break (== ':') host of
    (hostname, ':' : portStr)
        | Just p <- readMaybe portStr -> Right $ FranzPath hostname p path
        | otherwise -> Left "Failed to parse the port number"
    _ -> Right $ FranzPath host 1886 path

-- | Render 'FranzPath' as a franz URI.
fromFranzPath :: (Monoid a, IsString a) => FranzPath -> a
fromFranzPath (FranzPath host port path) = mconcat
  [ remotePrefix
  , fromString host
  , ":"
  , fromString (show port)
  , "/"
  , fromString path
  ]

fromFranzPath (LocalFranzPath path) = localPrefix <> fromString path