module Csound.Typed.Gui.Cabbage.CabbageLang(
  Lang, Line(..), Property(..), Arg(..), ppCabbage
) where

import Text.PrettyPrint.Leijen

type Lang = [Line]

data Line = Line
  { Line -> String
lineDef :: String
  , Line -> [Property]
lineProperties :: [Property]
  }

data Property = Property
  { Property -> String
propertyName :: String
  , Property -> [Arg]
propertyArgs :: [Arg]
  }

data Arg = StringArg String | FloatArg Float | IntArg Int | ColonArg Float Float

--------------------------------------------------
-- pretty print

ppCabbage :: Lang -> Doc
ppCabbage :: Lang -> Doc
ppCabbage Lang
xs = [Doc] -> Doc
vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Line -> Doc) -> Lang -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Line -> Doc
ppLine Lang
xs

ppLine :: Line -> Doc
ppLine :: Line -> Doc
ppLine (Line String
name [Property]
props) = String -> Doc
text String
name Doc -> Doc -> Doc
<+> [Doc] -> Doc
hcat (Doc -> [Doc] -> [Doc]
punctuate Doc
comma ((Property -> Doc) -> [Property] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Property -> Doc
ppProp [Property]
props))

ppProp :: Property -> Doc
ppProp :: Property -> Doc
ppProp (Property String
name [Arg]
args) = String -> Doc
text String
name Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Doc] -> Doc
tupled ((Arg -> Doc) -> [Arg] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Arg -> Doc
ppArg [Arg]
args)

ppArg :: Arg -> Doc
ppArg :: Arg -> Doc
ppArg Arg
x = case Arg
x of
  StringArg String
s -> Doc -> Doc
dquotes (String -> Doc
text String
s)
  FloatArg Float
a  -> Float -> Doc
float Float
a
  IntArg Int
a    -> Int -> Doc
int Int
a
  ColonArg Float
a Float
b -> Float -> Doc
float Float
a Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
colon Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Float -> Doc
float Float
b