-- | Functions to access to the SC3 RTF & HTML based help systems.
module Sound.SC3.Common.Help where

import Control.Monad {- base -}
import Data.Char {- base -}
import Data.Maybe {- base -}
import System.Environment {- base -}
import System.FilePath {- filepath -}
import System.Process {- process -}

import qualified Data.List.Split as Split {- split -}

import qualified Sound.SC3.Common.Base as Base {- hsc3 -}

-- * RTF

-- | Directory containing SC3 RTF help files.
sc3_rtf_help_dir :: IO FilePath
sc3_rtf_help_dir :: IO FilePath
sc3_rtf_help_dir = FilePath -> IO FilePath
getEnv FilePath
"SC3_RTF_HELP_DIR"

{- | Find (case-insensitively) indicated file at 'sc3_rtf_help_dir'.
     Runs the command "find -name" (so UNIX only).

> sc3_rtf_find_file "SinOsc.help.rtf"
> sc3_rtf_find_file "lfsaw.help.rtf"
> sc3_rtf_find_file "softClip.rtf"
-}
sc3_rtf_find_file :: FilePath -> IO (Maybe FilePath)
sc3_rtf_find_file :: FilePath -> IO (Maybe FilePath)
sc3_rtf_find_file FilePath
fn = do
  FilePath
d <- IO FilePath
sc3_rtf_help_dir
  FilePath
r <- FilePath -> [FilePath] -> FilePath -> IO FilePath
System.Process.readProcess FilePath
"find" [FilePath
d,FilePath
"-iname",FilePath
fn] FilePath
""
  case FilePath -> [FilePath]
lines FilePath
r of
    [] -> Maybe FilePath -> IO (Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FilePath
forall a. Maybe a
Nothing
    [FilePath
r0] -> Maybe FilePath -> IO (Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
r0)
    [FilePath]
_ -> FilePath -> IO (Maybe FilePath)
forall a. HasCallStack => FilePath -> a
error FilePath
"sc3_rtf_find_file: multiple files?"

-- | 'error' variant.
sc3_rtf_find_file_err :: FilePath -> IO FilePath
sc3_rtf_find_file_err :: FilePath -> IO FilePath
sc3_rtf_find_file_err = (Maybe FilePath -> FilePath) -> IO (Maybe FilePath) -> IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FilePath -> Maybe FilePath -> FilePath
forall a. a -> Maybe a -> a
fromMaybe (FilePath -> FilePath
forall a. HasCallStack => FilePath -> a
error FilePath
"sc3_rtf_find_file")) (IO (Maybe FilePath) -> IO FilePath)
-> (FilePath -> IO (Maybe FilePath)) -> FilePath -> IO FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO (Maybe FilePath)
sc3_rtf_find_file

-- | Run the command unrtf (so UNIX only) to convert an RTF file to a TEXT (.scd) file.
sc3_rtf_to_scd :: FilePath -> FilePath -> IO ()
sc3_rtf_to_scd :: FilePath -> FilePath -> IO ()
sc3_rtf_to_scd FilePath
rtf_fn FilePath
scd_fn = do
  FilePath
txt <- FilePath -> [FilePath] -> FilePath -> IO FilePath
System.Process.readProcess FilePath
"unrtf" [FilePath
"--text",FilePath
rtf_fn] FilePath
""
  let delete_trailing_whitespace :: FilePath -> FilePath
delete_trailing_whitespace = FilePath -> FilePath
forall a. [a] -> [a]
reverse (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
forall a. [a] -> [a]
reverse
      tidy :: FilePath -> FilePath
tidy = [FilePath] -> FilePath
unlines ([FilePath] -> FilePath)
-> (FilePath -> [FilePath]) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> FilePath
delete_trailing_whitespace ([FilePath] -> [FilePath])
-> (FilePath -> [FilePath]) -> FilePath -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [FilePath] -> [FilePath]
forall a. Int -> [a] -> [a]
drop Int
4 ([FilePath] -> [FilePath])
-> (FilePath -> [FilePath]) -> FilePath -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
lines
  FilePath -> FilePath -> IO ()
writeFile FilePath
scd_fn (FilePath -> FilePath
tidy FilePath
txt)

-- | 'sc3_rtf_to_scd' of 'sc3_rtf_find_file_err', writing output to TMPDIR
sc3_rtf_help_translate :: String -> IO FilePath
sc3_rtf_help_translate :: FilePath -> IO FilePath
sc3_rtf_help_translate FilePath
nm = do
  FilePath
tmp <- FilePath -> FilePath -> IO FilePath
Base.get_env_default FilePath
"TMPDIR" FilePath
"/tmp"
  FilePath
rtf_fn <- FilePath -> IO FilePath
sc3_rtf_find_file_err (FilePath
nm FilePath -> FilePath -> FilePath
<.> FilePath
"*rtf")
  let scd_fn :: FilePath
scd_fn = FilePath
tmp FilePath -> FilePath -> FilePath
</> FilePath -> FilePath
takeFileName FilePath
rtf_fn FilePath -> FilePath -> FilePath
-<.> FilePath
"scd"
  FilePath -> FilePath -> IO ()
sc3_rtf_to_scd FilePath
rtf_fn FilePath
scd_fn
  FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
scd_fn

-- | 'sc3_rtf_help_translate' and run editor.
sc3_rtf_help_scd_open :: (String,[String]) -> String -> IO ()
sc3_rtf_help_scd_open :: (FilePath, [FilePath]) -> FilePath -> IO ()
sc3_rtf_help_scd_open (FilePath
cmd,[FilePath]
arg) FilePath
nm = do
  FilePath
scd_fn <- FilePath -> IO FilePath
sc3_rtf_help_translate FilePath
nm
  FilePath -> [FilePath] -> IO ()
System.Process.callProcess FilePath
cmd ([FilePath]
arg [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
scd_fn])

-- | 'sc3_rtf_help_scd_open' with emacsclient --no-wait.
--
-- > sc3_rtf_help_scd_open_emacs "lfsaw"
sc3_rtf_help_scd_open_emacs :: String -> IO ()
sc3_rtf_help_scd_open_emacs :: FilePath -> IO ()
sc3_rtf_help_scd_open_emacs = (FilePath, [FilePath]) -> FilePath -> IO ()
sc3_rtf_help_scd_open (FilePath
"emacsclient",[FilePath
"--no-wait"])

-- * SC-DOC

-- | URL for online SC-DOC SuperCollider documentation.
sc3_scdoc_help_url :: String
sc3_scdoc_help_url :: FilePath
sc3_scdoc_help_url = FilePath
"http://doc.sccode.org/"

-- | Read the environment variable @SC3_SCDOC_HTML_HELP_DIR@.
--   The default value is @~\/.local\/share\/SuperCollider/Help@.
sc3_scdoc_help_dir :: IO String
sc3_scdoc_help_dir :: IO FilePath
sc3_scdoc_help_dir = do
  FilePath
h <- FilePath -> IO FilePath
getEnv FilePath
"HOME"
  let d :: FilePath
d = FilePath
h FilePath -> FilePath -> FilePath
</> FilePath
".local/share/SuperCollider/Help"
  FilePath -> FilePath -> IO FilePath
Base.get_env_default FilePath
"SC3_SCDOC_HTML_HELP_DIR" FilePath
d

-- | Path to indicated SC3 class help file.
--
-- > sc3_scdoc_help_class "SinOsc" == "Classes/SinOsc.html"
sc3_scdoc_help_class :: String -> String
sc3_scdoc_help_class :: FilePath -> FilePath
sc3_scdoc_help_class FilePath
c = FilePath
"Classes" FilePath -> FilePath -> FilePath
</> FilePath
c FilePath -> FilePath -> FilePath
<.> FilePath
"html"

-- | Generate path to indicated SC3 operator help file.
--
-- > sc3_scdoc_help_operator "+" == "Overviews/Operators.html#+"
sc3_scdoc_help_operator :: String -> FilePath
sc3_scdoc_help_operator :: FilePath -> FilePath
sc3_scdoc_help_operator = FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
(++) FilePath
"Overviews/Operators.html#"

-- | Generate path to indicated SC3 method help.
--
-- > sc3_scdoc_help_method '*' ("C","m") == "Classes/C.html#*m"
sc3_scdoc_help_method :: Char -> (String,String) -> FilePath
sc3_scdoc_help_method :: Char -> (FilePath, FilePath) -> FilePath
sc3_scdoc_help_method Char
z (FilePath
c,FilePath
m) = FilePath
"Classes" FilePath -> FilePath -> FilePath
</> FilePath
c FilePath -> FilePath -> FilePath
<.> FilePath
"html#" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ [Char
z] FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
m

-- | Generate path to indicated SC3 class method help.
--
-- > sc3_scdoc_help_class_method ("C","m") == "Classes/C.html#*m"
sc3_scdoc_help_class_method :: (String,String) -> FilePath
sc3_scdoc_help_class_method :: (FilePath, FilePath) -> FilePath
sc3_scdoc_help_class_method = Char -> (FilePath, FilePath) -> FilePath
sc3_scdoc_help_method Char
'*'

-- | Generate path to indicated SC3 instance method help.
--
-- > sc3_scdoc_help_instance_method ("C","m") == "Classes/C.html#-m"
sc3_scdoc_help_instance_method :: (String,String) -> FilePath
sc3_scdoc_help_instance_method :: (FilePath, FilePath) -> FilePath
sc3_scdoc_help_instance_method = Char -> (FilePath, FilePath) -> FilePath
sc3_scdoc_help_method Char
'-'

{- | SC3 help path documenting x.

> sc3_scdoc_help_path "Operator.distort" == "Overviews/Operators.html#.distort"
> sc3_scdoc_help_path "Collection.*fill" == "Classes/Collection.html#*fill"
> sc3_scdoc_help_path "Collection.inject" == "Classes/Collection.html#-inject"
> sc3_scdoc_help_path "SinOsc" == "Classes/SinOsc.html"
-}
sc3_scdoc_help_path :: String -> String
sc3_scdoc_help_path :: FilePath -> FilePath
sc3_scdoc_help_path FilePath
s = do
  case FilePath -> FilePath -> [FilePath]
forall a. Eq a => [a] -> [a] -> [[a]]
Split.splitOn FilePath
"." FilePath
s of
    [FilePath
"Operator",FilePath
m] -> FilePath -> FilePath
sc3_scdoc_help_operator FilePath
m
    [FilePath
c,Char
'*':FilePath
m] -> (FilePath, FilePath) -> FilePath
sc3_scdoc_help_class_method (FilePath
c,FilePath
m)
    [FilePath
c,FilePath
m] -> (FilePath, FilePath) -> FilePath
sc3_scdoc_help_instance_method (FilePath
c,FilePath
m)
    [FilePath]
_ -> FilePath -> FilePath
sc3_scdoc_help_class FilePath
s

{- | Open SC3 help path, either the local file or the online version.
     Use @BROWSER@ or @x-www-browser@.

> Base.get_env_default "BROWSER" "x-www-browser"

> sc3_scdoc_help_open True (sc3_scdoc_help_path "SinOsc")
> sc3_scdoc_help_open True (sc3_scdoc_help_path "Collection.*fill")
> sc3_scdoc_help_open False (sc3_scdoc_help_path "Collection.inject")
-}
sc3_scdoc_help_open :: Bool -> String -> IO ()
sc3_scdoc_help_open :: Bool -> FilePath -> IO ()
sc3_scdoc_help_open Bool
use_loc FilePath
p = do
  FilePath
d <- IO FilePath
sc3_scdoc_help_dir
  FilePath
b <- FilePath -> FilePath -> IO FilePath
Base.get_env_default FilePath
"BROWSER" FilePath
"x-www-browser"
  let u :: FilePath
u = if Bool
use_loc then FilePath
"file://" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (FilePath
d FilePath -> FilePath -> FilePath
</> FilePath
p) else FilePath
sc3_scdoc_help_url FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
p
  IO ExitCode -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (FilePath -> [FilePath] -> IO ExitCode
System.Process.rawSystem FilePath
b [FilePath
u])

{- | Generate path to indicated SC3 instance method help.
     Adds initial forward slash if not present.

> let r = "Reference/Server-Command-Reference.html#/b_alloc"
> sc3_scdoc_help_server_command_path "b_alloc" == r

-}
sc3_scdoc_help_server_command_path :: String -> FilePath
sc3_scdoc_help_server_command_path :: FilePath -> FilePath
sc3_scdoc_help_server_command_path FilePath
c =
    let c' :: FilePath
c' = case FilePath
c of
               Char
'/':FilePath
_ -> FilePath
c
               FilePath
_ -> Char
'/'Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:FilePath
c
    in FilePath
"Reference/Server-Command-Reference.html" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (Char
'#' Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: FilePath
c')

{- | 'sc3_scdoc_help_open' of 'sc3_server_command_path'

> sc3_scdoc_help_server_command_open True "s_new"
> sc3_scdoc_help_server_command_open False "/b_allocRead"
-}
sc3_scdoc_help_server_command_open :: Bool -> String -> IO ()
sc3_scdoc_help_server_command_open :: Bool -> FilePath -> IO ()
sc3_scdoc_help_server_command_open Bool
use_loc =
  Bool -> FilePath -> IO ()
sc3_scdoc_help_open Bool
use_loc (FilePath -> IO ()) -> (FilePath -> FilePath) -> FilePath -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  FilePath -> FilePath
sc3_scdoc_help_server_command_path