-- Copyright 2016 TensorFlow authors.
--
-- Licensed under the Apache License, Version 2.0 (the "License");
-- you may not use this file except in compliance with the License.
-- You may obtain a copy of the License at
--
--     http://www.apache.org/licenses/LICENSE-2.0
--
-- Unless required by applicable law or agreed to in writing, software
-- distributed under the License is distributed on an "AS IS" BASIS,
-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-- See the License for the specific language governing permissions and
-- limitations under the License.

{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE ScopedTypeVariables #-}

module TensorFlow.Output
    ( ControlNode(..)
    , Device(..)
    -- * Ops
    , NodeName(..)
    , OpDef(..)
    , opName
    , opType
    , opAttr
    , opInputs
    , opControlInputs
    , OpType(..)
    , OutputIx(..)
    , Output(..)
    , output
    , PendingNodeName(..)
    )  where

import Data.ProtoLens.Message(defMessage)
import qualified Data.Map.Strict as Map
import Data.String (IsString(..))
import Data.Text (Text)
import qualified Data.Text as Text
import Lens.Family2 (Lens')
import Lens.Family2.Unchecked (lens)
import Proto.Tensorflow.Core.Framework.AttrValue (AttrValue)
import TensorFlow.Types (Attribute, attrLens)

-- | A type of graph node which has no outputs. These nodes are
-- valuable for causing side effects when they are run.
newtype ControlNode = ControlNode { ControlNode -> NodeName
unControlNode :: NodeName }

-- | The type of op of a node in the graph.  This corresponds to the proto field
-- NodeDef.op.
newtype OpType = OpType { OpType -> Text
unOpType :: Text }
    deriving (OpType -> OpType -> Bool
(OpType -> OpType -> Bool)
-> (OpType -> OpType -> Bool) -> Eq OpType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OpType -> OpType -> Bool
$c/= :: OpType -> OpType -> Bool
== :: OpType -> OpType -> Bool
$c== :: OpType -> OpType -> Bool
Eq, Eq OpType
Eq OpType =>
(OpType -> OpType -> Ordering)
-> (OpType -> OpType -> Bool)
-> (OpType -> OpType -> Bool)
-> (OpType -> OpType -> Bool)
-> (OpType -> OpType -> Bool)
-> (OpType -> OpType -> OpType)
-> (OpType -> OpType -> OpType)
-> Ord OpType
OpType -> OpType -> Bool
OpType -> OpType -> Ordering
OpType -> OpType -> OpType
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: OpType -> OpType -> OpType
$cmin :: OpType -> OpType -> OpType
max :: OpType -> OpType -> OpType
$cmax :: OpType -> OpType -> OpType
>= :: OpType -> OpType -> Bool
$c>= :: OpType -> OpType -> Bool
> :: OpType -> OpType -> Bool
$c> :: OpType -> OpType -> Bool
<= :: OpType -> OpType -> Bool
$c<= :: OpType -> OpType -> Bool
< :: OpType -> OpType -> Bool
$c< :: OpType -> OpType -> Bool
compare :: OpType -> OpType -> Ordering
$ccompare :: OpType -> OpType -> Ordering
$cp1Ord :: Eq OpType
Ord, Int -> OpType -> ShowS
[OpType] -> ShowS
OpType -> String
(Int -> OpType -> ShowS)
-> (OpType -> String) -> ([OpType] -> ShowS) -> Show OpType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OpType] -> ShowS
$cshowList :: [OpType] -> ShowS
show :: OpType -> String
$cshow :: OpType -> String
showsPrec :: Int -> OpType -> ShowS
$cshowsPrec :: Int -> OpType -> ShowS
Show)

instance IsString OpType where
    fromString :: String -> OpType
fromString = Text -> OpType
OpType (Text -> OpType) -> (String -> Text) -> String -> OpType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack

-- | An output of a TensorFlow node.
data Output = Output {Output -> OutputIx
outputIndex :: !OutputIx, Output -> NodeName
outputNodeName :: !NodeName}
    deriving (Output -> Output -> Bool
(Output -> Output -> Bool)
-> (Output -> Output -> Bool) -> Eq Output
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Output -> Output -> Bool
$c/= :: Output -> Output -> Bool
== :: Output -> Output -> Bool
$c== :: Output -> Output -> Bool
Eq, Eq Output
Eq Output =>
(Output -> Output -> Ordering)
-> (Output -> Output -> Bool)
-> (Output -> Output -> Bool)
-> (Output -> Output -> Bool)
-> (Output -> Output -> Bool)
-> (Output -> Output -> Output)
-> (Output -> Output -> Output)
-> Ord Output
Output -> Output -> Bool
Output -> Output -> Ordering
Output -> Output -> Output
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Output -> Output -> Output
$cmin :: Output -> Output -> Output
max :: Output -> Output -> Output
$cmax :: Output -> Output -> Output
>= :: Output -> Output -> Bool
$c>= :: Output -> Output -> Bool
> :: Output -> Output -> Bool
$c> :: Output -> Output -> Bool
<= :: Output -> Output -> Bool
$c<= :: Output -> Output -> Bool
< :: Output -> Output -> Bool
$c< :: Output -> Output -> Bool
compare :: Output -> Output -> Ordering
$ccompare :: Output -> Output -> Ordering
$cp1Ord :: Eq Output
Ord, Int -> Output -> ShowS
[Output] -> ShowS
Output -> String
(Int -> Output -> ShowS)
-> (Output -> String) -> ([Output] -> ShowS) -> Show Output
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Output] -> ShowS
$cshowList :: [Output] -> ShowS
show :: Output -> String
$cshow :: Output -> String
showsPrec :: Int -> Output -> ShowS
$cshowsPrec :: Int -> Output -> ShowS
Show)

output :: OutputIx -> NodeName -> Output
output :: OutputIx -> NodeName -> Output
output = OutputIx -> NodeName -> Output
Output

newtype OutputIx = OutputIx { OutputIx -> Int
unOutputIx :: Int }
    deriving (OutputIx -> OutputIx -> Bool
(OutputIx -> OutputIx -> Bool)
-> (OutputIx -> OutputIx -> Bool) -> Eq OutputIx
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OutputIx -> OutputIx -> Bool
$c/= :: OutputIx -> OutputIx -> Bool
== :: OutputIx -> OutputIx -> Bool
$c== :: OutputIx -> OutputIx -> Bool
Eq, Eq OutputIx
Eq OutputIx =>
(OutputIx -> OutputIx -> Ordering)
-> (OutputIx -> OutputIx -> Bool)
-> (OutputIx -> OutputIx -> Bool)
-> (OutputIx -> OutputIx -> Bool)
-> (OutputIx -> OutputIx -> Bool)
-> (OutputIx -> OutputIx -> OutputIx)
-> (OutputIx -> OutputIx -> OutputIx)
-> Ord OutputIx
OutputIx -> OutputIx -> Bool
OutputIx -> OutputIx -> Ordering
OutputIx -> OutputIx -> OutputIx
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: OutputIx -> OutputIx -> OutputIx
$cmin :: OutputIx -> OutputIx -> OutputIx
max :: OutputIx -> OutputIx -> OutputIx
$cmax :: OutputIx -> OutputIx -> OutputIx
>= :: OutputIx -> OutputIx -> Bool
$c>= :: OutputIx -> OutputIx -> Bool
> :: OutputIx -> OutputIx -> Bool
$c> :: OutputIx -> OutputIx -> Bool
<= :: OutputIx -> OutputIx -> Bool
$c<= :: OutputIx -> OutputIx -> Bool
< :: OutputIx -> OutputIx -> Bool
$c< :: OutputIx -> OutputIx -> Bool
compare :: OutputIx -> OutputIx -> Ordering
$ccompare :: OutputIx -> OutputIx -> Ordering
$cp1Ord :: Eq OutputIx
Ord, Integer -> OutputIx
OutputIx -> OutputIx
OutputIx -> OutputIx -> OutputIx
(OutputIx -> OutputIx -> OutputIx)
-> (OutputIx -> OutputIx -> OutputIx)
-> (OutputIx -> OutputIx -> OutputIx)
-> (OutputIx -> OutputIx)
-> (OutputIx -> OutputIx)
-> (OutputIx -> OutputIx)
-> (Integer -> OutputIx)
-> Num OutputIx
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> OutputIx
$cfromInteger :: Integer -> OutputIx
signum :: OutputIx -> OutputIx
$csignum :: OutputIx -> OutputIx
abs :: OutputIx -> OutputIx
$cabs :: OutputIx -> OutputIx
negate :: OutputIx -> OutputIx
$cnegate :: OutputIx -> OutputIx
* :: OutputIx -> OutputIx -> OutputIx
$c* :: OutputIx -> OutputIx -> OutputIx
- :: OutputIx -> OutputIx -> OutputIx
$c- :: OutputIx -> OutputIx -> OutputIx
+ :: OutputIx -> OutputIx -> OutputIx
$c+ :: OutputIx -> OutputIx -> OutputIx
Num, Int -> OutputIx
OutputIx -> Int
OutputIx -> [OutputIx]
OutputIx -> OutputIx
OutputIx -> OutputIx -> [OutputIx]
OutputIx -> OutputIx -> OutputIx -> [OutputIx]
(OutputIx -> OutputIx)
-> (OutputIx -> OutputIx)
-> (Int -> OutputIx)
-> (OutputIx -> Int)
-> (OutputIx -> [OutputIx])
-> (OutputIx -> OutputIx -> [OutputIx])
-> (OutputIx -> OutputIx -> [OutputIx])
-> (OutputIx -> OutputIx -> OutputIx -> [OutputIx])
-> Enum OutputIx
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: OutputIx -> OutputIx -> OutputIx -> [OutputIx]
$cenumFromThenTo :: OutputIx -> OutputIx -> OutputIx -> [OutputIx]
enumFromTo :: OutputIx -> OutputIx -> [OutputIx]
$cenumFromTo :: OutputIx -> OutputIx -> [OutputIx]
enumFromThen :: OutputIx -> OutputIx -> [OutputIx]
$cenumFromThen :: OutputIx -> OutputIx -> [OutputIx]
enumFrom :: OutputIx -> [OutputIx]
$cenumFrom :: OutputIx -> [OutputIx]
fromEnum :: OutputIx -> Int
$cfromEnum :: OutputIx -> Int
toEnum :: Int -> OutputIx
$ctoEnum :: Int -> OutputIx
pred :: OutputIx -> OutputIx
$cpred :: OutputIx -> OutputIx
succ :: OutputIx -> OutputIx
$csucc :: OutputIx -> OutputIx
Enum, Int -> OutputIx -> ShowS
[OutputIx] -> ShowS
OutputIx -> String
(Int -> OutputIx -> ShowS)
-> (OutputIx -> String) -> ([OutputIx] -> ShowS) -> Show OutputIx
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OutputIx] -> ShowS
$cshowList :: [OutputIx] -> ShowS
show :: OutputIx -> String
$cshow :: OutputIx -> String
showsPrec :: Int -> OutputIx -> ShowS
$cshowsPrec :: Int -> OutputIx -> ShowS
Show)

-- | A device that a node can be assigned to.
-- There's a naming convention where the device names
-- are constructed from job and replica names.
newtype Device = Device {Device -> Text
deviceName :: Text}
    deriving (Device -> Device -> Bool
(Device -> Device -> Bool)
-> (Device -> Device -> Bool) -> Eq Device
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Device -> Device -> Bool
$c/= :: Device -> Device -> Bool
== :: Device -> Device -> Bool
$c== :: Device -> Device -> Bool
Eq, Eq Device
Eq Device =>
(Device -> Device -> Ordering)
-> (Device -> Device -> Bool)
-> (Device -> Device -> Bool)
-> (Device -> Device -> Bool)
-> (Device -> Device -> Bool)
-> (Device -> Device -> Device)
-> (Device -> Device -> Device)
-> Ord Device
Device -> Device -> Bool
Device -> Device -> Ordering
Device -> Device -> Device
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Device -> Device -> Device
$cmin :: Device -> Device -> Device
max :: Device -> Device -> Device
$cmax :: Device -> Device -> Device
>= :: Device -> Device -> Bool
$c>= :: Device -> Device -> Bool
> :: Device -> Device -> Bool
$c> :: Device -> Device -> Bool
<= :: Device -> Device -> Bool
$c<= :: Device -> Device -> Bool
< :: Device -> Device -> Bool
$c< :: Device -> Device -> Bool
compare :: Device -> Device -> Ordering
$ccompare :: Device -> Device -> Ordering
$cp1Ord :: Eq Device
Ord, String -> Device
(String -> Device) -> IsString Device
forall a. (String -> a) -> IsString a
fromString :: String -> Device
$cfromString :: String -> Device
IsString)

instance Show Device where
    show :: Device -> String
show (Device d :: Text
d) = Text -> String
forall a. Show a => a -> String
show Text
d

-- | Op definition. This corresponds somewhat to the 'NodeDef' proto.
data OpDef = OpDef
    { OpDef -> PendingNodeName
_opName :: !PendingNodeName
    , OpDef -> OpType
_opType :: !OpType
    , OpDef -> Map Text AttrValue
_opAttrs :: !(Map.Map Text AttrValue)
    , OpDef -> [Output]
_opInputs :: [Output]
    , OpDef -> [NodeName]
_opControlInputs :: [NodeName]
    }  deriving (OpDef -> OpDef -> Bool
(OpDef -> OpDef -> Bool) -> (OpDef -> OpDef -> Bool) -> Eq OpDef
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OpDef -> OpDef -> Bool
$c/= :: OpDef -> OpDef -> Bool
== :: OpDef -> OpDef -> Bool
$c== :: OpDef -> OpDef -> Bool
Eq, Eq OpDef
Eq OpDef =>
(OpDef -> OpDef -> Ordering)
-> (OpDef -> OpDef -> Bool)
-> (OpDef -> OpDef -> Bool)
-> (OpDef -> OpDef -> Bool)
-> (OpDef -> OpDef -> Bool)
-> (OpDef -> OpDef -> OpDef)
-> (OpDef -> OpDef -> OpDef)
-> Ord OpDef
OpDef -> OpDef -> Bool
OpDef -> OpDef -> Ordering
OpDef -> OpDef -> OpDef
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: OpDef -> OpDef -> OpDef
$cmin :: OpDef -> OpDef -> OpDef
max :: OpDef -> OpDef -> OpDef
$cmax :: OpDef -> OpDef -> OpDef
>= :: OpDef -> OpDef -> Bool
$c>= :: OpDef -> OpDef -> Bool
> :: OpDef -> OpDef -> Bool
$c> :: OpDef -> OpDef -> Bool
<= :: OpDef -> OpDef -> Bool
$c<= :: OpDef -> OpDef -> Bool
< :: OpDef -> OpDef -> Bool
$c< :: OpDef -> OpDef -> Bool
compare :: OpDef -> OpDef -> Ordering
$ccompare :: OpDef -> OpDef -> Ordering
$cp1Ord :: Eq OpDef
Ord)

-- | The name specified for an unrendered Op.  If an Op has an
-- ImplicitName, it will be assigned based on the opType plus a
-- unique identifier.  Does not contain the "scope" prefix.
data PendingNodeName = ExplicitName !Text | ImplicitName
    deriving (PendingNodeName -> PendingNodeName -> Bool
(PendingNodeName -> PendingNodeName -> Bool)
-> (PendingNodeName -> PendingNodeName -> Bool)
-> Eq PendingNodeName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PendingNodeName -> PendingNodeName -> Bool
$c/= :: PendingNodeName -> PendingNodeName -> Bool
== :: PendingNodeName -> PendingNodeName -> Bool
$c== :: PendingNodeName -> PendingNodeName -> Bool
Eq, Eq PendingNodeName
Eq PendingNodeName =>
(PendingNodeName -> PendingNodeName -> Ordering)
-> (PendingNodeName -> PendingNodeName -> Bool)
-> (PendingNodeName -> PendingNodeName -> Bool)
-> (PendingNodeName -> PendingNodeName -> Bool)
-> (PendingNodeName -> PendingNodeName -> Bool)
-> (PendingNodeName -> PendingNodeName -> PendingNodeName)
-> (PendingNodeName -> PendingNodeName -> PendingNodeName)
-> Ord PendingNodeName
PendingNodeName -> PendingNodeName -> Bool
PendingNodeName -> PendingNodeName -> Ordering
PendingNodeName -> PendingNodeName -> PendingNodeName
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PendingNodeName -> PendingNodeName -> PendingNodeName
$cmin :: PendingNodeName -> PendingNodeName -> PendingNodeName
max :: PendingNodeName -> PendingNodeName -> PendingNodeName
$cmax :: PendingNodeName -> PendingNodeName -> PendingNodeName
>= :: PendingNodeName -> PendingNodeName -> Bool
$c>= :: PendingNodeName -> PendingNodeName -> Bool
> :: PendingNodeName -> PendingNodeName -> Bool
$c> :: PendingNodeName -> PendingNodeName -> Bool
<= :: PendingNodeName -> PendingNodeName -> Bool
$c<= :: PendingNodeName -> PendingNodeName -> Bool
< :: PendingNodeName -> PendingNodeName -> Bool
$c< :: PendingNodeName -> PendingNodeName -> Bool
compare :: PendingNodeName -> PendingNodeName -> Ordering
$ccompare :: PendingNodeName -> PendingNodeName -> Ordering
$cp1Ord :: Eq PendingNodeName
Ord, Int -> PendingNodeName -> ShowS
[PendingNodeName] -> ShowS
PendingNodeName -> String
(Int -> PendingNodeName -> ShowS)
-> (PendingNodeName -> String)
-> ([PendingNodeName] -> ShowS)
-> Show PendingNodeName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PendingNodeName] -> ShowS
$cshowList :: [PendingNodeName] -> ShowS
show :: PendingNodeName -> String
$cshow :: PendingNodeName -> String
showsPrec :: Int -> PendingNodeName -> ShowS
$cshowsPrec :: Int -> PendingNodeName -> ShowS
Show)

instance IsString PendingNodeName where
    fromString :: String -> PendingNodeName
fromString = Text -> PendingNodeName
ExplicitName (Text -> PendingNodeName)
-> (String -> Text) -> String -> PendingNodeName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a. IsString a => String -> a
fromString

-- | The name of a node in the graph.  This corresponds to the proto field
-- NodeDef.name.  Includes the scope prefix (if any) and a unique identifier
-- (if the node was implicitly named).
newtype NodeName = NodeName { NodeName -> Text
unNodeName :: Text }
    deriving (NodeName -> NodeName -> Bool
(NodeName -> NodeName -> Bool)
-> (NodeName -> NodeName -> Bool) -> Eq NodeName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NodeName -> NodeName -> Bool
$c/= :: NodeName -> NodeName -> Bool
== :: NodeName -> NodeName -> Bool
$c== :: NodeName -> NodeName -> Bool
Eq, Eq NodeName
Eq NodeName =>
(NodeName -> NodeName -> Ordering)
-> (NodeName -> NodeName -> Bool)
-> (NodeName -> NodeName -> Bool)
-> (NodeName -> NodeName -> Bool)
-> (NodeName -> NodeName -> Bool)
-> (NodeName -> NodeName -> NodeName)
-> (NodeName -> NodeName -> NodeName)
-> Ord NodeName
NodeName -> NodeName -> Bool
NodeName -> NodeName -> Ordering
NodeName -> NodeName -> NodeName
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: NodeName -> NodeName -> NodeName
$cmin :: NodeName -> NodeName -> NodeName
max :: NodeName -> NodeName -> NodeName
$cmax :: NodeName -> NodeName -> NodeName
>= :: NodeName -> NodeName -> Bool
$c>= :: NodeName -> NodeName -> Bool
> :: NodeName -> NodeName -> Bool
$c> :: NodeName -> NodeName -> Bool
<= :: NodeName -> NodeName -> Bool
$c<= :: NodeName -> NodeName -> Bool
< :: NodeName -> NodeName -> Bool
$c< :: NodeName -> NodeName -> Bool
compare :: NodeName -> NodeName -> Ordering
$ccompare :: NodeName -> NodeName -> Ordering
$cp1Ord :: Eq NodeName
Ord, Int -> NodeName -> ShowS
[NodeName] -> ShowS
NodeName -> String
(Int -> NodeName -> ShowS)
-> (NodeName -> String) -> ([NodeName] -> ShowS) -> Show NodeName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NodeName] -> ShowS
$cshowList :: [NodeName] -> ShowS
show :: NodeName -> String
$cshow :: NodeName -> String
showsPrec :: Int -> NodeName -> ShowS
$cshowsPrec :: Int -> NodeName -> ShowS
Show)

opName :: Lens' OpDef PendingNodeName
opName :: LensLike' f OpDef PendingNodeName
opName = (OpDef -> PendingNodeName)
-> (OpDef -> PendingNodeName -> OpDef)
-> Lens OpDef OpDef PendingNodeName PendingNodeName
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens OpDef -> PendingNodeName
_opName (\o :: OpDef
o x :: PendingNodeName
x -> OpDef
o {_opName :: PendingNodeName
_opName = PendingNodeName
x})

opType :: Lens' OpDef OpType
opType :: LensLike' f OpDef OpType
opType = (OpDef -> OpType)
-> (OpDef -> OpType -> OpDef) -> Lens OpDef OpDef OpType OpType
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens OpDef -> OpType
_opType (\o :: OpDef
o x :: OpType
x -> OpDef
o { _opType :: OpType
_opType = OpType
x})

opAttr :: Attribute a => Text -> Lens' OpDef a
opAttr :: Text -> Lens' OpDef a
opAttr n :: Text
n = (OpDef -> Map Text AttrValue)
-> (OpDef -> Map Text AttrValue -> OpDef)
-> Lens OpDef OpDef (Map Text AttrValue) (Map Text AttrValue)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens OpDef -> Map Text AttrValue
_opAttrs (\o :: OpDef
o x :: Map Text AttrValue
x -> OpDef
o {_opAttrs :: Map Text AttrValue
_opAttrs = Map Text AttrValue
x})
              LensLike f OpDef OpDef (Map Text AttrValue) (Map Text AttrValue)
-> ((a -> f a) -> Map Text AttrValue -> f (Map Text AttrValue))
-> (a -> f a)
-> OpDef
-> f OpDef
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Text AttrValue -> AttrValue)
-> (Map Text AttrValue -> AttrValue -> Map Text AttrValue)
-> Lens
     (Map Text AttrValue) (Map Text AttrValue) AttrValue AttrValue
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (AttrValue -> Text -> Map Text AttrValue -> AttrValue
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault AttrValue
forall msg. Message msg => msg
defMessage Text
n) ((AttrValue -> Map Text AttrValue -> Map Text AttrValue)
-> Map Text AttrValue -> AttrValue -> Map Text AttrValue
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Text -> AttrValue -> Map Text AttrValue -> Map Text AttrValue
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
n))
              LensLike
  f (Map Text AttrValue) (Map Text AttrValue) AttrValue AttrValue
-> ((a -> f a) -> AttrValue -> f AttrValue)
-> (a -> f a)
-> Map Text AttrValue
-> f (Map Text AttrValue)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> f a) -> AttrValue -> f AttrValue
forall a. Attribute a => Lens' AttrValue a
attrLens

opInputs :: Lens' OpDef [Output]
opInputs :: LensLike' f OpDef [Output]
opInputs = (OpDef -> [Output])
-> (OpDef -> [Output] -> OpDef)
-> Lens OpDef OpDef [Output] [Output]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens OpDef -> [Output]
_opInputs (\o :: OpDef
o x :: [Output]
x -> OpDef
o {_opInputs :: [Output]
_opInputs = [Output]
x})

opControlInputs :: Lens' OpDef [NodeName]
opControlInputs :: LensLike' f OpDef [NodeName]
opControlInputs = (OpDef -> [NodeName])
-> (OpDef -> [NodeName] -> OpDef)
-> Lens OpDef OpDef [NodeName] [NodeName]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens OpDef -> [NodeName]
_opControlInputs (\o :: OpDef
o x :: [NodeName]
x -> OpDef
o {_opControlInputs :: [NodeName]
_opControlInputs = [NodeName]
x})

-- TODO(gnezdo): IsString instance is weird and we should move that
-- code into a Build function
instance IsString Output where
    fromString :: String -> Output
fromString s :: String
s = case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==':') String
s of
        (n :: String
n, ':':ixStr :: String
ixStr) | [(ix :: Integer
ix, String
"" :: String)] <- String -> [(Integer, String)]
forall a. Read a => String -> a
read String
ixStr
                         -> OutputIx -> NodeName -> Output
Output (Integer -> OutputIx
forall a. Num a => Integer -> a
fromInteger Integer
ix) (NodeName -> Output) -> NodeName -> Output
forall a b. (a -> b) -> a -> b
$ String -> NodeName
assigned String
n
        _ -> OutputIx -> NodeName -> Output
Output 0 (NodeName -> Output) -> NodeName -> Output
forall a b. (a -> b) -> a -> b
$ String -> NodeName
assigned String
s
     where assigned :: String -> NodeName
assigned = Text -> NodeName
NodeName (Text -> NodeName) -> (String -> Text) -> String -> NodeName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack