-- 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

{- | Turn single quoted strings into links to haddock docs, depending on
    whether the module can be found or not.

    E.g., @\'Derive.Score.Event\'@ becomes
    @[Derive.Score.Event](build/doc/Derive-Score.html#t:Event)@
    and @\'Derive.Score\'@ becomes
    @[Derive.Score](build/doc/Derive-Score.html)@.
-}
module Util.Linkify (main) where
import qualified Data.Char as Char
import qualified Data.Set as Set
import qualified Data.Text as Text
import qualified Data.Text.IO as Text.IO

import qualified System.Environment as Environment
import qualified System.IO as IO

import qualified Util.Files as Files
import qualified Util.Lists as Lists
import qualified Util.Logger as Logger
import qualified Util.Texts as Texts

import           Global


main :: IO ()
main :: IO ()
main = do
    [FilePath]
args <- IO [FilePath]
Environment.getArgs
    case [FilePath]
args of
        [FilePath
haddock_dir, FilePath
input] ->
            Text -> IO ()
Text.IO.putStr forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FilePath -> FilePath -> Text -> IO Text
linkify FilePath
haddock_dir FilePath
input
                forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FilePath -> IO Text
Text.IO.readFile FilePath
input
        [FilePath]
_ -> FilePath -> IO ()
putStrLn FilePath
"usage: linkify path/to/haddock/dir doc/text"

linkify :: FilePath -> FilePath -> Text -> IO Text
linkify :: FilePath -> FilePath -> Text -> IO Text
linkify FilePath
haddock_dir FilePath
input_file Text
text = do
    Files
files <- FilePath -> IO Files
get_files FilePath
"."
    let (Text
out, [Text]
logs) = forall w a. Logger w a -> (a, [w])
Logger.runId forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
Monad m =>
Bool -> Char -> (Text -> m Text) -> Text -> m Text
Texts.mapDelimitedM Bool
False Char
'\''
            (Files -> FilePath -> Text -> Logger Text Text
link_quoted Files
files FilePath
haddock_dir) Text
text
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
logs) forall a b. (a -> b) -> a -> b
$
        Handle -> Text -> IO ()
Text.IO.hPutStrLn Handle
IO.stderr forall a b. (a -> b) -> a -> b
$ Text
"** " forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
txt FilePath
input_file
            forall a. Semigroup a => a -> a -> a
<> Text
": broken link: " forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
Text.intercalate Text
", " [Text]
logs
    forall (m :: * -> *) a. Monad m => a -> m a
return Text
out

get_files :: FilePath -> IO Texts.Files
get_files :: FilePath -> IO Files
get_files FilePath
dir = do
    [FilePath]
files <- (FilePath -> Bool) -> FilePath -> IO [FilePath]
Files.listRecursive (forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False Char -> Bool
Char.isUpper forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Maybe a
Lists.head) FilePath
dir
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Ord a => [a] -> Set a
Set.fromList [FilePath]
files

link_quoted :: Texts.Files -> FilePath -> Text -> Logger.Logger Text Text
link_quoted :: Files -> FilePath -> Text -> Logger Text Text
link_quoted Files
files FilePath
haddock_dir Text
text
    | Text -> Bool
looks_like_link Text
text = case Files -> FilePath -> Text -> Maybe FilePath
Texts.haddockUrl Files
files FilePath
haddock_dir Text
text of
        Maybe FilePath
Nothing -> do
            forall w (m :: * -> *). MonadLogger w m => w -> m ()
Logger.log Text
text
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text
"'" forall a. Semigroup a => a -> a -> a
<> Text
text forall a. Semigroup a => a -> a -> a
<> Text
"'"
        Just FilePath
url -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> FilePath -> Text
markdown_link Text
text FilePath
url
    | Bool
otherwise = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text
"'" forall a. Semigroup a => a -> a -> a
<> Text
text forall a. Semigroup a => a -> a -> a
<> Text
"'"

looks_like_link :: Text -> Bool
looks_like_link :: Text -> Bool
looks_like_link Text
text =
    Text
"." Text -> Text -> Bool
`Text.isInfixOf` Text
text Bool -> Bool -> Bool
&& Char -> Bool
Char.isUpper (HasCallStack => Text -> Char
Text.head Text
text)

markdown_link :: Text -> String -> Text
markdown_link :: Text -> FilePath -> Text
markdown_link Text
text FilePath
url = Text
"[" forall a. Semigroup a => a -> a -> a
<> Text
text forall a. Semigroup a => a -> a -> a
<> Text
"](" forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
Text.pack FilePath
url forall a. Semigroup a => a -> a -> a
<> Text
")"