{-# 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
  { FranzPath -> HostName
franzHost :: !HostName
  , FranzPath -> PortNumber
franzPort :: !PortNumber
  , FranzPath -> HostName
franzDir :: !FilePath
  -- ^ Prefix of franz directories
  }
  | LocalFranzPath !FilePath
  deriving (Int -> FranzPath -> ShowS
[FranzPath] -> ShowS
FranzPath -> HostName
(Int -> FranzPath -> ShowS)
-> (FranzPath -> HostName)
-> ([FranzPath] -> ShowS)
-> Show FranzPath
forall a.
(Int -> a -> ShowS) -> (a -> HostName) -> ([a] -> ShowS) -> Show a
showList :: [FranzPath] -> ShowS
$cshowList :: [FranzPath] -> ShowS
show :: FranzPath -> HostName
$cshow :: FranzPath -> HostName
showsPrec :: Int -> FranzPath -> ShowS
$cshowsPrec :: Int -> FranzPath -> ShowS
Show, FranzPath -> FranzPath -> Bool
(FranzPath -> FranzPath -> Bool)
-> (FranzPath -> FranzPath -> Bool) -> Eq FranzPath
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FranzPath -> FranzPath -> Bool
$c/= :: FranzPath -> FranzPath -> Bool
== :: FranzPath -> FranzPath -> Bool
$c== :: FranzPath -> FranzPath -> Bool
Eq, Eq FranzPath
Eq FranzPath
-> (FranzPath -> FranzPath -> Ordering)
-> (FranzPath -> FranzPath -> Bool)
-> (FranzPath -> FranzPath -> Bool)
-> (FranzPath -> FranzPath -> Bool)
-> (FranzPath -> FranzPath -> Bool)
-> (FranzPath -> FranzPath -> FranzPath)
-> (FranzPath -> FranzPath -> FranzPath)
-> Ord FranzPath
FranzPath -> FranzPath -> Bool
FranzPath -> FranzPath -> Ordering
FranzPath -> FranzPath -> FranzPath
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FranzPath -> FranzPath -> FranzPath
$cmin :: FranzPath -> FranzPath -> FranzPath
max :: FranzPath -> FranzPath -> FranzPath
$cmax :: FranzPath -> FranzPath -> FranzPath
>= :: FranzPath -> FranzPath -> Bool
$c>= :: FranzPath -> FranzPath -> Bool
> :: FranzPath -> FranzPath -> Bool
$c> :: FranzPath -> FranzPath -> Bool
<= :: FranzPath -> FranzPath -> Bool
$c<= :: FranzPath -> FranzPath -> Bool
< :: FranzPath -> FranzPath -> Bool
$c< :: FranzPath -> FranzPath -> Bool
compare :: FranzPath -> FranzPath -> Ordering
$ccompare :: FranzPath -> FranzPath -> Ordering
$cp1Ord :: Eq FranzPath
Ord)

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

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

-- | Parse a franz URI (franz://host:port/path or franz-local:path).
toFranzPath :: String -> Either String FranzPath
toFranzPath :: HostName -> Either HostName FranzPath
toFranzPath HostName
uri | Just HostName
path <- HostName -> HostName -> Maybe HostName
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix HostName
forall a. IsString a => a
localPrefix HostName
uri = FranzPath -> Either HostName FranzPath
forall a b. b -> Either a b
Right (FranzPath -> Either HostName FranzPath)
-> FranzPath -> Either HostName FranzPath
forall a b. (a -> b) -> a -> b
$ HostName -> FranzPath
LocalFranzPath HostName
path
toFranzPath HostName
uri = do
  HostName
hostnamePath <- Either HostName HostName
-> (HostName -> Either HostName HostName)
-> Maybe HostName
-> Either HostName HostName
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (HostName -> Either HostName HostName
forall a b. a -> Either a b
Left (HostName -> Either HostName HostName)
-> HostName -> Either HostName HostName
forall a b. (a -> b) -> a -> b
$ HostName
"Expecting " HostName -> ShowS
forall a. Semigroup a => a -> a -> a
<> HostName
forall a. IsString a => a
remotePrefix) HostName -> Either HostName HostName
forall a b. b -> Either a b
Right (Maybe HostName -> Either HostName HostName)
-> Maybe HostName -> Either HostName HostName
forall a b. (a -> b) -> a -> b
$ HostName -> HostName -> Maybe HostName
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix HostName
forall a. IsString a => a
remotePrefix HostName
uri
  (HostName
host, HostName
path) <- case (Char -> Bool) -> HostName -> (HostName, HostName)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/') HostName
hostnamePath of
    (HostName
h, Char
'/' : HostName
p) -> (HostName, HostName) -> Either HostName (HostName, HostName)
forall a b. b -> Either a b
Right (HostName
h, HostName
p)
    (HostName, HostName)
_ -> HostName -> Either HostName (HostName, HostName)
forall a b. a -> Either a b
Left HostName
"Expecting /"
  case (Char -> Bool) -> HostName -> (HostName, HostName)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':') HostName
host of
    (HostName
hostname, Char
':' : HostName
portStr)
        | Just PortNumber
p <- HostName -> Maybe PortNumber
forall a. Read a => HostName -> Maybe a
readMaybe HostName
portStr -> FranzPath -> Either HostName FranzPath
forall a b. b -> Either a b
Right (FranzPath -> Either HostName FranzPath)
-> FranzPath -> Either HostName FranzPath
forall a b. (a -> b) -> a -> b
$ HostName -> PortNumber -> HostName -> FranzPath
FranzPath HostName
hostname PortNumber
p HostName
path
        | Bool
otherwise -> HostName -> Either HostName FranzPath
forall a b. a -> Either a b
Left HostName
"Failed to parse the port number"
    (HostName, HostName)
_ -> FranzPath -> Either HostName FranzPath
forall a b. b -> Either a b
Right (FranzPath -> Either HostName FranzPath)
-> FranzPath -> Either HostName FranzPath
forall a b. (a -> b) -> a -> b
$ HostName -> PortNumber -> HostName -> FranzPath
FranzPath HostName
host PortNumber
1886 HostName
path

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

fromFranzPath (LocalFranzPath HostName
path) = a
forall a. IsString a => a
localPrefix a -> a -> a
forall a. Semigroup a => a -> a -> a
<> HostName -> a
forall a. IsString a => HostName -> a
fromString HostName
path