-- | 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
    [] -> Maybe String -> IO (Maybe String)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing
    [String
r0] -> Maybe String -> IO (Maybe String)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Maybe String
forall a. a -> Maybe a
Just String
r0)
    [String]
_ -> String -> IO (Maybe 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 = (Maybe String -> String) -> IO (Maybe String) -> IO String
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe (String -> String
forall a. HasCallStack => String -> a
error String
"sc3_rtf_find_file")) (IO (Maybe String) -> IO String)
-> (String -> IO (Maybe String)) -> String -> IO String
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 = String -> String
forall a. [a] -> [a]
reverse (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. [a] -> [a]
reverse
      tidy :: String -> String
tidy = [String] -> String
unlines ([String] -> String) -> (String -> [String]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
delete_trailing_whitespace ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop Int
4 ([String] -> [String])
-> (String -> [String]) -> String -> [String]
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
  String -> IO String
forall a. a -> IO a
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 [String] -> [String] -> [String]
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 = String -> String -> String
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#" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
z] String -> String -> String
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 String -> String -> [String]
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://" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (String
d String -> String -> String
</> String
p) else String
sc3_scdoc_help_url String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
p
  IO ExitCode -> IO ()
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
'/' Char -> String -> String
forall a. a -> [a] -> [a]
: String
c
  in String
"Reference/Server-Command-Reference.html" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Char
'#' Char -> String -> String
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
    (String -> IO ()) -> (String -> String) -> String -> IO ()
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 = ([String] -> String) -> [[String]] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map [String] -> String
unlines ([[String]] -> [String])
-> (String -> [[String]]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [[String]]
f ([String] -> [[String]])
-> (String -> [String]) -> String -> [[String]]
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 = ([String] -> Bool) -> [[String]] -> [[String]]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> ([String] -> Bool) -> [String] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ([[String]] -> [[String]])
-> ([String] -> [[String]]) -> [String] -> [[String]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String] -> [[String]]
forall a. Eq a => [a] -> [a] -> [[a]]
Split.splitOn [[]]

{- | The text '----' appearing anywhere in a line indicates the end of the graph fragments.
The text '# ' appearing at the start of a line also indicates the end of the graph fragments.

>>> drop_post_graph_section ["a","b","c","","----d","e","f"]
["a","b","c",""]

>>> drop_post_graph_section ["a","b","c","","----d","# e","","f"]
["a","b","c",""]
-}
drop_post_graph_section :: [String] -> [String]
drop_post_graph_section :: [String] -> [String]
drop_post_graph_section =
  let isEnd :: String -> Bool
isEnd String
x = String
"----" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` String
x Bool -> Bool -> Bool
|| String
"# " String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
x
  in (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
isEnd)

{- | Some help files are in Markdown format.
These are recognised by examing the first two characters, which must be a '#' and ' '.
-}
is_md_help :: String -> Bool
is_md_help :: String -> Bool
is_md_help String
x =
  case String
x of
    Char
'#' : Char
' ' : String
_ -> Bool
True
    String
_ -> Bool
False

{- | There are two code block formats in markdown help files.
The first indents the block using a single tab or four spaces.
The second marks the start and end of the block by lines starting with three back ticks (`).

See:
<https://spec.commonmark.org/0.30/#indented-code-blocks>
and
<https://spec.commonmark.org/0.30/#fenced-code-blocks>
-}
data CodeBlockType = IndentedCodeBlock | FencedCodeBlock
  deriving (CodeBlockType
CodeBlockType -> CodeBlockType -> Bounded CodeBlockType
forall a. a -> a -> Bounded a
$cminBound :: CodeBlockType
minBound :: CodeBlockType
$cmaxBound :: CodeBlockType
maxBound :: CodeBlockType
Bounded, Int -> CodeBlockType
CodeBlockType -> Int
CodeBlockType -> [CodeBlockType]
CodeBlockType -> CodeBlockType
CodeBlockType -> CodeBlockType -> [CodeBlockType]
CodeBlockType -> CodeBlockType -> CodeBlockType -> [CodeBlockType]
(CodeBlockType -> CodeBlockType)
-> (CodeBlockType -> CodeBlockType)
-> (Int -> CodeBlockType)
-> (CodeBlockType -> Int)
-> (CodeBlockType -> [CodeBlockType])
-> (CodeBlockType -> CodeBlockType -> [CodeBlockType])
-> (CodeBlockType -> CodeBlockType -> [CodeBlockType])
-> (CodeBlockType
    -> CodeBlockType -> CodeBlockType -> [CodeBlockType])
-> Enum CodeBlockType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: CodeBlockType -> CodeBlockType
succ :: CodeBlockType -> CodeBlockType
$cpred :: CodeBlockType -> CodeBlockType
pred :: CodeBlockType -> CodeBlockType
$ctoEnum :: Int -> CodeBlockType
toEnum :: Int -> CodeBlockType
$cfromEnum :: CodeBlockType -> Int
fromEnum :: CodeBlockType -> Int
$cenumFrom :: CodeBlockType -> [CodeBlockType]
enumFrom :: CodeBlockType -> [CodeBlockType]
$cenumFromThen :: CodeBlockType -> CodeBlockType -> [CodeBlockType]
enumFromThen :: CodeBlockType -> CodeBlockType -> [CodeBlockType]
$cenumFromTo :: CodeBlockType -> CodeBlockType -> [CodeBlockType]
enumFromTo :: CodeBlockType -> CodeBlockType -> [CodeBlockType]
$cenumFromThenTo :: CodeBlockType -> CodeBlockType -> CodeBlockType -> [CodeBlockType]
enumFromThenTo :: CodeBlockType -> CodeBlockType -> CodeBlockType -> [CodeBlockType]
Enum, CodeBlockType -> CodeBlockType -> Bool
(CodeBlockType -> CodeBlockType -> Bool)
-> (CodeBlockType -> CodeBlockType -> Bool) -> Eq CodeBlockType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CodeBlockType -> CodeBlockType -> Bool
== :: CodeBlockType -> CodeBlockType -> Bool
$c/= :: CodeBlockType -> CodeBlockType -> Bool
/= :: CodeBlockType -> CodeBlockType -> Bool
Eq, ReadPrec [CodeBlockType]
ReadPrec CodeBlockType
Int -> ReadS CodeBlockType
ReadS [CodeBlockType]
(Int -> ReadS CodeBlockType)
-> ReadS [CodeBlockType]
-> ReadPrec CodeBlockType
-> ReadPrec [CodeBlockType]
-> Read CodeBlockType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS CodeBlockType
readsPrec :: Int -> ReadS CodeBlockType
$creadList :: ReadS [CodeBlockType]
readList :: ReadS [CodeBlockType]
$creadPrec :: ReadPrec CodeBlockType
readPrec :: ReadPrec CodeBlockType
$creadListPrec :: ReadPrec [CodeBlockType]
readListPrec :: ReadPrec [CodeBlockType]
Read, Int -> CodeBlockType -> String -> String
[CodeBlockType] -> String -> String
CodeBlockType -> String
(Int -> CodeBlockType -> String -> String)
-> (CodeBlockType -> String)
-> ([CodeBlockType] -> String -> String)
-> Show CodeBlockType
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> CodeBlockType -> String -> String
showsPrec :: Int -> CodeBlockType -> String -> String
$cshow :: CodeBlockType -> String
show :: CodeBlockType -> String
$cshowList :: [CodeBlockType] -> String -> String
showList :: [CodeBlockType] -> String -> String
Show)

-- | Get code blocks from Markdown help file.
md_help_get_code_blocks :: [String] -> [(CodeBlockType, [String])]
md_help_get_code_blocks :: [String] -> [(CodeBlockType, [String])]
md_help_get_code_blocks [String]
x =
  case [String]
x of
    [] -> []
    String
"```" : [String]
x' ->
      let ([String]
q, [String]
x'') = (String -> Bool) -> [String] -> ([String], [String])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"```") [String]
x'
      in (CodeBlockType
FencedCodeBlock, [String]
q) (CodeBlockType, [String])
-> [(CodeBlockType, [String])] -> [(CodeBlockType, [String])]
forall a. a -> [a] -> [a]
: [String] -> [(CodeBlockType, [String])]
md_help_get_code_blocks (Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop Int
1 [String]
x'')
    (Char
'\t' : String
_) : [String]
_ ->
      let ([String]
q, [String]
x') = (String -> Bool) -> [String] -> ([String], [String])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(==) [Char
'\t'] (String -> Bool) -> (String -> String) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1) [String]
x
      in (CodeBlockType
IndentedCodeBlock, ((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
1) [String]
q)) (CodeBlockType, [String])
-> [(CodeBlockType, [String])] -> [(CodeBlockType, [String])]
forall a. a -> [a] -> [a]
: [String] -> [(CodeBlockType, [String])]
md_help_get_code_blocks [String]
x'
    String
_ : [String]
x' ->
      [String] -> [(CodeBlockType, [String])]
md_help_get_code_blocks [String]
x'

is_doctest_block :: [String] -> Bool
is_doctest_block :: [String] -> Bool
is_doctest_block =
  let f :: [a] -> [a] -> Bool
f [a]
x [a]
p = [a]
p [a] -> [a] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [a]
x
  in (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\String
x -> String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
f String
x String
">>> " Bool -> Bool -> Bool
|| String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
f String
x String
">> ")

md_help_get_tab_indented_code_blocks :: [String] -> [[String]]
md_help_get_tab_indented_code_blocks :: [String] -> [[String]]
md_help_get_tab_indented_code_blocks =
  ([String] -> Bool) -> [[String]] -> [[String]]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> ([String] -> Bool) -> [String] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Bool
is_doctest_block)
    ([[String]] -> [[String]])
-> ([String] -> [[String]]) -> [String] -> [[String]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((CodeBlockType, [String]) -> [String])
-> [(CodeBlockType, [String])] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
map (CodeBlockType, [String]) -> [String]
forall a b. (a, b) -> b
snd
    ([(CodeBlockType, [String])] -> [[String]])
-> ([String] -> [(CodeBlockType, [String])])
-> [String]
-> [[String]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((CodeBlockType, [String]) -> Bool)
-> [(CodeBlockType, [String])] -> [(CodeBlockType, [String])]
forall a. (a -> Bool) -> [a] -> [a]
filter ((CodeBlockType -> CodeBlockType -> Bool
forall a. Eq a => a -> a -> Bool
== CodeBlockType
IndentedCodeBlock) (CodeBlockType -> Bool)
-> ((CodeBlockType, [String]) -> CodeBlockType)
-> (CodeBlockType, [String])
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CodeBlockType, [String]) -> CodeBlockType
forall a b. (a, b) -> a
fst)
    ([(CodeBlockType, [String])] -> [(CodeBlockType, [String])])
-> ([String] -> [(CodeBlockType, [String])])
-> [String]
-> [(CodeBlockType, [String])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [(CodeBlockType, [String])]
md_help_get_code_blocks

{- | Get indented code blocks from Markdown help file.

>>> s <- readFile "/home/rohan/sw/spl/Help/Reference/AllpassC.help.sl"
>>> is_md_help s
True

>>> let b = md_help_get_fenced_code_blocks (lines s)
>>> length b
3
-}
md_help_get_fenced_code_blocks :: [String] -> [[String]]
md_help_get_fenced_code_blocks :: [String] -> [[String]]
md_help_get_fenced_code_blocks =
  ([String] -> Bool) -> [[String]] -> [[String]]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> ([String] -> Bool) -> [String] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Bool
is_doctest_block)
    ([[String]] -> [[String]])
-> ([String] -> [[String]]) -> [String] -> [[String]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((CodeBlockType, [String]) -> [String])
-> [(CodeBlockType, [String])] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
map (CodeBlockType, [String]) -> [String]
forall a b. (a, b) -> b
snd
    ([(CodeBlockType, [String])] -> [[String]])
-> ([String] -> [(CodeBlockType, [String])])
-> [String]
-> [[String]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((CodeBlockType, [String]) -> Bool)
-> [(CodeBlockType, [String])] -> [(CodeBlockType, [String])]
forall a. (a -> Bool) -> [a] -> [a]
filter ((CodeBlockType -> CodeBlockType -> Bool
forall a. Eq a => a -> a -> Bool
== CodeBlockType
FencedCodeBlock) (CodeBlockType -> Bool)
-> ((CodeBlockType, [String]) -> CodeBlockType)
-> (CodeBlockType, [String])
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CodeBlockType, [String]) -> CodeBlockType
forall a b. (a, b) -> a
fst)
    ([(CodeBlockType, [String])] -> [(CodeBlockType, [String])])
-> ([String] -> [(CodeBlockType, [String])])
-> [String]
-> [(CodeBlockType, [String])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [(CodeBlockType, [String])]
md_help_get_code_blocks

get_help_file_fragments :: String -> [String]
get_help_file_fragments :: String -> [String]
get_help_file_fragments String
s =
  if String -> Bool
is_md_help String
s
    then ([String] -> [[String]]) -> String -> [String]
on_lines_of [String] -> [[String]]
md_help_get_fenced_code_blocks String
s
    else ([String] -> [[String]]) -> String -> [String]
on_lines_of ([String] -> [[String]]
split_multiple_fragments ([String] -> [[String]])
-> ([String] -> [String]) -> [String] -> [[String]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
drop_post_graph_section) String
s

-- | Read text fragments from file.
read_file_fragments :: FilePath -> IO [String]
read_file_fragments :: String -> IO [String]
read_file_fragments = (String -> [String]) -> IO String -> IO [String]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> [String]
get_help_file_fragments (IO String -> IO [String])
-> (String -> IO String) -> String -> IO [String]
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 = ([[String]] -> [String]) -> IO [[String]] -> IO [String]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (IO [[String]] -> IO [String])
-> ([String] -> IO [[String]]) -> [String] -> IO [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> IO [String]) -> [String] -> IO [[String]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM String -> IO [String]
read_file_fragments