-- | Tools to build Fm synthesis graphs
--
-- Example
--
-- > f a = fmOut1 $ do
-- >  x1 <- fmOsc 1
-- >  x2 <- fmOsc 2
-- >  x1 `fmod` [(a, x2)]
-- >  return x1
module Csound.Air.Fm(
  -- * Fm graph
  Fm, FmNode,
  fmOsc', fmOsc, fmSig,
  fmod,
  fmOut, fmOut1, fmOut2,

  -- * Simplified Fm graph
  FmSpec(..), FmGraph(..), fmRun,
  -- ** Specific graphs
  -- | Algorithms for DX7 fm synth
  dx_1,  dx_2,  dx_3,  dx_4 {-,  dx_5,  dx_6,  dx_7,  dx_8,
  dx_9,  dx_10, dx_11, dx_12, dx_13, dx_14, dx_15, dx_16,
  dx_17, dx_18, dx_19, dx_20, dx_21, dx_22, dx_23, dx_24,
  dx_25, dx_26, dx_27, dx_28, dx_29, dx_30, dx_31, dx_32 -}
) where

import qualified Data.IntMap as IM

import Control.Monad.Trans.State.Strict
import Control.Monad

import Csound.Typed
import Csound.Air.Wave

-- Fm graph rendering

type Fm a = State St a

newtype FmNode = FmNode Int

type FmIdx = (Int, Sig)

data Fmod = Fmod (Sig -> SE Sig) Sig [FmIdx] | Fsig Sig

data St = St
  { St -> Int
st'newIdx     :: Int
  , St -> [Fmod]
st'units      :: [Fmod]
  , St -> IntMap [FmIdx]
st'links      :: IM.IntMap [FmIdx]
  }

defSt :: St
defSt :: St
defSt = St :: Int -> [Fmod] -> IntMap [FmIdx] -> St
St
  { st'newIdx :: Int
st'newIdx = Int
0
  , st'units :: [Fmod]
st'units = []
  , st'links :: IntMap [FmIdx]
st'links = IntMap [FmIdx]
forall a. IntMap a
IM.empty }

renderGraph :: [Fmod] -> [FmIdx] -> Sig -> SE [Sig]
renderGraph :: [Fmod] -> [FmIdx] -> Sig -> SE [Sig]
renderGraph [Fmod]
units [FmIdx]
outs Sig
cps = do
  [Ref Sig]
refs <- Int -> SE [Ref Sig]
forall b. (Num b, Enum b) => b -> SE [Ref Sig]
initUnits ([Fmod] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Fmod]
units)
  ((Int, Fmod) -> SE ()) -> [(Int, Fmod)] -> SE ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ([Ref Sig] -> (Int, Fmod) -> SE ()
loopUnit [Ref Sig]
refs) ([Int] -> [Fmod] -> [(Int, Fmod)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 .. ] [Fmod]
units)
  (FmIdx -> SE Sig) -> [FmIdx] -> SE [Sig]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ([Ref Sig] -> FmIdx -> SE Sig
renderIdx [Ref Sig]
refs) [FmIdx]
outs
  where
    initUnits :: b -> SE [Ref Sig]
initUnits b
n = (b -> SE (Ref Sig)) -> [b] -> SE [Ref Sig]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (SE (Ref Sig) -> b -> SE (Ref Sig)
forall a b. a -> b -> a
const (SE (Ref Sig) -> b -> SE (Ref Sig))
-> SE (Ref Sig) -> b -> SE (Ref Sig)
forall a b. (a -> b) -> a -> b
$ Sig -> SE (Ref Sig)
forall a. Tuple a => a -> SE (Ref a)
newRef (Sig
0 :: Sig)) [b
1 .. b
n]

    loopUnit :: [Ref Sig] -> (Int, Fmod) -> SE ()
loopUnit [Ref Sig]
refs (Int
n, Fmod
x) = Ref Sig -> Sig -> SE ()
forall a. Tuple a => Ref a -> a -> SE ()
writeRef ([Ref Sig]
refs [Ref Sig] -> Int -> Ref Sig
forall a. [a] -> Int -> a
!! Int
n) (Sig -> SE ()) -> SE Sig -> SE ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< case Fmod
x of
      Fsig Sig
asig -> Sig -> SE Sig
forall (m :: * -> *) a. Monad m => a -> m a
return Sig
asig
      Fmod Sig -> SE Sig
wave Sig
modFreq [FmIdx]
subs -> do
        Sig
s <- ([Sig] -> Sig) -> SE [Sig] -> SE Sig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Sig] -> Sig
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (SE [Sig] -> SE Sig) -> SE [Sig] -> SE Sig
forall a b. (a -> b) -> a -> b
$ (FmIdx -> SE Sig) -> [FmIdx] -> SE [Sig]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ([Ref Sig] -> FmIdx -> SE Sig
renderModIdx [Ref Sig]
refs) [FmIdx]
subs
        Sig -> SE Sig
wave (Sig
cps Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
modFreq Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
+ Sig
s)
      where

    renderIdx :: [Ref Sig] -> (Int, Sig) -> SE Sig
    renderIdx :: [Ref Sig] -> FmIdx -> SE Sig
renderIdx [Ref Sig]
refs (Int
idx, Sig
amp) = Sig -> SE Sig -> SE Sig
forall a. SigSpace a => Sig -> a -> a
mul Sig
amp (SE Sig -> SE Sig) -> SE Sig -> SE Sig
forall a b. (a -> b) -> a -> b
$ Ref Sig -> SE Sig
forall a. Tuple a => Ref a -> SE a
readRef ([Ref Sig]
refs [Ref Sig] -> Int -> Ref Sig
forall a. [a] -> Int -> a
!! Int
idx)

    renderModIdx :: [Ref Sig] -> (Int, Sig) -> SE Sig
    renderModIdx :: [Ref Sig] -> FmIdx -> SE Sig
renderModIdx [Ref Sig]
refs (Int
idx, Sig
amp) = Sig -> SE Sig -> SE Sig
forall a. SigSpace a => Sig -> a -> a
mul (Sig
amp Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
modFreq) (SE Sig -> SE Sig) -> SE Sig -> SE Sig
forall a b. (a -> b) -> a -> b
$ Ref Sig -> SE Sig
forall a. Tuple a => Ref a -> SE a
readRef ([Ref Sig]
refs [Ref Sig] -> Int -> Ref Sig
forall a. [a] -> Int -> a
!! Int
idx)
      where
        modFreq :: Sig
modFreq = case ([Fmod]
units [Fmod] -> Int -> Fmod
forall a. [a] -> Int -> a
!! Int
idx) of
                    Fmod Sig -> SE Sig
_ Sig
m [FmIdx]
_ -> Sig
m Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
cps
                    Fmod
_          -> Sig
1


mkGraph :: St -> [Fmod]
mkGraph :: St -> [Fmod]
mkGraph St
s = (Fmod -> Int -> Fmod) -> [Fmod] -> [Int] -> [Fmod]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Fmod -> Int -> Fmod
extractMod ([Fmod] -> [Fmod]
forall a. [a] -> [a]
reverse ([Fmod] -> [Fmod]) -> [Fmod] -> [Fmod]
forall a b. (a -> b) -> a -> b
$ St -> [Fmod]
st'units St
s) [Int
0 .. ]
  where
    extractMod :: Fmod -> Int -> Fmod
extractMod Fmod
x Int
n = case Fmod
x of
      Fmod Sig -> SE Sig
alg Sig
w [FmIdx]
_ -> (Sig -> SE Sig) -> Sig -> [FmIdx] -> Fmod
Fmod Sig -> SE Sig
alg Sig
w ([FmIdx] -> ([FmIdx] -> [FmIdx]) -> Maybe [FmIdx] -> [FmIdx]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] [FmIdx] -> [FmIdx]
forall a. a -> a
id (Maybe [FmIdx] -> [FmIdx]) -> Maybe [FmIdx] -> [FmIdx]
forall a b. (a -> b) -> a -> b
$ Int -> IntMap [FmIdx] -> Maybe [FmIdx]
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
n (St -> IntMap [FmIdx]
st'links St
s))
      Fmod
_            -> Fmod
x

toFmIdx :: (Sig, FmNode) -> FmIdx
toFmIdx :: (Sig, FmNode) -> FmIdx
toFmIdx (Sig
amp, FmNode Int
n) = (Int
n, Sig
amp)

---------------------------------------------------------
-- constructors

-- | Creates fm node with generic wave.
--
-- > fmOsc' wave modFreq
fmOsc' :: (Sig -> SE Sig) -> Sig -> Fm FmNode
fmOsc' :: (Sig -> SE Sig) -> Sig -> Fm FmNode
fmOsc' Sig -> SE Sig
wave Sig
idx = Fmod -> Fm FmNode
newFmod ((Sig -> SE Sig) -> Sig -> [FmIdx] -> Fmod
Fmod Sig -> SE Sig
wave Sig
idx [])

-- | Creates fm node with sine wave.
--
-- > fmOsc modFreq
fmOsc :: Sig -> Fm FmNode
fmOsc :: Sig -> Fm FmNode
fmOsc = (Sig -> SE Sig) -> Sig -> Fm FmNode
fmOsc' Sig -> SE Sig
rndOsc

-- | Creates fm node with signal generator (it's independent from the main frequency).
fmSig :: Sig -> Fm FmNode
fmSig :: Sig -> Fm FmNode
fmSig Sig
a = Fmod -> Fm FmNode
newFmod (Sig -> Fmod
Fsig Sig
a)

newFmod :: Fmod -> Fm FmNode
newFmod :: Fmod -> Fm FmNode
newFmod Fmod
a = (St -> (FmNode, St)) -> Fm FmNode
forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state ((St -> (FmNode, St)) -> Fm FmNode)
-> (St -> (FmNode, St)) -> Fm FmNode
forall a b. (a -> b) -> a -> b
$ \St
s ->
  let n :: Int
n  = St -> Int
st'newIdx St
s
      s1 :: St
s1 = St
s { st'newIdx :: Int
st'newIdx = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, st'units :: [Fmod]
st'units = Fmod
a Fmod -> [Fmod] -> [Fmod]
forall a. a -> [a] -> [a]
: St -> [Fmod]
st'units St
s }
  in  (Int -> FmNode
FmNode Int
n, St
s1)

-- modulator

fmod :: FmNode -> [(Sig, FmNode)] -> Fm ()
fmod :: FmNode -> [(Sig, FmNode)] -> Fm ()
fmod (FmNode Int
idx) [(Sig, FmNode)]
mods = (St -> ((), St)) -> Fm ()
forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state ((St -> ((), St)) -> Fm ()) -> (St -> ((), St)) -> Fm ()
forall a b. (a -> b) -> a -> b
$ \St
s ->
  ((), St
s { st'links :: IntMap [FmIdx]
st'links = (Int -> [FmIdx] -> [FmIdx] -> [FmIdx])
-> Int -> [FmIdx] -> IntMap [FmIdx] -> IntMap [FmIdx]
forall a. (Int -> a -> a -> a) -> Int -> a -> IntMap a -> IntMap a
IM.insertWithKey (\Int
_ [FmIdx]
a [FmIdx]
b -> [FmIdx]
a [FmIdx] -> [FmIdx] -> [FmIdx]
forall a. [a] -> [a] -> [a]
++ [FmIdx]
b) Int
idx (((Sig, FmNode) -> FmIdx) -> [(Sig, FmNode)] -> [FmIdx]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Sig, FmNode) -> FmIdx
toFmIdx [(Sig, FmNode)]
mods) (St -> IntMap [FmIdx]
st'links St
s) })

-- outputs

-- | Renders Fm synth to function.
fmOut :: Fm [(Sig, FmNode)] -> Sig -> SE [Sig]
fmOut :: Fm [(Sig, FmNode)] -> Sig -> SE [Sig]
fmOut Fm [(Sig, FmNode)]
fm = [Fmod] -> [FmIdx] -> Sig -> SE [Sig]
renderGraph (St -> [Fmod]
mkGraph St
s) (((Sig, FmNode) -> FmIdx) -> [(Sig, FmNode)] -> [FmIdx]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Sig, FmNode) -> FmIdx
toFmIdx [(Sig, FmNode)]
outs)
  where ([(Sig, FmNode)]
outs, St
s) = Fm [(Sig, FmNode)] -> St -> ([(Sig, FmNode)], St)
forall s a. State s a -> s -> (a, s)
runState Fm [(Sig, FmNode)]
fm St
defSt

-- | Renders mono output.
fmOut1 :: Fm FmNode -> Sig -> SE Sig
fmOut1 :: Fm FmNode -> Sig -> SE Sig
fmOut1 Fm FmNode
fm Sig
cps = ([Sig] -> Sig) -> SE [Sig] -> SE Sig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Sig] -> Sig
forall a. [a] -> a
head (SE [Sig] -> SE Sig) -> SE [Sig] -> SE Sig
forall a b. (a -> b) -> a -> b
$ Fm [(Sig, FmNode)] -> Sig -> SE [Sig]
fmOut ((FmNode -> [(Sig, FmNode)]) -> Fm FmNode -> Fm [(Sig, FmNode)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\FmNode
x -> [(Sig
1, FmNode
x)]) Fm FmNode
fm) Sig
cps

-- | Renders stereo output.
fmOut2 :: Fm (FmNode, FmNode) -> Sig -> SE Sig2
fmOut2 :: Fm (FmNode, FmNode) -> Sig -> SE Sig2
fmOut2 Fm (FmNode, FmNode)
fm Sig
cps = ([Sig] -> Sig2) -> SE [Sig] -> SE Sig2
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\[Sig
a, Sig
b] -> (Sig
a, Sig
b)) (SE [Sig] -> SE Sig2) -> SE [Sig] -> SE Sig2
forall a b. (a -> b) -> a -> b
$ Fm [(Sig, FmNode)] -> Sig -> SE [Sig]
fmOut (((FmNode, FmNode) -> [(Sig, FmNode)])
-> Fm (FmNode, FmNode) -> Fm [(Sig, FmNode)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(FmNode
a, FmNode
b) -> [(Sig
1, FmNode
a), (Sig
1, FmNode
b)]) Fm (FmNode, FmNode)
fm) Sig
cps

-----------------------------------------------------------------------

data FmSpec = FmSpec
  { FmSpec -> [Sig -> SE Sig]
fmWave :: [Sig -> SE Sig]
  , FmSpec -> [Sig]
fmCps :: [Sig]
  , FmSpec -> [Sig]
fmInd :: [Sig]
  , FmSpec -> [Sig]
fmOuts :: [Sig] }

data FmGraph = FmGraph
  { FmGraph -> [(Int, [Int])]
fmGraph   :: [(Int, [Int])]
  , FmGraph -> [Int]
fmGraphOuts :: [Int] }

fmRun :: FmGraph -> FmSpec -> Sig -> SE Sig
fmRun :: FmGraph -> FmSpec -> Sig -> SE Sig
fmRun FmGraph
graph FmSpec
spec' Sig
cps = ([Sig] -> Sig) -> SE [Sig] -> SE Sig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Sig] -> Sig
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (SE [Sig] -> SE Sig) -> SE [Sig] -> SE Sig
forall a b. (a -> b) -> a -> b
$ ((Sig -> SE [Sig]) -> Sig -> SE [Sig]
forall a b. (a -> b) -> a -> b
$ Sig
cps) ((Sig -> SE [Sig]) -> SE [Sig]) -> (Sig -> SE [Sig]) -> SE [Sig]
forall a b. (a -> b) -> a -> b
$ Fm [(Sig, FmNode)] -> Sig -> SE [Sig]
fmOut (Fm [(Sig, FmNode)] -> Sig -> SE [Sig])
-> Fm [(Sig, FmNode)] -> Sig -> SE [Sig]
forall a b. (a -> b) -> a -> b
$ do
  [FmNode]
ops <- ((Sig -> SE Sig) -> Sig -> Fm FmNode)
-> [Sig -> SE Sig] -> [Sig] -> StateT St Identity [FmNode]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (Sig -> SE Sig) -> Sig -> Fm FmNode
fmOsc' (FmSpec -> [Sig -> SE Sig]
fmWave FmSpec
spec) (FmSpec -> [Sig]
fmCps FmSpec
spec)
  ((Int, [Int]) -> Fm ()) -> [(Int, [Int])] -> Fm ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ([FmNode] -> [Sig] -> (Int, [Int]) -> Fm ()
mkMod [FmNode]
ops (FmSpec -> [Sig]
fmInd FmSpec
spec)) (FmGraph -> [(Int, [Int])]
fmGraph FmGraph
graph)
  [(Sig, FmNode)] -> Fm [(Sig, FmNode)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Sig, FmNode)] -> Fm [(Sig, FmNode)])
-> [(Sig, FmNode)] -> Fm [(Sig, FmNode)]
forall a b. (a -> b) -> a -> b
$ (Sig -> Int -> (Sig, FmNode)) -> [Sig] -> [Int] -> [(Sig, FmNode)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ([FmNode] -> Sig -> Int -> (Sig, FmNode)
forall b a. [b] -> a -> Int -> (a, b)
toOut [FmNode]
ops) (FmSpec -> [Sig]
fmOuts FmSpec
spec) (FmGraph -> [Int]
fmGraphOuts FmGraph
graph)
  where
    spec :: FmSpec
spec = FmSpec -> FmSpec
addDefaults FmSpec
spec'
    toOut :: [b] -> a -> Int -> (a, b)
toOut [b]
xs a
amp Int
n = (a
amp, [b]
xs [b] -> Int -> b
forall a. [a] -> Int -> a
!! Int
n)
    mkMod :: [FmNode] -> [Sig] -> (Int, [Int]) -> Fm ()
mkMod [FmNode]
ops [Sig]
ixs (Int
n, [Int]
ms) = ([FmNode]
ops [FmNode] -> Int -> FmNode
forall a. [a] -> Int -> a
!! Int
n) FmNode -> [(Sig, FmNode)] -> Fm ()
`fmod` ((Int -> (Sig, FmNode)) -> [Int] -> [(Sig, FmNode)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Int
m -> ([Sig]
ixs [Sig] -> Int -> Sig
forall a. [a] -> Int -> a
!! Int
m, [FmNode]
ops [FmNode] -> Int -> FmNode
forall a. [a] -> Int -> a
!! Int
m)) [Int]
ms)

addDefaults :: FmSpec -> FmSpec
addDefaults :: FmSpec -> FmSpec
addDefaults FmSpec
spec = FmSpec
spec
  { fmWave :: [Sig -> SE Sig]
fmWave = FmSpec -> [Sig -> SE Sig]
fmWave FmSpec
spec [Sig -> SE Sig] -> [Sig -> SE Sig] -> [Sig -> SE Sig]
forall a. [a] -> [a] -> [a]
++ (Sig -> SE Sig) -> [Sig -> SE Sig]
forall a. a -> [a]
repeat Sig -> SE Sig
rndOsc
  , fmCps :: [Sig]
fmCps  = FmSpec -> [Sig]
fmCps  FmSpec
spec [Sig] -> [Sig] -> [Sig]
forall a. [a] -> [a] -> [a]
++ Sig -> [Sig]
forall a. a -> [a]
repeat Sig
1
  , fmInd :: [Sig]
fmInd  = FmSpec -> [Sig]
fmInd  FmSpec
spec [Sig] -> [Sig] -> [Sig]
forall a. [a] -> [a] -> [a]
++ Sig -> [Sig]
forall a. a -> [a]
repeat Sig
1
  , fmOuts :: [Sig]
fmOuts = FmSpec -> [Sig]
fmOuts FmSpec
spec [Sig] -> [Sig] -> [Sig]
forall a. [a] -> [a] -> [a]
++ Sig -> [Sig]
forall a. a -> [a]
repeat Sig
1 }

{-|
>   +--+
>   6  |
>   +--+
>   5
>   |
> 2 4
> | |
> 1 3
> +---+
-}
dx_1 :: FmGraph
dx_1 :: FmGraph
dx_1 = FmGraph :: [(Int, [Int])] -> [Int] -> FmGraph
FmGraph
  { fmGraphOuts :: [Int]
fmGraphOuts = [Int
1, Int
3]
  , fmGraph :: [(Int, [Int])]
fmGraph =
    [ (Int
1, [Int
2])
    , (Int
3, [Int
4])
    , (Int
4, [Int
5])
    , (Int
5, [Int
6])
    , (Int
6, [Int
6]) ]}

{-|
>         6
>         |
>         5
>   +--+  |
> 2  |  4
> +--+  |
> 1     3
>   +-----+
-}
dx_2 :: FmGraph
dx_2 :: FmGraph
dx_2 = FmGraph :: [(Int, [Int])] -> [Int] -> FmGraph
FmGraph
  { fmGraphOuts :: [Int]
fmGraphOuts = [Int
1, Int
3]
  , fmGraph :: [(Int, [Int])]
fmGraph =
    [ (Int
1, [Int
2])
    , (Int
2, [Int
2])
    , (Int
3, [Int
4])
    , (Int
5, [Int
6]) ]}

{-|
>     +--+
> 3   6  |
> |   +--+
> 2   5
> | |
> 1   4
> +---+
-}
dx_3 :: FmGraph
dx_3 :: FmGraph
dx_3 = FmGraph :: [(Int, [Int])] -> [Int] -> FmGraph
FmGraph
  { fmGraphOuts :: [Int]
fmGraphOuts = [Int
1, Int
4]
  , fmGraph :: [(Int, [Int])]
fmGraph =
    [ (Int
1, [Int
2])
    , (Int
2, [Int
3])
    , (Int
4, [Int
5])
    , (Int
5, [Int
6])
    , (Int
6, [Int
6]) ]}

{-|
>     +--+
>   3 6  |
>   | |  |
>   2 5  |
>   | |  |
>   1 4  |
>   | +--+
>       +---+
-}
dx_4 :: FmGraph
dx_4 :: FmGraph
dx_4 = FmGraph :: [(Int, [Int])] -> [Int] -> FmGraph
FmGraph
  { fmGraphOuts :: [Int]
fmGraphOuts = [Int
1, Int
4]
  , fmGraph :: [(Int, [Int])]
fmGraph =
    [ (Int
1, [Int
2])
    , (Int
2, [Int
3])
    , (Int
4, [Int
5])
    , (Int
5, [Int
6])
    , (Int
6, [Int
4]) ]}

{-
dx12 = DxGraph
  { dxGraphOuts = [3, 1]
  , dxGraph =
    [ (3, [4, 5, 6])
    , (1, [2])
    , (2, [2]) ]}

-}