-- | Elementary dot.
module Sound.DF.Uniform.LL.Dot where

import Data.List {- base -}
import Data.Maybe {- base -}
import Data.Typeable {- base -}
import Text.Printf {- base -}

import Sound.DF.Uniform.LL.K
import Sound.DF.Uniform.LL.UId

-- | Map from 'TypeRep' to colour name.
--
-- > map (ty_colour . Just) [int32_t,float_t] == ["orange","blue"]
ty_colour :: Maybe TypeRep -> String
ty_colour m =
    let tbl = [(bool_t,"brown")
              ,(int32_t,"orange")
              ,(float_t,"blue")
              ,(nil_t,"black")
              ,(vec_float_t,"purple")]
    in case m of
         Nothing -> "grey"
         Just ty -> fromMaybe "red" (lookup ty tbl)

-- | Left & right bracket.
--
-- > w_bracket '(' ')' "parentheses" == "(parentheses)"
w_bracket :: a -> a -> [a] -> [a]
w_bracket p q l = p : l ++ [q]

-- | Dot notation for /key,value/ attributes.
dot_attr :: [(String,String)] -> String
dot_attr a =
    let in_quotes = w_bracket '"' '"'
        in_square = w_bracket '[' ']'
        sep_commas = intercalate ","
        join_eq p q = p ++ "=" ++ q
        (k,v) = unzip a
    in in_square (sep_commas (zipWith join_eq k (map in_quotes v)))

-- | Dot node as /record/.  Constant values are drawn directly into
-- input ports.  The /nm/ 'String' has the @df_@ prefix removed for
-- printing.
--
-- > dot_rec 0 "nm" [] (Just float_t)
dot_rec :: Id -> String -> [Either Int K] -> Maybe TypeRep -> String
dot_rec k nm ar ty =
    let mk_i i = case i of
                   Left i_k -> printf "<i_%d>" i_k
                   Right i_k -> k_concise i_k
        ip = if null ar
             then ""
             else '|' : intercalate "|" (map mk_i ar)
        op = maybe "" (const "|<o_0>") ty
        nm' = fromMaybe nm (stripPrefix "df_" nm)
        c = ty_colour ty
        a = [("shape","record")
            ,("color",c)
            ,("label",printf "{{%s%s%s}}" nm' ip op)]
    in printf "%d %s;" k (dot_attr a)

-- | Make arguments input for 'dot_rec' from arity.
dot_rec_ar :: Int -> [Either Int K]
dot_rec_ar n = map Left [0 .. n - 1]

-- | Variant where 'nil_t' indicates no output.
dot_rec' :: Id -> String -> [Either Int K] -> TypeRep -> String
dot_rec' k nm n ty =
    let ty' = if ty == nil_t then Nothing else Just ty
    in dot_rec k nm n ty'