{-# LANGUAGE FlexibleInstances #-}

{- |
Copyright:  (c) 2015-2019 Aelve
            (c) 2019-2020 Kowainik
SPDX-License-Identifier: MPL-2.0
Maintainer: Kowainik <xrom.xkov@gmail.com>

Useful functions when writing your own link rules.
-}

module ShortcutLinks.Utils
    ( replaceSpaces
    , titleFirst
    , tryStripPrefixCI
    , stripPrefixCI
    , orElse
    , format
    , formatSlash
    ) where

import Data.Char (isSpace, toUpper)
import Data.Semigroup ((<>))
import Data.Text (Text)

import qualified Data.Text as T


{- | Replace spaces in text with chosen character (useful when processing queries containing spaces – they are often turned into “+” or “_”).

>>> replaceSpaces '_' "hi   there"
"hi___there"
-}
replaceSpaces :: Char -> Text -> Text
replaceSpaces :: Char -> Text -> Text
replaceSpaces r :: Char
r = (Char -> Char) -> Text -> Text
T.map (\c :: Char
c -> if Char -> Bool
isSpace Char
c then Char
r else Char
c)

{- | Convert the 1st character of a string to upper case.

This function is dumber than it could've been; when the 1st character
doesn't have a single-character uppercase form (like “ß”), it is left
intact instead of being converted (“Ss” in the case of “ß”). This is good,
however; for instance, if the “proper” capitalisation rule was applied to
e.g. Wikipedia links, a link to the article on “ß” would've been rendered
as “Ss”, which is a redirect to “Schutzstaffel”.
-}
titleFirst :: Text -> Text
titleFirst :: Text -> Text
titleFirst = Text -> [Text] -> Text
T.intercalate "#" ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
title ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> [Text]
T.splitOn "#"
  where
    title :: Text -> Text
    title :: Text -> Text
title s :: Text
s = case Text -> Maybe (Char, Text)
T.uncons Text
s of
        Nothing        -> ""
        Just (c :: Char
c, rest :: Text
rest) -> Char -> Char
toUpper Char
c Char -> Text -> Text
`T.cons` Text
rest

{- | Strip given prefix from a string, or do nothing if the string doesn't
have given prefix.

This function is case-insensitive.

>>> tryStripPrefixCI "FOO" "FooBAR"
"BAR"

>>> tryStripPrefixCI "foo" "quux"
"quux"
-}
tryStripPrefixCI :: Text -> Text -> Text
tryStripPrefixCI :: Text -> Text -> Text
tryStripPrefixCI pref :: Text
pref str :: Text
str =
  let pref' :: Text
pref' = Text -> Text
T.toCaseFold Text
pref
      (str_pref :: Text
str_pref, rest :: Text
rest) = Int -> Text -> (Text, Text)
T.splitAt (Text -> Int
T.length Text
pref') Text
str
  in  if Text -> Text
T.toCaseFold Text
str_pref Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
pref' then Text
rest else Text
str

{- | Strip given prefix from a string.

This function is case-insensitive.

>>> stripPrefixCI "FOO" "FooBAR"
Just "BAR"

>>> stripPrefixCI "foo" "quux"
Nothing
-}
stripPrefixCI :: Text -> Text -> Maybe Text
stripPrefixCI :: Text -> Text -> Maybe Text
stripPrefixCI pref :: Text
pref str :: Text
str =
  let pref' :: Text
pref' = Text -> Text
T.toCaseFold Text
pref
      (str_pref :: Text
str_pref, rest :: Text
rest) = Int -> Text -> (Text, Text)
T.splitAt (Text -> Int
T.length Text
pref') Text
str
  in  if Text -> Text
T.toCaseFold Text
str_pref Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
pref' then Text -> Maybe Text
forall a. a -> Maybe a
Just Text
rest else Maybe Text
forall a. Maybe a
Nothing

-- | Choose the 2nd value if the 1st is empty (equal to 'mempty').
orElse :: (Eq a, Monoid a) => a -> a -> a
orElse :: a -> a -> a
orElse a :: a
a b :: a
b = if a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
forall a. Monoid a => a
mempty then a
b else a
a

------------------------------------------------------------------------------
-- A micro formatting library which supports Text better than printf.
------------------------------------------------------------------------------

class FormatArg a where
  formatArg :: a -> Text

instance FormatArg Text    where formatArg :: Text -> Text
formatArg = Text -> Text
forall a. a -> a
id
instance FormatArg String  where formatArg :: String -> Text
formatArg = String -> Text
T.pack
instance FormatArg Int     where formatArg :: Int -> Text
formatArg = String -> Text
T.pack (String -> Text) -> (Int -> String) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show
instance FormatArg Integer where formatArg :: Integer -> Text
formatArg = String -> Text
T.pack (String -> Text) -> (Integer -> String) -> Integer -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> String
forall a. Show a => a -> String
show

class FormatType r where
  format' :: Text -> [Text] -> r

instance FormatType String where
  format' :: Text -> [Text] -> String
format' str :: Text
str params :: [Text]
params = Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
forall r. FormatType r => Text -> [Text] -> r
format' Text
str [Text]
params

instance FormatType Text where
  format' :: Text -> [Text] -> Text
format' str :: Text
str params :: [Text]
params = [Text] -> [Text] -> Text
forall p. Semigroup p => [p] -> [p] -> p
go [Text]
fragments ([Text] -> [Text]
forall a. [a] -> [a]
reverse [Text]
params)
    where
      fragments :: [Text]
fragments = Text -> Text -> [Text]
T.splitOn "{}" Text
str
      go :: [p] -> [p] -> p
go (f :: p
f:fs :: [p]
fs) (y :: p
y:ys :: [p]
ys) = p
f p -> p -> p
forall a. Semigroup a => a -> a -> a
<> p
y p -> p -> p
forall a. Semigroup a => a -> a -> a
<> [p] -> [p] -> p
go [p]
fs [p]
ys
      go [f :: p
f] []        = p
f
      go _ _ = String -> p
forall a. HasCallStack => String -> a
error (String -> p) -> String -> p
forall a b. (a -> b) -> a -> b
$ Text -> Int -> Int -> String
forall r. FormatType r => Text -> r
format
        "ShortcutLinks.Utils.format: {} placeholders, but {} parameters"
        ([Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
fragments Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1)
        ([Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
params)

instance (FormatArg a, FormatType r) => FormatType (a -> r) where
  format' :: Text -> [Text] -> (a -> r)
  format' :: Text -> [Text] -> a -> r
format' str :: Text
str params :: [Text]
params a :: a
a = Text -> [Text] -> r
forall r. FormatType r => Text -> [Text] -> r
format' Text
str (a -> Text
forall a. FormatArg a => a -> Text
formatArg a
a Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
params)

{- | A 'printf'-like function which fully supports 'Text' as an input and
output format and which uses @{}@ instead of @%@ to indicate
placeholders. If you use it, don't forget to enable @OverloadedStrings@.

This is a lightweight alternative to something like the text-format
package, and it's closer to 'printf' and simpler to use.
-}
format :: FormatType r => Text -> r
format :: Text -> r
format str :: Text
str = Text -> [Text] -> r
forall r. FormatType r => Text -> [Text] -> r
format' Text
str []

formatSlash :: FormatType r => r
formatSlash :: r
formatSlash = Text -> r
forall r. FormatType r => Text -> r
format "{}/{}"