{- | .scsyndef file encoded in plain text.
There are reader and writer functions.
-}
module Sound.Sc3.Server.Graphdef.Text where

import Data.Char {- base -}
import Data.Functor.Identity {- base -}
import Data.List {- 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 -}

-- | * Printer

-- | Print string.  Strings must not have internal whitespace or semi-colons.  A quoting system could allow these if required.
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 a. Eq a => a -> [a] -> 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_Functions' for plain text output.
enc_text :: (String -> String) -> Encode_Functions String
enc_text :: (String -> String) -> Encode_Functions 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 a. [a] -> 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 = Sound.Sc3.Server.Graphdef.Io.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_Functions String -> Graphdef -> String
forall t. Encode_Functions t -> Graphdef -> t
encode_graphdef_f ((String -> String) -> Encode_Functions 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 :: forall t u. (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
  case [t] -> Maybe (t, [t])
forall a. [a] -> Maybe (a, [a])
uncons [t]
l of
    Maybe (t, [t])
Nothing -> String -> State [t] u
forall a. HasCallStack => String -> a
error String
"list_read_f"
    Just (t
h, [t]
t) -> [t] -> StateT [t] Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
S.put [t]
t StateT [t] Identity () -> State [t] u -> State [t] u
forall a b.
StateT [t] Identity a
-> StateT [t] Identity b -> StateT [t] Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> u -> State [t] u
forall a. a -> StateT [t] Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (t -> u
f t
h)

-- | Read function for floating point that admits inf and infinity.
read_float :: (Fractional p, Read p) => String -> p
read_float :: forall p. (Fractional p, Read p) => String -> p
read_float String
txt =
  case (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
txt of
    String
"inf" -> p
1 p -> p -> p
forall a. Fractional a => a -> a -> a
/ p
0
    String
"infinity" -> p
1 p -> p -> p
forall a. Fractional a => a -> a -> a
/ p
0
    String
_ -> String -> p
forall a. Read a => String -> a
read String
txt

-- | Get_Functions for text representation of Graphdef.
text_get_f :: Get_Functions (S.StateT [String] Identity)
text_get_f :: Get_Functions (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 p. (Fractional p, Read p) => String -> p
read_float)

-- | Is line empty or starts with ';'
is_nil_or_comment :: String -> Bool
is_nil_or_comment :: String -> Bool
is_nil_or_comment String
txt =
  case String -> Maybe (Char, String)
forall a. [a] -> Maybe (a, [a])
uncons String
txt of
    Maybe (Char, String)
Nothing -> Bool
True
    Just (Char
h, String
_) -> Char
h Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
';'

{- | 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 (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
is_nil_or_comment)
  in State [String] Graphdef -> [String] -> Graphdef
forall s a. State s a -> s -> a
S.evalState (Get_Functions (StateT [String] Identity) -> State [String] Graphdef
forall (m :: * -> *). Monad m => Get_Functions m -> m Graphdef
get_graphdef Get_Functions (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)))

read_graphdef_file :: FilePath -> IO Graphdef
read_graphdef_file :: String -> IO Graphdef
read_graphdef_file = (String -> Graphdef) -> IO String -> IO Graphdef
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Graphdef
read_graphdef (IO String -> IO Graphdef)
-> (String -> IO String) -> String -> IO Graphdef
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO String
readFile