{-# 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:" forall a. Semigroup a => a -> a -> a
<> Text
i
  fromPathPiece :: Text -> Maybe UserNameP
fromPathPiece Text
s =
    case Text -> Text -> (Text, Text)
breakOn Text
":" Text
s of
      (Text
"u", Text
"") -> forall a. Maybe a
Nothing
      (Text
"u", Text
uname) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text -> UserNameP
UserNameP (forall seq. IsSequence seq => Index seq -> seq -> seq
drop Int
1 Text
uname)
      (Text, Text)
_ -> forall a. Maybe a
Nothing

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

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

decodeTag :: Text -> Text
decodeTag :: Text -> Text
decodeTag = 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" -> forall a. a -> Maybe a
Just SharedP
SharedPublic
    Text
"private" -> forall a. a -> Maybe a
Just SharedP
SharedPrivate
    Text
_ -> 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:" forall a. Semigroup a => a -> a -> a
<> BmSlug -> Text
unBmSlug BmSlug
slug
  fromPathPiece :: Text -> Maybe FilterP
fromPathPiece = \case
    Text
"unread" -> forall a. a -> Maybe a
Just FilterP
FilterUnread
    Text
"untagged" -> forall a. a -> Maybe a
Just FilterP
FilterUntagged
    Text
"starred" -> forall a. a -> Maybe a
Just FilterP
FilterStarred
    Text
s -> case Text -> Text -> (Text, Text)
breakOn Text
":" Text
s of
        (Text
"b", Text
"") -> forall a. Maybe a
Nothing
        (Text
"b", Text
slug) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ BmSlug -> FilterP
FilterSingle (Text -> BmSlug
BmSlug (forall seq. IsSequence seq => Index seq -> seq -> seq
drop Int
1 Text
slug))
        (Text, Text)
_ -> forall a. Maybe a
Nothing


deriving instance PathPiece NtSlug 
deriving instance PathPiece BmSlug