module Csound.Dynamic.Render(
  RenderOptions (..),
  renderCsd,
  module X
) where

import qualified Text.PrettyPrint.Leijen.Text as P

import Csound.Dynamic.Render.Instr
import Csound.Dynamic.Render.Pretty
import Csound.Dynamic.Types
import Csound.Dynamic.Tfm.InferTypes as X (InferenceOptions (..), OpcodeInferenceStrategy (..))
import Data.Default

data RenderOptions = RenderOptions
  { RenderOptions -> InferenceOptions
inferenceOptions :: !InferenceOptions
  }
  deriving (RenderOptions -> RenderOptions -> Bool
(RenderOptions -> RenderOptions -> Bool)
-> (RenderOptions -> RenderOptions -> Bool) -> Eq RenderOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RenderOptions -> RenderOptions -> Bool
== :: RenderOptions -> RenderOptions -> Bool
$c/= :: RenderOptions -> RenderOptions -> Bool
/= :: RenderOptions -> RenderOptions -> Bool
Eq, Eq RenderOptions
Eq RenderOptions =>
(RenderOptions -> RenderOptions -> Ordering)
-> (RenderOptions -> RenderOptions -> Bool)
-> (RenderOptions -> RenderOptions -> Bool)
-> (RenderOptions -> RenderOptions -> Bool)
-> (RenderOptions -> RenderOptions -> Bool)
-> (RenderOptions -> RenderOptions -> RenderOptions)
-> (RenderOptions -> RenderOptions -> RenderOptions)
-> Ord RenderOptions
RenderOptions -> RenderOptions -> Bool
RenderOptions -> RenderOptions -> Ordering
RenderOptions -> RenderOptions -> RenderOptions
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: RenderOptions -> RenderOptions -> Ordering
compare :: RenderOptions -> RenderOptions -> Ordering
$c< :: RenderOptions -> RenderOptions -> Bool
< :: RenderOptions -> RenderOptions -> Bool
$c<= :: RenderOptions -> RenderOptions -> Bool
<= :: RenderOptions -> RenderOptions -> Bool
$c> :: RenderOptions -> RenderOptions -> Bool
> :: RenderOptions -> RenderOptions -> Bool
$c>= :: RenderOptions -> RenderOptions -> Bool
>= :: RenderOptions -> RenderOptions -> Bool
$cmax :: RenderOptions -> RenderOptions -> RenderOptions
max :: RenderOptions -> RenderOptions -> RenderOptions
$cmin :: RenderOptions -> RenderOptions -> RenderOptions
min :: RenderOptions -> RenderOptions -> RenderOptions
Ord, Int -> RenderOptions -> ShowS
[RenderOptions] -> ShowS
RenderOptions -> String
(Int -> RenderOptions -> ShowS)
-> (RenderOptions -> String)
-> ([RenderOptions] -> ShowS)
-> Show RenderOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RenderOptions -> ShowS
showsPrec :: Int -> RenderOptions -> ShowS
$cshow :: RenderOptions -> String
show :: RenderOptions -> String
$cshowList :: [RenderOptions] -> ShowS
showList :: [RenderOptions] -> ShowS
Show, ReadPrec [RenderOptions]
ReadPrec RenderOptions
Int -> ReadS RenderOptions
ReadS [RenderOptions]
(Int -> ReadS RenderOptions)
-> ReadS [RenderOptions]
-> ReadPrec RenderOptions
-> ReadPrec [RenderOptions]
-> Read RenderOptions
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS RenderOptions
readsPrec :: Int -> ReadS RenderOptions
$creadList :: ReadS [RenderOptions]
readList :: ReadS [RenderOptions]
$creadPrec :: ReadPrec RenderOptions
readPrec :: ReadPrec RenderOptions
$creadListPrec :: ReadPrec [RenderOptions]
readListPrec :: ReadPrec [RenderOptions]
Read)

instance Default RenderOptions where
  def :: RenderOptions
def = RenderOptions
          { inferenceOptions :: InferenceOptions
inferenceOptions = InferenceOptions
forall a. Default a => a
def
          }

renderCsd :: RenderOptions -> Csd -> String
renderCsd :: RenderOptions -> Csd -> String
renderCsd RenderOptions
opts Csd
a = Doc -> String
forall a. Show a => a -> String
show (Doc -> String) -> Doc -> String
forall a b. (a -> b) -> a -> b
$ Doc -> Doc -> Doc -> [Plugin] -> Doc
ppCsdFile
    (Flags -> Doc
renderFlags (Flags -> Doc) -> Flags -> Doc
forall a b. (a -> b) -> a -> b
$ Csd -> Flags
csdFlags Csd
a)
    (InferenceOptions -> Orc -> Doc
renderOrc (RenderOptions -> InferenceOptions
inferenceOptions RenderOptions
opts) (Orc -> Doc) -> Orc -> Doc
forall a b. (a -> b) -> a -> b
$ Csd -> Orc
csdOrc Csd
a)
    (Sco -> Doc
renderSco   (Sco -> Doc) -> Sco -> Doc
forall a b. (a -> b) -> a -> b
$ Csd -> Sco
csdSco Csd
a)
    (Csd -> [Plugin]
csdPlugins Csd
a)

renderFlags :: Flags -> Doc
renderFlags :: Flags -> Doc
renderFlags = Flags -> Doc
forall a. Pretty a => a -> Doc
P.pretty

renderOrc :: InferenceOptions -> Orc -> Doc
renderOrc :: InferenceOptions -> Orc -> Doc
renderOrc InferenceOptions
opts Orc
a = [Doc] -> Doc
vcatSep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Doc
headExpr Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: [Doc]
instrExprs
  where
    headExpr :: Doc
headExpr    = InferenceOptions -> E -> Doc
renderInstrBody InferenceOptions
opts (Orc -> E
orcHead Orc
a)
    instrExprs :: [Doc]
instrExprs  = (Instr -> Doc) -> [Instr] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (InferenceOptions -> Instr -> Doc
renderInstr InferenceOptions
opts) (Orc -> [Instr]
orcInstruments Orc
a)

renderSco :: Sco -> Doc
renderSco :: Sco -> Doc
renderSco Sco
a = [Doc] -> Doc
vcatSep
    [ [Doc] -> Doc
P.vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ ((Int, Gen) -> Doc) -> [(Int, Gen)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Int -> Gen -> Doc) -> (Int, Gen) -> Doc
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> Gen -> Doc
ppGen) ([(Int, Gen)] -> [Doc]) -> [(Int, Gen)] -> [Doc]
forall a b. (a -> b) -> a -> b
$ Sco -> [(Int, Gen)]
scoGens Sco
a
    , Doc -> (Double -> Doc) -> Maybe Double -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
P.empty Double -> Doc
ppTotalDur (Maybe Double -> Doc) -> Maybe Double -> Doc
forall a b. (a -> b) -> a -> b
$ Sco -> Maybe Double
scoTotalDur Sco
a
    , [Doc] -> Doc
P.vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ ((InstrId, [CsdEvent]) -> Doc) -> [(InstrId, [CsdEvent])] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((InstrId -> [CsdEvent] -> Doc) -> (InstrId, [CsdEvent]) -> Doc
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry InstrId -> [CsdEvent] -> Doc
ppNotes) ([(InstrId, [CsdEvent])] -> [Doc])
-> [(InstrId, [CsdEvent])] -> [Doc]
forall a b. (a -> b) -> a -> b
$ Sco -> [(InstrId, [CsdEvent])]
scoNotes Sco
a ]