-- | Interpreter (module) contexts for hsc3.
module Sound.Sc3.Common.Context where

import Text.Printf {- base -}

-- | (moduleName, qualifierName, packageName)
type Context = [(String, Maybe String, String)]

-- | Format a Context as a sequence of import commands.
context_format :: Context -> [String]
context_format :: Context -> [String]
context_format =
  let f :: (t, Maybe t, t) -> t
f (t
moduleName, Maybe t
qualifier, t
packageName) =
        case Maybe t
qualifier of
          Maybe t
Nothing -> String -> t -> t -> t
forall r. PrintfType r => String -> r
printf String
"import %s {- %s -}" t
moduleName t
packageName
          Just t
qualifierName -> String -> t -> t -> t -> t
forall r. PrintfType r => String -> r
printf String
"import qualified %s as %s {- %s -}" t
moduleName t
qualifierName t
packageName
  in ((String, Maybe String, String) -> String) -> Context -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, Maybe String, String) -> String
forall {t} {t} {t} {t}.
(PrintfType t, PrintfArg t, PrintfArg t, PrintfArg t) =>
(t, Maybe t, t) -> t
f

-- | writeFile of context_format
context_write :: FilePath -> Context -> IO ()
context_write :: String -> Context -> IO ()
context_write String
fn = String -> String -> IO ()
writeFile String
fn (String -> IO ()) -> (Context -> String) -> Context -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines ([String] -> String) -> (Context -> [String]) -> Context -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context -> [String]
context_format

-- | Minimal hsc3 context
min_context :: Context
min_context :: Context
min_context =
  [ (String
"Prelude", Maybe String
forall a. Maybe a
Nothing, String
"base")
  , (String
"Control.Monad", Maybe String
forall a. Maybe a
Nothing, String
"base")
  , (String
"Data.Bits", Maybe String
forall a. Maybe a
Nothing, String
"base")
  , (String
"Data.Function", Maybe String
forall a. Maybe a
Nothing, String
"base")
  , (String
"Data.List", Maybe String
forall a. Maybe a
Nothing, String
"base")
  , (String
"Sound.Sc3", Maybe String
forall a. Maybe a
Nothing, String
"hsc3")
  ]

-- | Standard hsc3 context
std_context :: Context
std_context :: Context
std_context =
  [ (String
"Prelude", Maybe String
forall a. Maybe a
Nothing, String
"base")
  , (String
"Control.Monad", Maybe String
forall a. Maybe a
Nothing, String
"base")
  , (String
"Data.Bits", Maybe String
forall a. Maybe a
Nothing, String
"base")
  , (String
"Data.Function", Maybe String
forall a. Maybe a
Nothing, String
"base")
  , (String
"Data.List", Maybe String
forall a. Maybe a
Nothing, String
"base")
  , (String
"System.Random", Maybe String
forall a. Maybe a
Nothing, String
"random")
  , (String
"Sound.Osc", Maybe String
forall a. Maybe a
Nothing, String
"hosc")
  , (String
"Sound.Sc3", Maybe String
forall a. Maybe a
Nothing, String
"hsc3")
  , (String
"Sound.Sc3.Common.Base", String -> Maybe String
forall a. a -> Maybe a
Just String
"Sound.Sc3.Common.Base", String
"hsc3")
  , (String
"Sound.Sc3.Common.Buffer.Gen", String -> Maybe String
forall a. a -> Maybe a
Just String
"Gen", String
"hsc3")
  , (String
"Sound.Sc3.Common.Math.Filter.Beq", String -> Maybe String
forall a. a -> Maybe a
Just String
"Sound.Sc3.Common.Math.Filter.Beq", String
"hsc3")
  , (String
"Sound.Sc3.Ugen.Bindings.Db.External", String -> Maybe String
forall a. a -> Maybe a
Just String
"X", String
"hsc3")
  , (String
"Sound.Sc3.Ugen.Bindings.Composite.External", String -> Maybe String
forall a. a -> Maybe a
Just String
"X", String
"hsc3")
  , (String
"Sound.Sc3.Ugen.Bindings.Hw.External.F0", String -> Maybe String
forall a. a -> Maybe a
Just String
"X", String
"hsc3")
  , (String
"Sound.Sc3.Ugen.Bindings.Hw.External.SC3_Plugins", String -> Maybe String
forall a. a -> Maybe a
Just String
"X", String
"hsc3")
  , (String
"Sound.Sc3.Ugen.Bindings.Hw.External.Zita", String -> Maybe String
forall a. a -> Maybe a
Just String
"X", String
"hsc3")
  , (String
"Sound.Sc3.Ugen.Bindings.Db.Rdu", String -> Maybe String
forall a. a -> Maybe a
Just String
"X", String
"sc3-rdu")
  , (String
"Sound.Sc3.Ugen.Dot", String -> Maybe String
forall a. a -> Maybe a
Just String
"Sound.Sc3.Ugen.Dot", String
"hsc3-dot")
  , (String
"Sound.Sc3.Ugen.Unsafe", Maybe String
forall a. Maybe a
Nothing, String
"hsc3-unsafe")
  , (String
"Sound.Sc3.Ugen.Unsafe", Maybe String
forall a. Maybe a
Nothing, String
"hsc3-unsafe")
  , (String
"Sound.Sc3.Ugen.Protect", String -> Maybe String
forall a. a -> Maybe a
Just String
"Protect", String
"hsc3-rw")
  , (String
"Sound.Sc3.Ui.Html", String -> Maybe String
forall a. a -> Maybe a
Just String
"Ui", String
"hsc3-ui")
  , (String
"Sound.Sc3.Ui.Plot", String -> Maybe String
forall a. a -> Maybe a
Just String
"Ui", String
"hsc3-ui")
  , (String
"Sound.Sc3.Ui.Qarma", String -> Maybe String
forall a. a -> Maybe a
Just String
"Ui", String
"hsc3-ui")
  , (String
"Sound.Sc3.Ui.ScLang", String -> Maybe String
forall a. a -> Maybe a
Just String
"Ui", String
"hsc3-ui")
  , (String
"Sound.Sc3.Ui.ScLang.Control", String -> Maybe String
forall a. a -> Maybe a
Just String
"Ui", String
"hsc3-ui")
  ]