module Sound.SC3.Server.Graphdef.Text where

import Control.Monad {- base -}
import Data.Char {- base -}
import Data.Functor.Identity {- base -}

import qualified Numeric {- base -}

import qualified Control.Monad.State as S {- mtl -}

import qualified Sound.OSC.Datum as Datum {- hosc -}

import Sound.SC3.Server.Graphdef {- hsc3 -}

-- | * PRINT

-- | Print string.  Strings must not have internal whitespace or semi-colons.
print_string :: Datum.ASCII -> String
print_string :: ASCII -> String
print_string ASCII
a =
  let s :: String
s = ASCII -> String
Datum.ascii_to_string ASCII
a
  in if (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Char -> Bool
isSpace String
s Bool -> Bool -> Bool
|| Char
';' Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
s then String -> String
forall a. HasCallStack => String -> a
error String
"print_string" else String
s

-- | 'ENCODE_F' for plain text output.
enc_text :: (String -> String) -> ENCODE_F String
enc_text :: (String -> String) -> ENCODE_F String
enc_text String -> String
com_f =
  ([String] -> String
unwords ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null),ASCII -> String
print_string,Int -> String
forall a. Show a => a -> String
show,Int -> String
forall a. Show a => a -> String
show,Int -> String
forall a. Show a => a -> String
show,\Double
n -> Maybe Int -> Double -> String -> String
forall a. RealFloat a => Maybe Int -> a -> String -> String
Numeric.showFFloat Maybe Int
forall a. Maybe a
Nothing Double
n String
""
  ,String -> String
com_f)

{- | 'encode_graphdef_f' of 'enc_text' with optional semi-colon delimited comments.

> dir = "/home/rohan/sw/rsc3-disassembler/scsyndef/"
> pp nm = read_graphdef_file (dir ++ nm) >>= putStrLn . print_graphdef True
> pp "simple.scsyndef"
> pp "with-ctl.scsyndef"
> pp "mce.scsyndef"
> pp "mrg.scsyndef"
-}
print_graphdef :: Bool -> Graphdef -> String
print_graphdef :: Bool -> Graphdef -> String
print_graphdef Bool
with_com =
    let com_f :: String -> String
com_f = if Bool
with_com then \String
c -> [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"\n; ",String
c,String
"\n"] else String -> String -> String
forall a b. a -> b -> a
const String
""
    in ENCODE_F String -> Graphdef -> String
forall t. ENCODE_F t -> Graphdef -> t
encode_graphdef_f ((String -> String) -> ENCODE_F String
enc_text String -> String
com_f)

-- * LIST INPUT

-- | Read the next value from a list.
list_read_f :: (t -> u) -> S.State [t] u
list_read_f :: (t -> u) -> State [t] u
list_read_f t -> u
f = do
  [t]
l <- StateT [t] Identity [t]
forall s (m :: * -> *). MonadState s m => m s
S.get
  Bool -> StateT [t] Identity () -> StateT [t] Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([t] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [t]
l) (String -> StateT [t] Identity ()
forall a. HasCallStack => String -> a
error String
"list_read_f")
  [t] -> StateT [t] Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
S.put ([t] -> [t]
forall a. [a] -> [a]
tail [t]
l)
  u -> State [t] u
forall (m :: * -> *) a. Monad m => a -> m a
return (t -> u
f ([t] -> t
forall a. [a] -> a
head [t]
l))

-- | GET_F for text representation of Graphdef.
text_get_f :: GET_F (S.StateT [String] Identity)
text_get_f :: GET_F (StateT [String] Identity)
text_get_f = ((String -> ASCII) -> State [String] ASCII
forall t u. (t -> u) -> State [t] u
list_read_f String -> ASCII
Datum.ascii,(String -> Int) -> State [String] Int
forall t u. (t -> u) -> State [t] u
list_read_f String -> Int
forall a. Read a => String -> a
read,(String -> Int) -> State [String] Int
forall t u. (t -> u) -> State [t] u
list_read_f String -> Int
forall a. Read a => String -> a
read,(String -> Int) -> State [String] Int
forall t u. (t -> u) -> State [t] u
list_read_f String -> Int
forall a. Read a => String -> a
read,(String -> Double) -> State [String] Double
forall t u. (t -> u) -> State [t] u
list_read_f String -> Double
forall a. Read a => String -> a
read)

-- | Read text representation of Graphdef, as written by 'print_graphdef'.
--
-- > read_graphdef "1396926310 0 1 simple 2 0.0 440.0 0 0 2 SinOsc 2 2 1 0 -1 1 -1 0 2 Out 2 2 0 0 -1 0 0 0"
read_graphdef :: String -> Graphdef
read_graphdef :: String -> Graphdef
read_graphdef String
txt =
  let delete_comments :: [String] -> [String]
delete_comments = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (\String
x -> Bool -> Bool
not (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
x) Bool -> Bool -> Bool
&& (String -> Char
forall a. [a] -> a
head String
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
';'))
  in State [String] Graphdef -> [String] -> Graphdef
forall s a. State s a -> s -> a
S.evalState (GET_F (StateT [String] Identity) -> State [String] Graphdef
forall (m :: * -> *). Monad m => GET_F m -> m Graphdef
get_graphdef GET_F (StateT [String] Identity)
text_get_f) ((String -> [String]) -> [String] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap String -> [String]
words ([String] -> [String]
delete_comments (String -> [String]
lines String
txt)))