-- | 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.List {- 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.System as Base.System {- hsc3 -}

-- * Rtf

-- | Directory containing Sc3 Rtf help files.
sc3_rtf_help_dir :: IO FilePath
sc3_rtf_help_dir :: IO String
sc3_rtf_help_dir = String -> IO String
getEnv String
"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 :: String -> IO (Maybe String)
sc3_rtf_find_file String
fn = do
  String
d <- IO String
sc3_rtf_help_dir
  String
r <- String -> [String] -> String -> IO String
System.Process.readProcess String
"find" [String
d,String
"-iname",String
fn] String
""
  case String -> [String]
lines String
r of
    [] -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
    [String
r0] -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just String
r0)
    [String]
_ -> forall a. HasCallStack => String -> a
error String
"sc3_rtf_find_file: multiple files?"

-- | 'error' variant.
sc3_rtf_find_file_err :: FilePath -> IO FilePath
sc3_rtf_find_file_err :: String -> IO String
sc3_rtf_find_file_err = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error String
"sc3_rtf_find_file")) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO (Maybe String)
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 :: String -> String -> IO ()
sc3_rtf_to_scd String
rtf_fn String
scd_fn = do
  String
txt <- String -> [String] -> String -> IO String
System.Process.readProcess String
"unrtf" [String
"--text",String
rtf_fn] String
""
  let delete_trailing_whitespace :: String -> String
delete_trailing_whitespace = forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse
      tidy :: String -> String
tidy = [String] -> String
unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map String -> String
delete_trailing_whitespace forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
drop Int
4 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines
  String -> String -> IO ()
writeFile String
scd_fn (String -> String
tidy String
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 :: String -> IO String
sc3_rtf_help_translate String
nm = do
  String
tmp <- String -> String -> IO String
Base.System.get_env_default String
"TMPDIR" String
"/tmp"
  String
rtf_fn <- String -> IO String
sc3_rtf_find_file_err (String
nm String -> String -> String
<.> String
"*rtf")
  let scd_fn :: String
scd_fn = String
tmp String -> String -> String
</> String -> String
takeFileName String
rtf_fn String -> String -> String
-<.> String
"scd"
  String -> String -> IO ()
sc3_rtf_to_scd String
rtf_fn String
scd_fn
  forall (m :: * -> *) a. Monad m => a -> m a
return String
scd_fn

-- | 'sc3_rtf_help_translate' and run editor.
sc3_rtf_help_scd_open :: (String,[String]) -> String -> IO ()
sc3_rtf_help_scd_open :: (String, [String]) -> String -> IO ()
sc3_rtf_help_scd_open (String
cmd,[String]
arg) String
nm = do
  String
scd_fn <- String -> IO String
sc3_rtf_help_translate String
nm
  String -> [String] -> IO ()
System.Process.callProcess String
cmd ([String]
arg forall a. [a] -> [a] -> [a]
++ [String
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 :: String -> IO ()
sc3_rtf_help_scd_open_emacs = (String, [String]) -> String -> IO ()
sc3_rtf_help_scd_open (String
"emacsclient",[String
"--no-wait"])

-- * Sc-Doc (Html)

-- | Url for online Sc-Doc SuperCollider documentation.
sc3_scdoc_help_url :: String
sc3_scdoc_help_url :: String
sc3_scdoc_help_url = String
"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 String
sc3_scdoc_help_dir = do
  String
h <- String -> IO String
getEnv String
"HOME"
  let d :: String
d = String
h String -> String -> String
</> String
".local/share/SuperCollider/Help"
  String -> String -> IO String
Base.System.get_env_default String
"SC3_SCDOC_HTML_HELP_DIR" String
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 :: String -> String
sc3_scdoc_help_class String
c = String
"Classes" String -> String -> String
</> String
c String -> String -> String
<.> String
"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 :: String -> String
sc3_scdoc_help_operator = forall a. [a] -> [a] -> [a]
(++) String
"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 -> (String, String) -> String
sc3_scdoc_help_method Char
z (String
c,String
m) = String
"Classes" String -> String -> String
</> String
c String -> String -> String
<.> String
"html#" forall a. [a] -> [a] -> [a]
++ [Char
z] forall a. [a] -> [a] -> [a]
++ String
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 :: (String, String) -> String
sc3_scdoc_help_class_method = Char -> (String, String) -> String
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 :: (String, String) -> String
sc3_scdoc_help_instance_method = Char -> (String, String) -> String
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 :: String -> String
sc3_scdoc_help_path String
s = do
  case forall a. Eq a => [a] -> [a] -> [[a]]
Split.splitOn String
"." String
s of
    [String
"Operator",String
m] -> String -> String
sc3_scdoc_help_operator String
m
    [String
c,Char
'*':String
m] -> (String, String) -> String
sc3_scdoc_help_class_method (String
c,String
m)
    [String
c,String
m] -> (String, String) -> String
sc3_scdoc_help_instance_method (String
c,String
m)
    [String]
_ -> String -> String
sc3_scdoc_help_class String
s

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

> Base.System.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 -> String -> IO ()
sc3_scdoc_help_open Bool
use_loc String
p = do
  String
d <- IO String
sc3_scdoc_help_dir
  String
b <- String -> String -> IO String
Base.System.get_env_default String
"BROWSER" String
"x-www-browser"
  let u :: String
u = if Bool
use_loc then String
"file://" forall a. [a] -> [a] -> [a]
++ (String
d String -> String -> String
</> String
p) else String
sc3_scdoc_help_url forall a. [a] -> [a] -> [a]
++ String
p
  forall (f :: * -> *) a. Functor f => f a -> f ()
void (String -> [String] -> IO ExitCode
System.Process.rawSystem String
b [String
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 :: String -> String
sc3_scdoc_help_server_command_path String
c =
    let c' :: String
c' = case String
c of
               Char
'/':String
_ -> String
c
               String
_ -> Char
'/'forall a. a -> [a] -> [a]
:String
c
    in String
"Reference/Server-Command-Reference.html" forall a. [a] -> [a] -> [a]
++ (Char
'#' forall a. a -> [a] -> [a]
: String
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 -> String -> IO ()
sc3_scdoc_help_server_command_open Bool
use_loc =
  Bool -> String -> IO ()
sc3_scdoc_help_open Bool
use_loc forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  String -> String
sc3_scdoc_help_server_command_path

-- * Fragments

-- | Apply function at lines of string.
on_lines_of :: ([String] -> [[String]]) -> String -> [String]
on_lines_of :: ([String] -> [[String]]) -> String -> [String]
on_lines_of [String] -> [[String]]
f = forall a b. (a -> b) -> [a] -> [b]
map [String] -> String
unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [[String]]
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines

{- | Split text into fragments at empty lines.
Hsc3 (and related projects) write help files as sets of distinct fragments.
Fragments are separated by empty lines.
A line containing the special character sequence ---- indicates the end of the fragments.

> on_lines_of split_multiple_fragments ";a\nb\n\n\n;c\nd" == [";a\nb\n",";c\nd\n"]
-}
split_multiple_fragments :: [String] -> [[String]]
split_multiple_fragments :: [String] -> [[String]]
split_multiple_fragments = forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => [a] -> [a] -> [[a]]
Split.splitOn [[]]

-- | The text ---- indicates the end of graph fragments.
drop_post_graph_section :: [String] -> [String]
drop_post_graph_section :: [String] -> [String]
drop_post_graph_section = forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => [a] -> [a] -> Bool
isInfixOf String
"----")

-- | Read text fragments from file.
read_file_fragments :: FilePath -> IO [String]
read_file_fragments :: String -> IO [String]
read_file_fragments = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([String] -> [[String]]) -> String -> [String]
on_lines_of ([String] -> [[String]]
split_multiple_fragments forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
drop_post_graph_section)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO String
readFile

-- | Read text fragments from set of files.
read_file_set_fragments :: [FilePath] -> IO [String]
read_file_set_fragments :: [String] -> IO [String]
read_file_set_fragments = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> IO [String]
read_file_fragments