{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ViewPatterns #-}
module LaunchDarkly.Server.Reference
( Reference
, makeReference
, makeLiteral
, isValid
, getError
, getComponents
, getRawPath
)
where
import Data.Aeson (ToJSON, Value (String), toJSON)
import Data.Text (Text)
import qualified Data.Text as T
data Reference
= Valid {Reference -> Text
rawPath :: !Text, Reference -> [Text]
components :: ![Text]}
| Invalid {rawPath :: !Text, Reference -> Text
error :: !Text}
deriving (Int -> Reference -> ShowS
[Reference] -> ShowS
Reference -> String
(Int -> Reference -> ShowS)
-> (Reference -> String)
-> ([Reference] -> ShowS)
-> Show Reference
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Reference] -> ShowS
$cshowList :: [Reference] -> ShowS
show :: Reference -> String
$cshow :: Reference -> String
showsPrec :: Int -> Reference -> ShowS
$cshowsPrec :: Int -> Reference -> ShowS
Show, Reference -> Reference -> Bool
(Reference -> Reference -> Bool)
-> (Reference -> Reference -> Bool) -> Eq Reference
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Reference -> Reference -> Bool
$c/= :: Reference -> Reference -> Bool
== :: Reference -> Reference -> Bool
$c== :: Reference -> Reference -> Bool
Eq)
instance Ord Reference where
compare :: Reference -> Reference -> Ordering
compare (Invalid _ _) (Valid _ _) = Ordering
LT
compare (Valid _ _) (Invalid _ _) = Ordering
GT
compare (Valid lhsRaw :: Text
lhsRaw lhsComponents :: [Text]
lhsComponents) (Valid rhsRaw :: Text
rhsRaw rhsComponents :: [Text]
rhsComponents)
| [Text]
lhsComponents [Text] -> [Text] -> Bool
forall a. Eq a => a -> a -> Bool
== [Text]
rhsComponents = Text -> Text -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Text
lhsRaw Text
rhsRaw
| Bool
otherwise = [Text] -> [Text] -> Ordering
forall a. Ord a => a -> a -> Ordering
compare [Text]
lhsComponents [Text]
rhsComponents
compare (Invalid lhsRaw :: Text
lhsRaw lhsError :: Text
lhsError) (Invalid rhsRaw :: Text
rhsRaw rhsError :: Text
rhsError)
| Text
lhsRaw Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
rhsRaw = Text -> Text -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Text
lhsError Text
rhsError
| Bool
otherwise = Text -> Text -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Text
lhsRaw Text
rhsRaw
instance ToJSON Reference where
toJSON :: Reference -> Value
toJSON = Text -> Value
String (Text -> Value) -> (Reference -> Text) -> Reference -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reference -> Text
rawPath
makeReference :: Text -> Reference
makeReference :: Text -> Reference
makeReference "" = $WInvalid :: Text -> Text -> Reference
Invalid {$sel:rawPath:Valid :: Text
rawPath = "", $sel:error:Valid :: Text
error = "empty reference"}
makeReference "/" = $WInvalid :: Text -> Text -> Reference
Invalid {$sel:rawPath:Valid :: Text
rawPath = "/", $sel:error:Valid :: Text
error = "empty reference"}
makeReference value :: Text
value@(Text -> Text -> Maybe Text
T.stripPrefix "/" -> Maybe Text
Nothing) = $WValid :: Text -> [Text] -> Reference
Valid {$sel:rawPath:Valid :: Text
rawPath = Text
value, $sel:components:Valid :: [Text]
components = [Text
value]}
makeReference value :: Text
value@(Text -> Text -> Maybe Text
T.stripSuffix "/" -> Just _) = $WInvalid :: Text -> Text -> Reference
Invalid {$sel:rawPath:Valid :: Text
rawPath = Text
value, $sel:error:Valid :: Text
error = "trailing slash"}
makeReference value :: Text
value = (Text -> Reference -> Reference)
-> Reference -> [Text] -> Reference
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Text -> Reference -> Reference
addComponentToReference ($WValid :: Text -> [Text] -> Reference
Valid {$sel:rawPath:Valid :: Text
rawPath = Text
value, $sel:components:Valid :: [Text]
components = []}) (Text -> Text -> [Text]
T.splitOn "/" (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.drop 1 Text
value)
makeLiteral :: Text -> Reference
makeLiteral :: Text -> Reference
makeLiteral "" = $WInvalid :: Text -> Text -> Reference
Invalid {$sel:rawPath:Valid :: Text
rawPath = "", $sel:error:Valid :: Text
error = "empty reference"}
makeLiteral value :: Text
value@(Text -> Text -> Maybe Text
T.stripPrefix "/" -> Maybe Text
Nothing) = $WValid :: Text -> [Text] -> Reference
Valid {$sel:rawPath:Valid :: Text
rawPath = Text
value, $sel:components:Valid :: [Text]
components = [Text
value]}
makeLiteral value :: Text
value = $WValid :: Text -> [Text] -> Reference
Valid {$sel:rawPath:Valid :: Text
rawPath = "/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Text -> Text -> Text -> Text
T.replace "/" "~1" (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> Text
T.replace "~" "~0" Text
value), $sel:components:Valid :: [Text]
components = [Text
value]}
isValid :: Reference -> Bool
isValid :: Reference -> Bool
isValid (Invalid _ _) = Bool
False
isValid _ = Bool
True
getError :: Reference -> Text
getError :: Reference -> Text
getError (Invalid {$sel:error:Valid :: Reference -> Text
error = Text
e}) = Text
e
getError _ = ""
getComponents :: Reference -> [Text]
getComponents :: Reference -> [Text]
getComponents (Valid {[Text]
components :: [Text]
$sel:components:Valid :: Reference -> [Text]
components}) = [Text]
components
getComponents _ = []
getRawPath :: Reference -> Text
getRawPath :: Reference -> Text
getRawPath = Reference -> Text
rawPath
addComponentToReference :: Text -> Reference -> Reference
addComponentToReference :: Text -> Reference -> Reference
addComponentToReference _ r :: Reference
r@(Invalid _ _) = Reference
r
addComponentToReference "" (Valid {Text
rawPath :: Text
$sel:rawPath:Valid :: Reference -> Text
rawPath}) = $WInvalid :: Text -> Text -> Reference
Invalid {Text
rawPath :: Text
$sel:rawPath:Valid :: Text
rawPath, $sel:error:Valid :: Text
error = "double slash"}
addComponentToReference component :: Text
component (Valid {Text
rawPath :: Text
$sel:rawPath:Valid :: Reference -> Text
rawPath, [Text]
components :: [Text]
$sel:components:Valid :: Reference -> [Text]
components}) = case Text -> Either Text Text
unescapePath Text
component of
Left c :: Text
c -> $WValid :: Text -> [Text] -> Reference
Valid {Text
rawPath :: Text
$sel:rawPath:Valid :: Text
rawPath, $sel:components:Valid :: [Text]
components = (Text
c Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
components)}
Right e :: Text
e -> $WInvalid :: Text -> Text -> Reference
Invalid {Text
rawPath :: Text
$sel:rawPath:Valid :: Text
rawPath, $sel:error:Valid :: Text
error = Text
e}
unescapePath :: Text -> Either Text Text
unescapePath :: Text -> Either Text Text
unescapePath value :: Text
value@(Text -> Text -> Bool
T.isInfixOf "~" -> Bool
False) = Text -> Either Text Text
forall a b. a -> Either a b
Left Text
value
unescapePath (Text -> Text -> Maybe Text
T.stripSuffix "~" -> Just _) = Text -> Either Text Text
forall a b. b -> Either a b
Right "invalid escape sequence"
unescapePath value :: Text
value =
let component :: ComponentState
component = (ComponentState -> Char -> ComponentState)
-> ComponentState -> Text -> ComponentState
forall a. (a -> Char -> a) -> a -> Text -> a
T.foldl ComponentState -> Char -> ComponentState
unescapeComponent ($WComponentState :: String -> Bool -> Bool -> ComponentState
ComponentState {$sel:acc:ComponentState :: String
acc = [], $sel:valid:ComponentState :: Bool
valid = Bool
True, $sel:inEscape:ComponentState :: Bool
inEscape = Bool
False}) Text
value
in case ComponentState
component of
ComponentState {$sel:acc:ComponentState :: ComponentState -> String
acc = String
acc, $sel:valid:ComponentState :: ComponentState -> Bool
valid = Bool
True} -> Text -> Either Text Text
forall a b. a -> Either a b
Left (Text -> Either Text Text) -> Text -> Either Text Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ShowS
forall a. [a] -> [a]
reverse String
acc
_ -> Text -> Either Text Text
forall a b. b -> Either a b
Right "invalid escape sequence"
data ComponentState = ComponentState
{ ComponentState -> String
acc :: ![Char]
, ComponentState -> Bool
valid :: !Bool
, ComponentState -> Bool
inEscape :: !Bool
}
unescapeComponent :: ComponentState -> Char -> ComponentState
unescapeComponent :: ComponentState -> Char -> ComponentState
unescapeComponent component :: ComponentState
component@(ComponentState {$sel:valid:ComponentState :: ComponentState -> Bool
valid = Bool
False}) _ = ComponentState
component
unescapeComponent component :: ComponentState
component@(ComponentState {String
acc :: String
$sel:acc:ComponentState :: ComponentState -> String
acc, $sel:inEscape:ComponentState :: ComponentState -> Bool
inEscape = Bool
True}) '0' = ComponentState
component {$sel:acc:ComponentState :: String
acc = '~' Char -> ShowS
forall a. a -> [a] -> [a]
: String
acc, $sel:valid:ComponentState :: Bool
valid = Bool
True, $sel:inEscape:ComponentState :: Bool
inEscape = Bool
False}
unescapeComponent component :: ComponentState
component@(ComponentState {String
acc :: String
$sel:acc:ComponentState :: ComponentState -> String
acc, $sel:inEscape:ComponentState :: ComponentState -> Bool
inEscape = Bool
True}) '1' = ComponentState
component {$sel:acc:ComponentState :: String
acc = '/' Char -> ShowS
forall a. a -> [a] -> [a]
: String
acc, $sel:valid:ComponentState :: Bool
valid = Bool
True, $sel:inEscape:ComponentState :: Bool
inEscape = Bool
False}
unescapeComponent component :: ComponentState
component@(ComponentState {$sel:inEscape:ComponentState :: ComponentState -> Bool
inEscape = Bool
True}) _ = ComponentState
component {$sel:valid:ComponentState :: Bool
valid = Bool
False}
unescapeComponent component :: ComponentState
component '~' = ComponentState
component {$sel:inEscape:ComponentState :: Bool
inEscape = Bool
True}
unescapeComponent component :: ComponentState
component@(ComponentState {String
acc :: String
$sel:acc:ComponentState :: ComponentState -> String
acc}) c :: Char
c = ComponentState
component {$sel:acc:ComponentState :: String
acc = Char
c Char -> ShowS
forall a. a -> [a] -> [a]
: String
acc}