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

import Data.Text (Text)
import Text.PrettyPrint.Leijen.Text

type Lang = [Line]

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

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

data Arg = StringArg Text | 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 a b. (a -> b) -> [a] -> [b]
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 Text
name [Property]
props) = Text -> Doc
textStrict Text
name Doc -> Doc -> Doc
<+> [Doc] -> Doc
hcat (Doc -> [Doc] -> [Doc]
punctuate Doc
comma ((Property -> Doc) -> [Property] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
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 Text
name [Arg]
args) = Text -> Doc
textStrict Text
name Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Doc] -> Doc
tupled ((Arg -> Doc) -> [Arg] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
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 Text
s -> Doc -> Doc
dquotes (Text -> Doc
textStrict Text
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