-- | 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 -> forall r. PrintfType r => String -> r
printf String
"import %s {- %s -}" t
moduleName t
packageName
          Just t
qualifierName -> forall r. PrintfType r => String -> r
printf String
"import qualified %s as %s {- %s -}" t
moduleName t
qualifierName t
packageName
  in forall a b. (a -> b) -> [a] -> [b]
map 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines 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",forall a. Maybe a
Nothing,String
"base")
  ,(String
"Control.Monad",forall a. Maybe a
Nothing,String
"base")
  ,(String
"Data.Bits",forall a. Maybe a
Nothing,String
"base")
  ,(String
"Data.Function",forall a. Maybe a
Nothing,String
"base")
  ,(String
"Data.List",forall a. Maybe a
Nothing,String
"base")
  ,(String
"Sound.Sc3",forall a. Maybe a
Nothing,String
"hsc3")]

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