{-# OPTIONS_GHC -fno-warn-orphans #-}

module PathPiece where
  
import Data.Text (breakOn, splitOn)
import qualified Data.Text as T (replace)
import Import.NoFoundation

-- PathPiece

instance PathPiece UserNameP where
  toPathPiece :: UserNameP -> Text
toPathPiece (UserNameP Text
i) = Text
"u:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
i
  fromPathPiece :: Text -> Maybe UserNameP
fromPathPiece Text
s =
    case HasCallStack => Text -> Text -> (Text, Text)
Text -> Text -> (Text, Text)
breakOn Text
":" Text
s of
      (Text
"u", Text
"") -> Maybe UserNameP
forall a. Maybe a
Nothing
      (Text
"u", Text
uname) -> UserNameP -> Maybe UserNameP
forall a. a -> Maybe a
Just (UserNameP -> Maybe UserNameP) -> UserNameP -> Maybe UserNameP
forall a b. (a -> b) -> a -> b
$ Text -> UserNameP
UserNameP (Index Text -> Text -> Text
forall seq. IsSequence seq => Index seq -> seq -> seq
drop Int
Index Text
1 Text
uname)
      (Text, Text)
_ -> Maybe UserNameP
forall a. Maybe a
Nothing

instance PathPiece TagsP where
  toPathPiece :: TagsP -> Text
toPathPiece (TagsP [Text]
tags) = Text
"t:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Element [Text] -> [Text] -> Element [Text]
forall mono.
(MonoFoldable mono, Monoid (Element mono)) =>
Element mono -> mono -> Element mono
intercalate Text
Element [Text]
"+" ((Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
encodeTag [Text]
tags)
  fromPathPiece :: Text -> Maybe TagsP
fromPathPiece Text
s =
    case HasCallStack => Text -> Text -> (Text, Text)
Text -> Text -> (Text, Text)
breakOn Text
":" Text
s of
      (Text
"t", Text
"") -> Maybe TagsP
forall a. Maybe a
Nothing
      (Text
"t", Text
tags) -> TagsP -> Maybe TagsP
forall a. a -> Maybe a
Just (TagsP -> Maybe TagsP) -> TagsP -> Maybe TagsP
forall a b. (a -> b) -> a -> b
$ ([Text] -> TagsP
TagsP ([Text] -> TagsP) -> (Text -> [Text]) -> Text -> TagsP
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
decodeTag ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
splitOn Text
"+" (Text -> [Text]) -> (Text -> Text) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Index Text -> Text -> Text
forall seq. IsSequence seq => Index seq -> seq -> seq
drop Int
Index Text
1) Text
tags
      (Text, Text)
_ -> Maybe TagsP
forall a. Maybe a
Nothing

encodeTag :: Text -> Text
encodeTag :: Text -> Text
encodeTag = HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"+" Text
"%2B"

decodeTag :: Text -> Text
decodeTag :: Text -> Text
decodeTag = HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"%2B" Text
"+"

instance PathPiece SharedP where
  toPathPiece :: SharedP -> Text
toPathPiece = \case
    SharedP
SharedAll -> Text
""
    SharedP
SharedPublic -> Text
"public"
    SharedP
SharedPrivate -> Text
"private"
  fromPathPiece :: Text -> Maybe SharedP
fromPathPiece = \case
    Text
"public" -> SharedP -> Maybe SharedP
forall a. a -> Maybe a
Just SharedP
SharedPublic
    Text
"private" -> SharedP -> Maybe SharedP
forall a. a -> Maybe a
Just SharedP
SharedPrivate
    Text
_ -> Maybe SharedP
forall a. Maybe a
Nothing

instance PathPiece FilterP where
  toPathPiece :: FilterP -> Text
toPathPiece = \case
    FilterP
FilterAll -> Text
""
    FilterP
FilterUnread -> Text
"unread"
    FilterP
FilterUntagged -> Text
"untagged"
    FilterP
FilterStarred -> Text
"starred"
    FilterSingle BmSlug
slug -> Text
"b:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> BmSlug -> Text
unBmSlug BmSlug
slug
  fromPathPiece :: Text -> Maybe FilterP
fromPathPiece = \case
    Text
"unread" -> FilterP -> Maybe FilterP
forall a. a -> Maybe a
Just FilterP
FilterUnread
    Text
"untagged" -> FilterP -> Maybe FilterP
forall a. a -> Maybe a
Just FilterP
FilterUntagged
    Text
"starred" -> FilterP -> Maybe FilterP
forall a. a -> Maybe a
Just FilterP
FilterStarred
    Text
s -> case HasCallStack => Text -> Text -> (Text, Text)
Text -> Text -> (Text, Text)
breakOn Text
":" Text
s of
        (Text
"b", Text
"") -> Maybe FilterP
forall a. Maybe a
Nothing
        (Text
"b", Text
slug) -> FilterP -> Maybe FilterP
forall a. a -> Maybe a
Just (FilterP -> Maybe FilterP) -> FilterP -> Maybe FilterP
forall a b. (a -> b) -> a -> b
$ BmSlug -> FilterP
FilterSingle (Text -> BmSlug
BmSlug (Index Text -> Text -> Text
forall seq. IsSequence seq => Index seq -> seq -> seq
drop Int
Index Text
1 Text
slug))
        (Text, Text)
_ -> Maybe FilterP
forall a. Maybe a
Nothing


deriving instance PathPiece NtSlug 
deriving instance PathPiece BmSlug