-- Copyright 2013 Evan Laforge
-- This program is distributed under the terms of the GNU General Public
-- License 3.0, see COPYING or http://www.gnu.org/licenses/gpl-3.0.txt

{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, OverloadedStrings #-}
module Util.Texts where
import           Prelude hiding (lines)
import           Control.Arrow (first)
import           Control.Monad (liftM)
import qualified Control.Monad.Identity as Identity

import qualified Data.ByteString as ByteString
import qualified Data.ByteString.Lazy as ByteString.Lazy
import qualified Data.Char as Char
import qualified Data.List as List
import qualified Data.Map as Map
import qualified Data.Maybe as Maybe
import qualified Data.Set as Set
import qualified Data.String as String
import qualified Data.Text as Text
import           Data.Text (Text)
import qualified Data.Text.Encoding as Encoding
import qualified Data.Text.Encoding.Error as Encoding.Error
import qualified Data.Text.Lazy as Text.Lazy
import qualified Data.Text.Lazy.Encoding as Lazy.Encoding

import qualified System.FilePath as FilePath
import           System.FilePath ((</>))

import qualified Util.Regex as Regex
import qualified Util.Seq as Seq


-- * conversion

class Textlike a where
    toText :: a -> Text
    fromText :: Text -> a

    toString :: a -> String
    toString = Text -> String
Text.unpack (Text -> String) -> (a -> Text) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Text
forall a. Textlike a => a -> Text
toText

    toByteString :: a -> ByteString.ByteString
    toByteString = Text -> ByteString
Encoding.encodeUtf8 (Text -> ByteString) -> (a -> Text) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Text
forall a. Textlike a => a -> Text
toText

    toLazyByteString :: a -> ByteString.Lazy.ByteString
    toLazyByteString = Text -> ByteString
Lazy.Encoding.encodeUtf8 (Text -> ByteString) -> (a -> Text) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
Text.Lazy.fromStrict (Text -> Text) -> (a -> Text) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Text
forall a. Textlike a => a -> Text
toText

instance Textlike Text where
    toText :: Text -> Text
toText = Text -> Text
forall a. a -> a
id
    fromText :: Text -> Text
fromText = Text -> Text
forall a. a -> a
id

instance Textlike String where
    toText :: String -> Text
toText = String -> Text
Text.pack
    fromText :: Text -> String
fromText = Text -> String
Text.unpack

instance Textlike ByteString.ByteString where
    toText :: ByteString -> Text
toText = OnDecodeError -> ByteString -> Text
Encoding.decodeUtf8With OnDecodeError
Encoding.Error.lenientDecode
    fromText :: Text -> ByteString
fromText = Text -> ByteString
forall a. Textlike a => a -> ByteString
toByteString
    toByteString :: ByteString -> ByteString
toByteString = ByteString -> ByteString
forall a. a -> a
id
    toLazyByteString :: ByteString -> ByteString
toLazyByteString = ByteString -> ByteString
ByteString.Lazy.fromStrict

instance Textlike ByteString.Lazy.ByteString where
    toText :: ByteString -> Text
toText = ByteString -> Text
forall a. Textlike a => a -> Text
toText (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
ByteString.Lazy.toStrict
    fromText :: Text -> ByteString
fromText = ByteString -> ByteString
ByteString.Lazy.fromStrict (ByteString -> ByteString)
-> (Text -> ByteString) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
forall a. Textlike a => Text -> a
fromText
    toByteString :: ByteString -> ByteString
toByteString = ByteString -> ByteString
ByteString.Lazy.toStrict
    toLazyByteString :: ByteString -> ByteString
toLazyByteString = ByteString -> ByteString
forall a. a -> a
id


-- * operations

-- | Replace substrings simultaneously.
replaceMany :: [(Text, Text)] -> Text -> Text
replaceMany :: [(Text, Text)] -> Text -> Text
replaceMany [(Text, Text)]
replace = [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
go
    where
    go :: Text -> [Text]
go Text
text
        | Text -> Bool
Text.null Text
text = []
        | Bool
otherwise = [Text]
-> (((Text, Text), (Text, Text)) -> [Text])
-> Maybe ((Text, Text), (Text, Text))
-> [Text]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Text
text] ((Text, Text), (Text, Text)) -> [Text]
continue (Maybe ((Text, Text), (Text, Text)) -> [Text])
-> Maybe ((Text, Text), (Text, Text)) -> [Text]
forall a b. (a -> b) -> a -> b
$
            (((Text, Text), (Text, Text)) -> Int)
-> [((Text, Text), (Text, Text))]
-> Maybe ((Text, Text), (Text, Text))
forall k a. Ord k => (a -> k) -> [a] -> Maybe a
Seq.minimum_on (Text -> Int
Text.length (Text -> Int)
-> (((Text, Text), (Text, Text)) -> Text)
-> ((Text, Text), (Text, Text))
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Text) -> Text
forall a b. (a, b) -> a
fst ((Text, Text) -> Text)
-> (((Text, Text), (Text, Text)) -> (Text, Text))
-> ((Text, Text), (Text, Text))
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, Text), (Text, Text)) -> (Text, Text)
forall a b. (a, b) -> a
fst)
                [(Text -> Text -> (Text, Text)
Text.breakOn ((Text, Text) -> Text
forall a b. (a, b) -> a
fst (Text, Text)
r) Text
text, (Text, Text)
r) | (Text, Text)
r <- [(Text, Text)]
replace]
    continue :: ((Text, Text), (Text, Text)) -> [Text]
continue ((Text
pre, Text
post), (Text
from, Text
to))
        | Text -> Bool
Text.null Text
post = [Text
pre]
        | Bool
otherwise = Text
pre Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Text
to Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Text -> [Text]
go (Int -> Text -> Text
Text.drop (Text -> Int
Text.length Text
from) Text
post)

-- | Join the two pieces with a space, if they are non-empty.
unwords2 :: Textlike a => a -> a -> a
unwords2 :: forall a. Textlike a => a -> a -> a
unwords2 = a -> a -> a -> a
forall a. Textlike a => a -> a -> a -> a
join2 (Text -> a
forall a. Textlike a => Text -> a
fromText Text
" ")

unlines2 :: Textlike a => a -> a -> a
unlines2 :: forall a. Textlike a => a -> a -> a
unlines2 = a -> a -> a -> a
forall a. Textlike a => a -> a -> a -> a
join2 (Text -> a
forall a. Textlike a => Text -> a
fromText Text
"\n")

-- | The 2 variants join two texts, but omit the separator if one is null.
join2 :: Textlike a => a -> a -> a -> a
join2 :: forall a. Textlike a => a -> a -> a -> a
join2 a
sep a
a a
b = a -> [a] -> a
forall a. Textlike a => a -> [a] -> a
join a
sep ([a] -> a) -> [a] -> a
forall a b. (a -> b) -> a -> b
$ (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (a -> Bool) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
Text.null (Text -> Bool) -> (a -> Text) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Text
forall a. Textlike a => a -> Text
toText) [a
a, a
b]

join :: Textlike a => a -> [a] -> a
join :: forall a. Textlike a => a -> [a] -> a
join a
sep = Text -> a
forall a. Textlike a => Text -> a
fromText (Text -> a) -> ([a] -> Text) -> [a] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
Text.intercalate (a -> Text
forall a. Textlike a => a -> Text
toText a
sep) ([Text] -> Text) -> ([a] -> [Text]) -> [a] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Text) -> [a] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map a -> Text
forall a. Textlike a => a -> Text
toText

unlines :: Textlike a => [a] -> a
unlines :: forall a. Textlike a => [a] -> a
unlines = Text -> a
forall a. Textlike a => Text -> a
fromText (Text -> a) -> ([a] -> Text) -> [a] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
Text.unlines ([Text] -> Text) -> ([a] -> [Text]) -> [a] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Text) -> [a] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map a -> Text
forall a. Textlike a => a -> Text
toText

split1 :: Text -> Text -> (Text, Text)
split1 :: Text -> Text -> (Text, Text)
split1 Text
sep Text
text = (Text
pre, Int -> Text -> Text
Text.drop (Text -> Int
Text.length Text
sep) Text
post)
    where (Text
pre, Text
post) = Text -> Text -> (Text, Text)
Text.breakOn Text
sep Text
text

ellipsis :: Int -> Text -> Text
ellipsis :: Int -> Text -> Text
ellipsis Int
maxWidth Text
text
    | Text -> Int
Text.length Text
text Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
maxWidth = Text
text
    | Bool
otherwise = Int -> Text -> Text
Text.take (Int
maxWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
3) Text
text Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"..."

ellipsisList :: Int -> [Text] -> [Text]
ellipsisList :: Int -> [Text] -> [Text]
ellipsisList Int
max [Text]
xs
    | [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
post = [Text]
xs
    | Bool
otherwise = [Text]
pre [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
"..."]
    where ([Text]
pre, [Text]
post) = Int -> [Text] -> ([Text], [Text])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
max [Text]
xs

dropPrefix :: Text -> Text -> Text
dropPrefix :: Text -> Text -> Text
dropPrefix Text
prefix Text
text
    | Text
prefix Text -> Text -> Bool
`Text.isPrefixOf` Text
text = Int -> Text -> Text
Text.drop (Text -> Int
Text.length Text
prefix) Text
text
    | Bool
otherwise = Text
text

enumeration :: (Textlike a, Monoid a, String.IsString a) => [a] -> a
enumeration :: forall a. (Textlike a, Monoid a, IsString a) => [a] -> a
enumeration = a -> [a] -> a
forall a. Textlike a => a -> [a] -> a
join a
"\n" ([a] -> a) -> ([a] -> [a]) -> [a] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a
"- "<>)

-- | Format the given rows into columns, aligned vertically.
columns :: Int -> [[Text]] -> [Text]
columns :: Int -> [[Text]] -> [Text]
columns Int
padding [[Text]]
rows = ([Text] -> Text) -> [[Text]] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map [Text] -> Text
formatRow [[Text]]
rows
    where
    formatRow :: [Text] -> Text
formatRow = Text -> Text
Text.stripEnd (Text -> Text) -> ([Text] -> Text) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ([Text] -> Text) -> ([Text] -> [Text]) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Text -> Text) -> [Int] -> [Text] -> [Text]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> Text -> Text
pad [Int]
widths
    pad :: Int -> Text -> Text
pad Int
w = Int -> Char -> Text -> Text
Text.justifyLeft (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
padding) Char
' '
    byCol :: [[Text]]
byCol = ([Maybe Text] -> [Text]) -> [[Maybe Text]] -> [[Text]]
forall a b. (a -> b) -> [a] -> [b]
map ((Maybe Text -> Text) -> [Maybe Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
Maybe.fromMaybe Text
Text.empty)) ([[Text]] -> [[Maybe Text]]
forall a. [[a]] -> [[Maybe a]]
Seq.rotate2 [[Text]]
rows)
    widths :: [Int]
widths = ([Text] -> Int) -> [[Text]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ([Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
List.maximum ([Int] -> Int) -> ([Text] -> [Int]) -> [Text] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int
0:) ([Int] -> [Int]) -> ([Text] -> [Int]) -> [Text] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Int) -> [Text] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Int
Text.length) [[Text]]
byCol

-- | Apply a function to the contents delimited by the given Char.  You can
-- quote a delimiter with a backslash.
mapDelimited :: Bool -> Char -> (Text -> Text) -> Text -> Text
mapDelimited :: Bool -> Char -> (Text -> Text) -> Text -> Text
mapDelimited Bool
withSpaces Char
delimiter Text -> Text
f =
    Identity Text -> Text
forall a. Identity a -> a
Identity.runIdentity (Identity Text -> Text) -> (Text -> Identity Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Char -> (Text -> Identity Text) -> Text -> Identity Text
forall (m :: * -> *).
Monad m =>
Bool -> Char -> (Text -> m Text) -> Text -> m Text
mapDelimitedM Bool
withSpaces Char
delimiter (Text -> Identity Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Identity Text) -> (Text -> Text) -> Text -> Identity Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
f)

mapDelimitedM :: Monad m => Bool -> Char -> (Text -> m Text) -> Text -> m Text
mapDelimitedM :: forall (m :: * -> *).
Monad m =>
Bool -> Char -> (Text -> m Text) -> Text -> m Text
mapDelimitedM Bool
withSpaces Char
delimiter Text -> m Text
f =
    ([[Text]] -> Text) -> m [[Text]] -> m Text
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ([Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ([Text] -> Text) -> ([[Text]] -> [Text]) -> [[Text]] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Text]] -> [Text]
forall a. Monoid a => [a] -> a
mconcat) (m [[Text]] -> m Text) -> (Text -> m [[Text]]) -> Text -> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, Maybe Text) -> m [Text])
-> [(Text, Maybe Text)] -> m [[Text]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Text, Maybe Text) -> m [Text]
apply
        ([(Text, Maybe Text)] -> m [[Text]])
-> (Text -> [(Text, Maybe Text)]) -> Text -> m [[Text]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Char -> Text -> [(Text, Maybe Text)]
extractDelimited Bool
withSpaces Char
delimiter
    where
    apply :: (Text, Maybe Text) -> m [Text]
apply (Text
text, Just Text
word) = do
        Text
replace <- Text -> m Text
f Text
word
        [Text] -> m [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return [Text
text, Text
replace]
    apply (Text
text, Maybe Text
Nothing) = [Text] -> m [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return [Text
text]

-- | This is more awkward than a parser, but... ok, maybe I should have used
-- a parser.
extractDelimited :: Bool -- ^ If false, a delimiter doesn't count if the text
    -- after it has a space.
    -> Char -> Text -> [(Text, Maybe Text)]
extractDelimited :: Bool -> Char -> Text -> [(Text, Maybe Text)]
extractDelimited Bool
withSpaces Char
delimiter = Text -> [(Text, Maybe Text)]
go
    where
    go :: Text -> [(Text, Maybe Text)]
go Text
text
        | Text -> Bool
Text.null Text
within Bool -> Bool -> Bool
|| Text -> Bool
Text.null Text
post = [(Text
pre Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
within, Maybe Text
forall a. Maybe a
Nothing)]
        | Bool -> Bool
not Bool
withSpaces Bool -> Bool -> Bool
&& (Char -> Bool) -> Text -> Bool
Text.any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
' ') Text
word =
            (Text
pre Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
delim, Maybe Text
forall a. Maybe a
Nothing) (Text, Maybe Text) -> [(Text, Maybe Text)] -> [(Text, Maybe Text)]
forall a. a -> [a] -> [a]
: Text -> [(Text, Maybe Text)]
go (Int -> Text -> Text
Text.drop Int
1 Text
within)
        | Bool
otherwise = (Text
pre, Text -> Maybe Text
forall a. a -> Maybe a
Just Text
word) (Text, Maybe Text) -> [(Text, Maybe Text)] -> [(Text, Maybe Text)]
forall a. a -> [a] -> [a]
: Text -> [(Text, Maybe Text)]
go (Int -> Text -> Text
Text.drop Int
1 Text
post)
        where
        (Text
pre, Text
within) = Text -> (Text, Text)
break Text
text
        (Text
word, Text
post) = Text -> (Text, Text)
break (Text -> (Text, Text)) -> Text -> (Text, Text)
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
Text.drop Int
1 Text
within
    break :: Text -> (Text, Text)
break Text
text
        | Text
"\\" Text -> Text -> Bool
`Text.isSuffixOf` Text
pre =
            (Text -> Text) -> (Text, Text) -> (Text, Text)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first ((Int -> Text -> Text
Text.take (Text -> Int
Text.length Text
pre Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Text
pre Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
delim) <>) ((Text, Text) -> (Text, Text)) -> (Text, Text) -> (Text, Text)
forall a b. (a -> b) -> a -> b
$
                Text -> (Text, Text)
break (Int -> Text -> Text
Text.drop Int
1 Text
post)
        | Bool
otherwise = (Text
pre, Text
post)
        where (Text
pre, Text
post) = Text -> Text -> (Text, Text)
Text.breakOn Text
delim Text
text
    delim :: Text
delim = Char -> Text
Text.singleton Char
delimiter

-- * interpolate

-- | Replace @${variable}@.
interpolate :: Text -> Map.Map Text Text -> Either Text Text
interpolate :: Text -> Map Text Text -> Either Text Text
interpolate Text
template Map Text Text
variables
    | Set Text
notInTemplate Set Text -> Set Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Set Text
forall a. Monoid a => a
mempty = 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
$ Text
"given variables not in template: "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
commas (Set Text -> [Text]
forall a. Set a -> [a]
Set.toList Set Text
notInTemplate)
    | Set Text
notInVariables Set Text -> Set Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Set Text
forall a. Monoid a => a
mempty = 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
$ Text
"template variable not given: "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
commas (Set Text -> [Text]
forall a. Set a -> [a]
Set.toList Set Text
notInVariables)
    | Bool
otherwise = Text -> Either Text Text
forall a b. b -> Either a b
Right (Text -> Either Text Text) -> Text -> Either Text Text
forall a b. (a -> b) -> a -> b
$ [(Text, Text)] -> Text -> Text
replaceMany
        [(Text
"${" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
k Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}", Text
v) | (Text
k, Text
v) <- Map Text Text -> [(Text, Text)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Text Text
variables] Text
template
    where
    inTemplate :: Set Text
inTemplate = [Text] -> Set Text
forall a. Ord a => [a] -> Set a
Set.fromList ([Text] -> Set Text) -> [Text] -> Set Text
forall a b. (a -> b) -> a -> b
$ ((Text, [Text]) -> [Text]) -> [(Text, [Text])] -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Text, [Text]) -> [Text]
forall a b. (a, b) -> b
snd ([(Text, [Text])] -> [Text]) -> [(Text, [Text])] -> [Text]
forall a b. (a -> b) -> a -> b
$ Regex -> Text -> [(Text, [Text])]
Regex.groups Regex
variable Text
template
    inVariables :: Set Text
inVariables = Map Text Text -> Set Text
forall k a. Map k a -> Set k
Map.keysSet Map Text Text
variables
    notInTemplate :: Set Text
notInTemplate = Set Text
inVariables Set Text -> Set Text -> Set Text
forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` Set Text
inTemplate
    notInVariables :: Set Text
notInVariables = Set Text
inTemplate Set Text -> Set Text -> Set Text
forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` Set Text
inVariables
    commas :: [Text] -> Text
commas = Text -> [Text] -> Text
Text.intercalate Text
", "
    variable :: Regex
variable = HasCallStack => String -> Regex
String -> Regex
Regex.compileUnsafe String
"\\$\\{([a-z0-9_]+)\\}"

-- * haddockUrl

type Files = Set.Set FilePath
type Url = String

-- | This doesn't really belong here, but it can't go in 'Util.Linkify' since
-- that's a main module.
haddockUrl :: Files -> FilePath -> Text -> Maybe Url
haddockUrl :: Files -> String -> Text -> Maybe String
haddockUrl Files
files String
haddockDir Text
text
    | [String] -> Bool
moduleExists [String]
components = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ [String] -> String
moduleLink [String]
components
    | [String] -> Bool
moduleExists (Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
Seq.rdrop Int
1 [String]
components) = Maybe String
symbolLink
    | Bool
otherwise = Maybe String
forall a. Maybe a
Nothing
    where
    components :: [String]
components = (Text -> String) -> [Text] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Text -> String
Text.unpack ([Text] -> [String]) -> [Text] -> [String]
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> [Text]
Text.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'.') Text
text
    moduleExists :: [String] -> Bool
moduleExists [String]
path = String -> Bool
exists ([String] -> String
FilePath.joinPath [String]
path String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".hs")
        Bool -> Bool -> Bool
|| String -> Bool
exists ([String] -> String
FilePath.joinPath [String]
path String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".hsc")
    exists :: String -> Bool
exists = (String -> Files -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Files
files)

    moduleLink :: [String] -> String
moduleLink [String]
path = String -> String
strip (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
haddockDir String -> String -> String
</> String -> [String] -> String
forall a. Monoid a => a -> [a] -> a
Seq.join String
"-" [String]
path String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".html"
    strip :: String -> String
strip (Char
'.' : Char
'/' : String
path) = String
path
    strip String
path = String
path
    symbolLink :: Maybe String
symbolLink = case [String] -> Maybe ([String], String)
forall a. [a] -> Maybe ([a], a)
Seq.viewr [String]
components of
        Just ([String]
mod, String
sym) -> String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ [String] -> String
moduleLink [String]
mod String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
symbolAnchor String
sym
        Maybe ([String], String)
Nothing -> Maybe String
forall a. Maybe a
Nothing

symbolAnchor :: String -> String
symbolAnchor :: String -> String
symbolAnchor String
sym = case String
sym of
    Char
c : String
_ | Char -> Bool
Char.isUpper Char
c -> String
"#t:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
sym
    String
_ -> String
"#v:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
sym