tensorflow (empty) → 0.1.0.0

raw patch · 18 files changed

+2888/−0 lines, 18 filesdep +HUnitdep +asyncdep +attoparsecsetup-changed

Dependencies added: HUnit, async, attoparsec, base, bytestring, containers, data-default, exceptions, fgl, lens-family, mainland-pretty, mtl, proto-lens, proto-lens-protoc, semigroups, split, temporary, tensorflow, tensorflow-proto, test-framework, test-framework-hunit, test-framework-quickcheck2, text, transformers, vector

Files

• LICENSE +203/−0
• Setup.hs +3/−0
• src/TensorFlow/Build.hs +339/−0
• src/TensorFlow/BuildOp.hs +306/−0
• src/TensorFlow/ControlFlow.hs +50/−0
• src/TensorFlow/Core.hs +92/−0
• src/TensorFlow/Internal/FFI.hs +264/−0
• src/TensorFlow/Internal/Raw.chs +158/−0
• src/TensorFlow/Internal/VarInt.hs +50/−0
• src/TensorFlow/Nodes.hs +140/−0
• src/TensorFlow/Orphans.hs +46/−0
• src/TensorFlow/Output.hs +128/−0
• src/TensorFlow/Session.hs +211/−0
• src/TensorFlow/Tensor.hs +193/−0
• src/TensorFlow/Types.hs +539/−0
• tensorflow.cabal +94/−0
• tests/FFITest.hs +39/−0
• tests/VarIntTest.hs +33/−0

@@ -0,0 +1,203 @@+Copyright 2016 The TensorFlow Authors.  All rights reserved.++                                 Apache License+                           Version 2.0, January 2004+                        http://www.apache.org/licenses/++   TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION++   1. Definitions.++      "License" shall mean the terms and conditions for use, reproduction,+      and distribution as defined by Sections 1 through 9 of this document.++      "Licensor" shall mean the copyright owner or entity authorized by+      the copyright owner that is granting the License.++      "Legal Entity" shall mean the union of the acting entity and all+      other entities that control, are controlled by, or are under common+      control with that entity. For the purposes of this definition,+      "control" means (i) the power, direct or indirect, to cause the+      direction or management of such entity, whether by contract or+      otherwise, or (ii) ownership of fifty percent (50%) or more of the+      outstanding shares, or (iii) beneficial ownership of such entity.++      "You" (or "Your") shall mean an individual or Legal Entity+      exercising permissions granted by this License.++      "Source" form shall mean the preferred form for making modifications,+      including but not limited to software source code, documentation+      source, and configuration files.++      "Object" form shall mean any form resulting from mechanical+      transformation or translation of a Source form, including but+      not limited to compiled object code, generated documentation,+      and conversions to other media types.++      "Work" shall mean the work of authorship, whether in Source or+      Object form, made available under the License, as indicated by a+      copyright notice that is included in or attached to the work+      (an example is provided in the Appendix below).++      "Derivative Works" shall mean any work, whether in Source or Object+      form, that is based on (or derived from) the Work and for which the+      editorial revisions, annotations, elaborations, or other modifications+      represent, as a whole, an original work of authorship. For the purposes+      of this License, Derivative Works shall not include works that remain+      separable from, or merely link (or bind by name) to the interfaces of,+      the Work and Derivative Works thereof.++      "Contribution" shall mean any work of authorship, including+      the original version of the Work and any modifications or additions+      to that Work or Derivative Works thereof, that is intentionally+      submitted to Licensor for inclusion in the Work by the copyright owner+      or by an individual or Legal Entity authorized to submit on behalf of+      the copyright owner. For the purposes of this definition, "submitted"+      means any form of electronic, verbal, or written communication sent+      to the Licensor or its representatives, including but not limited to+      communication on electronic mailing lists, source code control systems,+      and issue tracking systems that are managed by, or on behalf of, the+      Licensor for the purpose of discussing and improving the Work, but+      excluding communication that is conspicuously marked or otherwise+      designated in writing by the copyright owner as "Not a Contribution."++      "Contributor" shall mean Licensor and any individual or Legal Entity+      on behalf of whom a Contribution has been received by Licensor and+      subsequently incorporated within the Work.++   2. Grant of Copyright License. Subject to the terms and conditions of+      this License, each Contributor hereby grants to You a perpetual,+      worldwide, non-exclusive, no-charge, royalty-free, irrevocable+      copyright license to reproduce, prepare Derivative Works of,+      publicly display, publicly perform, sublicense, and distribute the+      Work and such Derivative Works in Source or Object form.++   3. Grant of Patent License. Subject to the terms and conditions of+      this License, each Contributor hereby grants to You a perpetual,+      worldwide, non-exclusive, no-charge, royalty-free, irrevocable+      (except as stated in this section) patent license to make, have made,+      use, offer to sell, sell, import, and otherwise transfer the Work,+      where such license applies only to those patent claims licensable+      by such Contributor that are necessarily infringed by their+      Contribution(s) alone or by combination of their Contribution(s)+      with the Work to which such Contribution(s) was submitted. If You+      institute patent litigation against any entity (including a+      cross-claim or counterclaim in a lawsuit) alleging that the Work+      or a Contribution incorporated within the Work constitutes direct+      or contributory patent infringement, then any patent licenses+      granted to You under this License for that Work shall terminate+      as of the date such litigation is filed.++   4. Redistribution. You may reproduce and distribute copies of the+      Work or Derivative Works thereof in any medium, with or without+      modifications, and in Source or Object form, provided that You+      meet the following conditions:++      (a) You must give any other recipients of the Work or+          Derivative Works a copy of this License; and++      (b) You must cause any modified files to carry prominent notices+          stating that You changed the files; and++      (c) You must retain, in the Source form of any Derivative Works+          that You distribute, all copyright, patent, trademark, and+          attribution notices from the Source form of the Work,+          excluding those notices that do not pertain to any part of+          the Derivative Works; and++      (d) If the Work includes a "NOTICE" text file as part of its+          distribution, then any Derivative Works that You distribute must+          include a readable copy of the attribution notices contained+          within such NOTICE file, excluding those notices that do not+          pertain to any part of the Derivative Works, in at least one+          of the following places: within a NOTICE text file distributed+          as part of the Derivative Works; within the Source form or+          documentation, if provided along with the Derivative Works; or,+          within a display generated by the Derivative Works, if and+          wherever such third-party notices normally appear. The contents+          of the NOTICE file are for informational purposes only and+          do not modify the License. You may add Your own attribution+          notices within Derivative Works that You distribute, alongside+          or as an addendum to the NOTICE text from the Work, provided+          that such additional attribution notices cannot be construed+          as modifying the License.++      You may add Your own copyright statement to Your modifications and+      may provide additional or different license terms and conditions+      for use, reproduction, or distribution of Your modifications, or+      for any such Derivative Works as a whole, provided Your use,+      reproduction, and distribution of the Work otherwise complies with+      the conditions stated in this License.++   5. Submission of Contributions. Unless You explicitly state otherwise,+      any Contribution intentionally submitted for inclusion in the Work+      by You to the Licensor shall be under the terms and conditions of+      this License, without any additional terms or conditions.+      Notwithstanding the above, nothing herein shall supersede or modify+      the terms of any separate license agreement you may have executed+      with Licensor regarding such Contributions.++   6. Trademarks. This License does not grant permission to use the trade+      names, trademarks, service marks, or product names of the Licensor,+      except as required for reasonable and customary use in describing the+      origin of the Work and reproducing the content of the NOTICE file.++   7. Disclaimer of Warranty. Unless required by applicable law or+      agreed to in writing, Licensor provides the Work (and each+      Contributor provides its Contributions) on an "AS IS" BASIS,+      WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or+      implied, including, without limitation, any warranties or conditions+      of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A+      PARTICULAR PURPOSE. You are solely responsible for determining the+      appropriateness of using or redistributing the Work and assume any+      risks associated with Your exercise of permissions under this License.++   8. Limitation of Liability. In no event and under no legal theory,+      whether in tort (including negligence), contract, or otherwise,+      unless required by applicable law (such as deliberate and grossly+      negligent acts) or agreed to in writing, shall any Contributor be+      liable to You for damages, including any direct, indirect, special,+      incidental, or consequential damages of any character arising as a+      result of this License or out of the use or inability to use the+      Work (including but not limited to damages for loss of goodwill,+      work stoppage, computer failure or malfunction, or any and all+      other commercial damages or losses), even if such Contributor+      has been advised of the possibility of such damages.++   9. Accepting Warranty or Additional Liability. While redistributing+      the Work or Derivative Works thereof, You may choose to offer,+      and charge a fee for, acceptance of support, warranty, indemnity,+      or other liability obligations and/or rights consistent with this+      License. However, in accepting such obligations, You may act only+      on Your own behalf and on Your sole responsibility, not on behalf+      of any other Contributor, and only if You agree to indemnify,+      defend, and hold each Contributor harmless for any liability+      incurred by, or claims asserted against, such Contributor by reason+      of your accepting any such warranty or additional liability.++   END OF TERMS AND CONDITIONS++   APPENDIX: How to apply the Apache License to your work.++      To apply the Apache License to your work, attach the following+      boilerplate notice, with the fields enclosed by brackets "[]"+      replaced with your own identifying information. (Don't include+      the brackets!)  The text should be enclosed in the appropriate+      comment syntax for the file format. We also recommend that a+      file or class name and description of purpose be included on the+      same "printed page" as the copyright notice for easier+      identification within third-party archives.++   Copyright 2016, The 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.

@@ -0,0 +1,3 @@+import Distribution.Simple++main = defaultMain

@@ -0,0 +1,339 @@+-- 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 FlexibleInstances #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE TypeFamilies #-}+module TensorFlow.Build+    ( -- * Graph node types+      ControlNode(..)+    , Unique+    -- * Ops+    , explicitName+    , implicitName+    , opDef+    , opDefWithName+    , opName+    , opType+    , opAttr+    , opInputs+    , opControlInputs+    -- * The Build monad+    , GraphState+    , renderedNodeDefs+    , BuildT+    , Build+    , MonadBuild(..)+    , addInitializer+    , hoistBuildT+    , evalBuildT+    , runBuildT+    , asGraphDef+    , addGraphDef+    , flushInitializers+    , flushNodeBuffer+    , summaries+    -- * Creating and looking up Ops+    , getOrAddOp+    , addNewOp+    , encodeOutput+    , lookupNode+    -- * Modifying all nodes in a Build action+    , withStateLens+    , withDevice+    , withNameScope+    , withNodeDependencies+    ) where++import Control.Monad.Catch (MonadThrow, MonadCatch, MonadMask)+import Control.Monad.Fix (MonadFix(..))+import Control.Monad.IO.Class (MonadIO(..))+import Control.Monad.Trans.Class (MonadTrans(..))+import Control.Monad.Trans.State.Strict(StateT(..), mapStateT, evalStateT)+import Data.Default (def)+import Data.Functor.Identity (Identity(..))+import qualified Data.Map.Strict as Map+import Data.Monoid ((<>))+import qualified Data.Set as Set+import Data.Set (Set)+import Data.String (IsString(..))+import Data.Text (Text)+import qualified Data.Text as Text+import Lens.Family2 (Lens', (.~), (^.), (&))+import Lens.Family2.State.Strict (MonadState, use, uses, (.=), (<>=), (%=))+import Lens.Family2.Unchecked (lens)+import Proto.Tensorflow.Core.Framework.Graph+    ( GraphDef+    , node+    )+import Proto.Tensorflow.Core.Framework.NodeDef+    ( NodeDef+    , attr+    , input+    , device+    , name+    , op+    )++import TensorFlow.Orphans ()+import TensorFlow.Output++newtype Unique = Unique Int+    deriving (Eq, Ord, Enum)++--------------++implicitName :: PendingNodeName+implicitName = ImplicitName++explicitName :: Text -> PendingNodeName+explicitName = ExplicitName++newtype Scope = Scope {unScope :: Text}+    deriving (Eq, Ord, IsString)++instance Show Scope where+    show = show . unScope++opDef :: OpType -> OpDef+opDef = opDefWithName ImplicitName++opDefWithName :: PendingNodeName -> OpType -> OpDef+opDefWithName n t = OpDef+    { _opName = n+    , _opType = t+    , _opAttrs = Map.empty+    , _opInputs = []+    , _opControlInputs = []+    }++data GraphState = GraphState+    { _renderedNodes :: !(Map.Map PendingNode NodeDef)+        -- ^ Nodes which have been rendered.  Keeps track of the unique ID we+        -- assign each implicitly-named node.  Also prevents us from adding the+        -- same node (implicit or explicit) more than once to the nodeBuffer.+    , _renderedNodeDefs :: !(Map.Map NodeName NodeDef)+        -- ^ The NodeDefs of nodes which have been rendered. Used by the+        -- Gradient module to inspect the node graph.+    , _nodeBuffer :: [NodeDef]+        -- ^ A list of nodes that should be passed to TensorFlow during+        -- the next call to Session.extend (TF_ExtendGraph).+    , _nextUnique :: !Unique+        -- ^ Unique ID for the next node+    -- TODO(judahjacobson): watch for clashes between auto and user names.+    , _defaultDevice :: !(Maybe Device)+    , _currentScope :: [Scope]+    , _defaultControlInputs :: !(Set NodeName)+    , _initializationNodes  :: [NodeName]+      -- ^ The nodes to run next time a TF.run is issued, typically+      -- variable initializers.+    , _summaries :: [Output]+      -- ^ The tensors for summary (ByteString type)+    }++-- | A node definition without its final name.  Used as a key in the+-- "renderedNodes" map.+-- The NodeDef contained inside has an empty "name" field.+data PendingNode = PendingNode [Scope] !PendingNodeName !NodeDef+    deriving (Eq, Ord)++-- Returns an _incomplete_ NodeDef. The name is fixed by addNewOpFromPending.+pendingNodeDef :: PendingNode -> NodeDef+pendingNodeDef (PendingNode _ _ n) = n++initGraphState :: GraphState+initGraphState =+    GraphState Map.empty Map.empty [] (Unique 0) Nothing [] Set.empty [] []++renderedNodes :: Lens' GraphState (Map.Map PendingNode NodeDef)+renderedNodes = lens _renderedNodes (\g x -> g { _renderedNodes = x })++renderedNodeDefs :: Lens' GraphState (Map.Map NodeName NodeDef)+renderedNodeDefs = lens _renderedNodeDefs (\g x -> g { _renderedNodeDefs = x })++nodeBuffer :: Lens' GraphState [NodeDef]+nodeBuffer = lens _nodeBuffer (\g x -> g { _nodeBuffer = x })++nextUnique :: Lens' GraphState Unique+nextUnique = lens _nextUnique (\g x -> g { _nextUnique = x })++defaultDevice :: Lens' GraphState (Maybe Device)+defaultDevice = lens _defaultDevice (\g x -> g { _defaultDevice = x })++currentScope :: Lens' GraphState [Scope]+currentScope = lens _currentScope (\g x -> g { _currentScope = x })++defaultControlInputs :: Lens' GraphState (Set NodeName)+defaultControlInputs = lens _defaultControlInputs+                          (\g x -> g { _defaultControlInputs = x })++initializationNodes :: Lens' GraphState [NodeName]+initializationNodes = lens _initializationNodes (\g x -> g { _initializationNodes = x })++summaries :: Lens' GraphState [Output]+summaries = lens _summaries (\g x -> g { _summaries = x })++-- | An action for building nodes in a TensorFlow graph.+-- Used to manage build state internally as part of the @Session@ monad.+newtype BuildT m a = BuildT (StateT GraphState m a)+    deriving (Functor, Applicative, Monad, MonadIO, MonadTrans,+              MonadState GraphState, MonadThrow, MonadCatch, MonadMask,+              MonadFix)++-- | An action for building nodes in a TensorFlow graph.+type Build = BuildT Identity++-- | This is Control.Monad.Morph.hoist sans the dependency.+hoistBuildT :: (forall a . m a -> n a) -> BuildT m b -> BuildT n b+hoistBuildT f (BuildT m) = BuildT $ mapStateT f m++runBuildT :: BuildT m a -> m (a, GraphState)+runBuildT (BuildT f) = runStateT f initGraphState++evalBuildT :: Monad m => BuildT m a -> m a+evalBuildT (BuildT f) = evalStateT f initGraphState++-- | Lift a 'Build' action into a monad, including any explicit op renderings.+class Monad m => MonadBuild m where+    build :: Build a -> m a++instance Monad m => MonadBuild (BuildT m) where+    build = hoistBuildT $ return . runIdentity++-- | Get all the NodeDefs that have accumulated so far, and clear that buffer.+flushNodeBuffer :: MonadBuild m => m [NodeDef]+flushNodeBuffer = build $ do+    ns <- use nodeBuffer+    nodeBuffer .= []+    return ns++-- | Get all the initializers that have accumulated so far, and clear+-- that buffer.+flushInitializers :: Monad m => BuildT m [NodeName]+flushInitializers = do+    ns <- use initializationNodes+    initializationNodes .= []+    return ns++-- | Registers the given node to be executed before the next+-- 'TensorFlow.Session.run'.+addInitializer :: MonadBuild m => ControlNode -> m ()+addInitializer (ControlNode i) = build $ initializationNodes %= (i:)++-- | Produce a GraphDef proto representation of the nodes that are rendered in+-- the given 'Build' action.+asGraphDef :: Build a -> GraphDef+asGraphDef b = def & node .~ gs ^. nodeBuffer+  where+    gs = snd $ runIdentity $ runBuildT b++-- TODO: check against existing nodes for conflicts?+addGraphDef :: MonadBuild m => GraphDef -> m ()+addGraphDef g = build $ nodeBuffer <>= g ^. node++-- | Render the given op if it hasn't been rendered already, and return its+-- name.+getOrAddOp :: OpDef -> Build NodeName+getOrAddOp o = do+    pending <- getPendingNode o+    uses renderedNodes (Map.lookup pending) >>= \case+        Just n -> return $ NodeName $ n ^. name+        Nothing -> addNewOpFromPending pending++lookupNode :: NodeName -> Build NodeDef+lookupNode n = uses renderedNodeDefs (Map.lookup n) >>= \case+    Just n' -> return n'+    Nothing -> error $ "lookupNode: unknown node name " ++ show n++-- | Add a new node for a given 'OpDef'.  This is used for making "stateful" ops+-- which are not safe to dedup (e.g, "variable" and "assign").+addNewOp :: OpDef -> Build NodeName+addNewOp o = getPendingNode o >>= addNewOpFromPending++addNewOpFromPending :: PendingNode -> Build NodeName+addNewOpFromPending pending = do+    nodeName <- renderPendingNode pending+    let nodeDef = pendingNodeDef pending & name .~ unNodeName nodeName+    nodeBuffer %= (nodeDef :)+    renderedNodes %= Map.insert pending nodeDef+    renderedNodeDefs %= Map.insert nodeName nodeDef+    return nodeName++-- | Get the pending node corresponding to an OpDef, which may or may not have+-- been rendered before.  Implicitly renders all of this node's inputs.+getPendingNode :: OpDef -> Build PendingNode+getPendingNode o = do+    -- An empty string in the proto field means that no specific+    -- device is specified.+    dev <- maybe "" deviceName <$> use defaultDevice+    scope <- use currentScope+    controls <- use defaultControlInputs+    let inputs = map encodeOutput (o ^. opInputs)+    let controlInputs+            = map makeDep (o ^. opControlInputs ++ Set.toList controls)+    return $ PendingNode scope (o ^. opName)+            $ def & op .~ (unOpType (o ^. opType) :: Text)+                  & attr .~ _opAttrs o+                  & input .~ (inputs ++ controlInputs)+                  & device .~ dev+  where+    makeDep = ("^" <>) . unNodeName++-- | Pick a name for a pending node.  If it has an explicit name, just use that;+-- if the name is implicit, assign a new unique name based on the op type.+renderPendingNode :: PendingNode -> Build NodeName+renderPendingNode (PendingNode scope pendingName nodeDef)+    = NodeName . (scopePrefix <>) <$> getName+  where+    scopePrefix = Text.concat $ fmap ((<> "/") . unScope) scope+    getName = case pendingName of+        ExplicitName n -> return n+        ImplicitName -> do+            u@(Unique k) <- use nextUnique+            nextUnique .= succ u+            return $ nodeDef ^. op <> "_" <> Text.pack (show k)++-- | Turn an 'Output' into a string representation for the TensorFlow+-- foreign APIs.+encodeOutput :: Output -> Text+encodeOutput (Output (OutputIx 0) n) = unNodeName n+encodeOutput (Output (OutputIx i) n) = unNodeName n <> Text.pack (':' : show i)++-- | Modify some part of the state, run an action, and restore the state+-- after that action is done.+withStateLens :: MonadBuild m => Lens' GraphState a -> (a -> a) -> m b -> m b+withStateLens accessor f act = do+    old <- build $ use accessor+    build $ accessor %= f+    result <- act+    build $ accessor .= old+    return result++-- | Set a device for all nodes rendered in the given 'Build' action+-- (unless further overridden by another use of withDevice).+withDevice :: MonadBuild m => Maybe Device -> m a -> m a+withDevice d = withStateLens defaultDevice (const d)++-- | Prepend a scope to all nodes rendered in the given 'Build' action.+withNameScope :: MonadBuild m => Text -> m a -> m a+withNameScope s = withStateLens currentScope (Scope s :)++-- | Add control inputs to all nodes rendered in the given 'Build' action.+withNodeDependencies :: MonadBuild m => Set NodeName -> m a -> m a+withNodeDependencies nodes = withStateLens defaultControlInputs (<> nodes)

@@ -0,0 +1,306 @@+-- 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 FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TupleSections #-}++module TensorFlow.BuildOp+    ( BuildResult(..)+    , buildOp+    , PureResult(..)+    , pureOp+    , eqLengthGuard+    , BuildInputs(..)+    , OpParams+    )+  where++import Control.Monad (liftM2, replicateM)+import Control.Monad.Reader (ReaderT, runReaderT, ask)+import Control.Monad.State.Strict (State, evalState, get, put)+import Data.Int (Int64)++import TensorFlow.Build+import TensorFlow.Output+import TensorFlow.Tensor+import TensorFlow.Types++data ResultState = ResultState !OutputIx [Int64] deriving Show++type Result = ReaderT NodeName (State ResultState)++-- | Class of types that can be used as op outputs.+class BuildResult a where+    buildResult :: Result a++instance (BuildResult a1, BuildResult a2) => BuildResult (a1, a2) where+    buildResult = (,) <$> buildResult <*> buildResult++instance (BuildResult a1, BuildResult a2, BuildResult a3) => BuildResult (a1, a2, a3) where+    buildResult = (,,) <$> buildResult <*> buildResult <*> buildResult++instance (BuildResult a1, BuildResult a2, BuildResult a3, BuildResult a4)+         => BuildResult (a1, a2, a3, a4) where+    buildResult = (,,,) <$> buildResult <*> buildResult <*> buildResult <*> buildResult++instance (BuildResult a1, BuildResult a2, BuildResult a3, BuildResult a4, BuildResult a5)+         => BuildResult (a1, a2, a3, a4, a5) where+    buildResult = (,,,,) <$> buildResult+                      <*> buildResult+                      <*> buildResult+                      <*> buildResult+                      <*> buildResult++instance ( BuildResult a1+         , BuildResult a2+         , BuildResult a3+         , BuildResult a4+         , BuildResult a5+         , BuildResult a6+         )+         => BuildResult (a1, a2, a3, a4, a5, a6) where+    buildResult = (,,,,,)+               <$> buildResult+               <*> buildResult+               <*> buildResult+               <*> buildResult+               <*> buildResult+               <*> buildResult++instance ( BuildResult a1+         , BuildResult a2+         , BuildResult a3+         , BuildResult a4+         , BuildResult a5+         , BuildResult a6+         , BuildResult a7+         )+         => BuildResult (a1, a2, a3, a4, a5, a6, a7) where+    buildResult = (,,,,,,)+               <$> buildResult+               <*> buildResult+               <*> buildResult+               <*> buildResult+               <*> buildResult+               <*> buildResult+               <*> buildResult++instance ( BuildResult a1+         , BuildResult a2+         , BuildResult a3+         , BuildResult a4+         , BuildResult a5+         , BuildResult a6+         , BuildResult a7+         , BuildResult a8+         )+         => BuildResult (a1, a2, a3, a4, a5, a6, a7, a8) where+    buildResult = (,,,,,,,)+               <$> buildResult+               <*> buildResult+               <*> buildResult+               <*> buildResult+               <*> buildResult+               <*> buildResult+               <*> buildResult+               <*> buildResult++recordResult :: Result Output+recordResult = do+    o <- ask+    ResultState i ns <- get+    put $! ResultState (i+1) ns+    return $! output i o++instance Rendered v => BuildResult (Tensor v a) where+    buildResult = Tensor . pure <$> recordResult++instance BuildResult ControlNode where+    buildResult = ControlNode <$> ask++instance (Rendered v, TensorTypes as) => BuildResult (TensorList v as) where+  buildResult = loop (tensorTypes :: TensorTypeList as)+    where+        loop :: TensorTypeList bs -> Result (TensorList v bs)+        loop Nil = return Nil+        loop (TensorTypeProxy :/ ls) = do+            t <- buildResult+            ts <- loop ls+            return (t :/ ts)++instance BuildResult a => BuildResult [a] where+    buildResult = do+        ResultState i ns <- get+        case ns of+            [] -> error $ "Ran out of counts in buildResult. " +++                          "Likely misuse of buildOp."+            (n : rest) -> do+                put $! ResultState i rest+                replicateM (fromIntegral n) buildResult++buildOp :: BuildResult a => [Int64] -> OpDef -> Build a+buildOp sizes o = do+    n <- addNewOp o+    return $ flip evalState (ResultState 0 sizes) (runReaderT buildResult n)++-- | Returns true if all the integers in each tuple are identical.+-- Throws an error with a descriptive message if not.+eqLengthGuard :: [(String, [(String, Int)])] -> Bool+eqLengthGuard = all eachOk+  where+    eachOk (_, []) = True+    -- The next line has (== 1) . length . nub in disguise+    eachOk (numberAttrName, pairs@((_, x) : zs)) = all (\z -> snd z == x) zs ||+        error ("number_attr " ++ numberAttrName +++               " contains tensors with different length " ++ show pairs)++-----------+++-- | Class of types that can be used as op outputs.+class PureResult a where+    pureResult :: ReaderT (Build OpDef) (State ResultState) a++instance PureResult (Tensor Build a) where+    pureResult = do+        ResultState i ns <- get+        put $! ResultState (i+1) ns+        makeOp <- ask+        return $ Tensor $ do+            o <- makeOp+            -- TODO: unify with BuildResult (Tensor v)+            output i <$> getOrAddOp o++instance (PureResult a1, PureResult a2) => PureResult (a1, a2) where+    pureResult = (,) <$> pureResult <*> pureResult++instance (PureResult a1, PureResult a2, PureResult a3) => PureResult (a1, a2, a3) where+    pureResult = (,,) <$> pureResult <*> pureResult <*> pureResult++instance (PureResult a1, PureResult a2, PureResult a3, PureResult a4)+         => PureResult (a1, a2, a3, a4) where+    pureResult = (,,,) <$> pureResult <*> pureResult <*> pureResult <*> pureResult++instance (PureResult a1, PureResult a2, PureResult a3, PureResult a4, PureResult a5)+         => PureResult (a1, a2, a3, a4, a5) where+    pureResult = (,,,,) <$> pureResult+                      <*> pureResult+                      <*> pureResult+                      <*> pureResult+                      <*> pureResult++instance ( PureResult a1+         , PureResult a2+         , PureResult a3+         , PureResult a4+         , PureResult a5+         , PureResult a6+         )+         => PureResult (a1, a2, a3, a4, a5, a6) where+    pureResult = (,,,,,)+               <$> pureResult+               <*> pureResult+               <*> pureResult+               <*> pureResult+               <*> pureResult+               <*> pureResult++instance ( PureResult a1+         , PureResult a2+         , PureResult a3+         , PureResult a4+         , PureResult a5+         , PureResult a6+         , PureResult a7+         )+         => PureResult (a1, a2, a3, a4, a5, a6, a7) where+    pureResult = (,,,,,,)+               <$> pureResult+               <*> pureResult+               <*> pureResult+               <*> pureResult+               <*> pureResult+               <*> pureResult+               <*> pureResult++instance ( PureResult a1+         , PureResult a2+         , PureResult a3+         , PureResult a4+         , PureResult a5+         , PureResult a6+         , PureResult a7+         , PureResult a8+         )+         => PureResult (a1, a2, a3, a4, a5, a6, a7, a8) where+    pureResult = (,,,,,,,)+               <$> pureResult+               <*> pureResult+               <*> pureResult+               <*> pureResult+               <*> pureResult+               <*> pureResult+               <*> pureResult+               <*> pureResult++instance PureResult a => PureResult [a] where+    pureResult = do+        ResultState i ns <- get+        case ns of+            [] -> error $ "Ran out of counts in pureResult. " +++                          "Likely misuse of pureOp with output lists."+            n : rest -> do+                put $! ResultState i rest+                replicateM (fromIntegral n) pureResult++instance TensorTypes as => PureResult (TensorList Build as) where+    pureResult = loop (tensorTypes :: TensorTypeList as)+      where+        loop :: TensorTypeList bs -> ReaderT (Build OpDef) (State ResultState)+                                        (TensorList Build bs)+        loop Nil = return Nil+        loop (TensorTypeProxy :/ ls) = do+            t <- pureResult+            ts <- loop ls+            return (t :/ ts)++pureOp :: PureResult a => [Int64] -> Build OpDef -> a+pureOp sizes o = flip evalState (ResultState 0 sizes) (runReaderT pureResult o)++-----+-- Class of types that can be used as arguments++class BuildInputs a where+    buildInputs :: a -> Build [Output]++instance BuildInputs a => BuildInputs [a] where+    buildInputs = fmap concat . mapM buildInputs++instance BuildInputs (Tensor v a) where+    buildInputs (Tensor t) = do+        o <- toBuild t+        return [o]++instance BuildInputs (ListOf (Tensor v) as) where+    buildInputs Nil = return []+    buildInputs (t :/ ts) = liftM2 (++) (buildInputs t) (buildInputs ts)++----++-- | Parameters to build an op (for example, the node name or optional attributes).+-- TODO: be more type safe.+type OpParams = OpDef -> OpDef

@@ -0,0 +1,50 @@+-- 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 GADTs #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}++module TensorFlow.ControlFlow+    ( -- * Dependencies+      withControlDependencies+    , group+      -- * Operations+    , noOp+    ) where++import TensorFlow.BuildOp+import TensorFlow.Build+import TensorFlow.Nodes++-- | Modify a 'Build' action, such that all new ops rendered in it will depend+-- on the nodes in the first argument.+withControlDependencies :: (MonadBuild m, Nodes t) => t -> m a -> m a+withControlDependencies deps act = do+    nodes <- build $ getNodes deps+    withNodeDependencies nodes act++-- TODO(judahjacobson): Reimplement withDependencies.++-- | Create an op that groups multiple operations.+--+-- When this op finishes, all ops in the input @n@ have finished.  This op has+-- no output.+group :: (MonadBuild m, Nodes t) => t -> m ControlNode+group deps = withControlDependencies deps noOp++-- | Does nothing.  Only useful as a placeholder for control edges.+noOp :: MonadBuild m => m ControlNode+noOp = build $ buildOp [] $ opDef "NoOp"

@@ -0,0 +1,92 @@+-- 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 ExplicitNamespaces #-}++-- | The core functionality of TensorFlow.+--+-- Unless you are defining ops, you do not need to import other modules from+-- this package.+--+-- Basic ops are provided in the tensorflow-ops and tensorflow-core-ops+-- packages.+module TensorFlow.Core+    ( -- * Session+      Session+    , Options+    , sessionConfig+    , sessionTarget+    , sessionTracer+    , runSession+    , runSessionWithOptions+      -- ** Building graphs+    , MonadBuild(..)+      -- ** Running graphs+    , Fetchable+    , Nodes+    , run+    , run_+    , Feed+    , feed+    , runWithFeeds+    , runWithFeeds_+      -- ** Async+    , asyncProdNodes++      -- * Build+    , Build+    , BuildT+    , render+    , asGraphDef+    , addGraphDef+    , opName+    , opAttr+    , addInitializer+      -- * Tensor+    , ControlNode+    , Tensor+    , Value+    , Ref+    , value+    , tensorFromName+    , expr+      -- ** Element types+    , TensorType+    , TensorData+    , TensorDataType(decodeTensorData, encodeTensorData)+    , ResourceHandle+    , Scalar(..)+    , Shape(..)+    , OneOf+    , type (/=)++      -- * Op combinators+    , colocateWith+    , Device(..)+    , withDevice+    , withNameScope+      -- ** Dependencies+    , withControlDependencies+    , group+      -- ** Misc+    , noOp+    ) where++import TensorFlow.Build+import TensorFlow.ControlFlow+import TensorFlow.Nodes+import TensorFlow.Output+import TensorFlow.Session+import TensorFlow.Tensor+import TensorFlow.Types

@@ -0,0 +1,264 @@+-- 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 DeriveDataTypeable #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++module TensorFlow.Internal.FFI+    ( TensorFlowException(..)+    , Raw.Session+    , withSession+    , extendGraph+    , run+    , TensorData(..)+    , setSessionConfig+    , setSessionTarget+    , getAllOpList+      -- * Internal helper.+    , useProtoAsVoidPtrLen+    )+    where++import Control.Concurrent.Async (Async, async, cancel, waitCatch)+import Control.Concurrent.MVar (MVar, modifyMVarMasked_, newMVar, takeMVar)+import Control.Exception (Exception, throwIO, bracket, finally, mask_)+import Control.Monad (when)+import Data.Bits (Bits, toIntegralSized)+import Data.Int (Int64)+import Data.Maybe (fromMaybe)+import Data.Typeable (Typeable)+import Data.Word (Word8)+import Foreign (Ptr, FunPtr, nullPtr, castPtr)+import Foreign.C.String (CString)+import Foreign.ForeignPtr (newForeignPtr, newForeignPtr_, withForeignPtr)+import Foreign.Marshal.Alloc (free)+import Foreign.Marshal.Array (withArrayLen, peekArray, mallocArray, copyArray)+import System.IO.Unsafe (unsafePerformIO)+import qualified Data.ByteString as B+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import qualified Data.Text.Encoding.Error as T+import qualified Data.Vector.Storable as S+import qualified Data.Vector.Storable.Mutable as M++import Data.ProtoLens (Message, encodeMessage)+import Proto.Tensorflow.Core.Framework.Graph (GraphDef)+import Proto.Tensorflow.Core.Framework.Types (DataType(..))+import Proto.Tensorflow.Core.Protobuf.Config (ConfigProto)++import qualified TensorFlow.Internal.Raw as Raw++data TensorFlowException = TensorFlowException Raw.Code T.Text+    deriving (Show, Eq, Typeable)++instance Exception TensorFlowException++-- | All of the data needed to represent a tensor.+data TensorData = TensorData+    { tensorDataDimensions :: [Int64]+    , tensorDataType       :: !DataType+    , tensorDataBytes      :: !(S.Vector Word8)+    }+  deriving (Show, Eq)++-- | Runs the given action after creating a session with options+-- populated by the given optionSetter.+withSession :: (Raw.SessionOptions -> IO ())+            -> ((IO () -> IO ()) -> Raw.Session -> IO a)+            -- ^ The action can spawn concurrent tasks which will+            -- be canceled before withSession returns.+            -> IO a+withSession optionSetter action = do+    drain <- newMVar []+    let cleanup s =+        -- Closes the session to nudge the pending run calls to fail and exit.+            finally (checkStatus (Raw.closeSession s)) $ do+                runners <- takeMVar drain+                -- Collects all runners before deleting the session.+                mapM_ shutDownRunner runners+                checkStatus (Raw.deleteSession s)+    bracket Raw.newSessionOptions Raw.deleteSessionOptions $ \options -> do+        optionSetter options+        bracket+            (checkStatus (Raw.newSession options))+            cleanup+            (action (asyncCollector drain))++asyncCollector :: MVar [Async ()] -> IO () -> IO ()+asyncCollector drain runner = modifyMVarMasked_ drain launchAndRecord+    where+      launchAndRecord restRunners = (: restRunners) <$> async runner++shutDownRunner :: Async () -> IO ()+shutDownRunner r = do+    cancel r+    -- TODO(gnezdo): manage exceptions better than print.+    either print (const (return ())) =<< waitCatch r++extendGraph :: Raw.Session -> GraphDef -> IO ()+extendGraph session pb =+    useProtoAsVoidPtrLen pb $ \ptr len ->+        checkStatus $ Raw.extendGraph session ptr len+++run :: Raw.Session+    -> [(B.ByteString, TensorData)] -- ^ Feeds.+    -> [B.ByteString]               -- ^ Fetches.+    -> [B.ByteString]               -- ^ Targets.+    -> IO [TensorData]+run session feeds fetches targets = do+    let nullTensor = Raw.Tensor nullPtr+    -- Use mask to avoid leaking input tensors before they are passed to 'run'+    -- and output tensors before they are passed to 'createTensorData'.+    mask_ $+        -- Feeds+        withStringArrayLen (fst <$> feeds) $ \feedsLen feedNames ->+        mapM (createRawTensor . snd) feeds >>= \feedTensors ->+        withArrayLen feedTensors $ \_ cFeedTensors ->+        -- Fetches.+        withStringArrayLen fetches $ \fetchesLen fetchNames ->+        -- tensorOuts is an array of null Tensor pointers that will be filled+        -- by the call to Raw.run.+        withArrayLen (replicate fetchesLen nullTensor) $ \_ tensorOuts ->+        -- Targets.+        withStringArrayLen targets $ \targetsLen ctargets -> do+            checkStatus $ Raw.run+                session+                nullPtr+                feedNames cFeedTensors (safeConvert feedsLen)+                fetchNames tensorOuts (safeConvert fetchesLen)+                ctargets (safeConvert targetsLen)+                nullPtr+            mapM_ Raw.deleteTensor feedTensors+            outTensors <- peekArray fetchesLen tensorOuts+            mapM createTensorData outTensors+++-- Internal.+++-- | Same as 'fromIntegral', but throws an error if conversion is "lossy".+safeConvert ::+    forall a b. (Show a, Show b, Bits a, Bits b, Integral a, Integral b)+    => a -> b+safeConvert x =+    fromMaybe+    (error ("Failed to convert " ++ show x ++ ", got " +++            show (fromIntegral x :: b)))+    (toIntegralSized x)+++-- | Use a list of ByteString as a list of CString.+withStringList :: [B.ByteString] -> ([CString] -> IO a) -> IO a+withStringList strings fn = go strings []+  where+    go [] cs = fn (reverse cs)+    -- TODO(fmayle): Is it worth using unsafeAsCString here?+    go (x:xs) cs = B.useAsCString x $ \c -> go xs (c:cs)+++-- | Use a list of ByteString as an array of CString.+withStringArrayLen :: [B.ByteString] -> (Int -> Ptr CString -> IO a) -> IO a+withStringArrayLen xs fn = withStringList xs (`withArrayLen` fn)+++-- | Create a Raw.Tensor from a TensorData.+createRawTensor :: TensorData -> IO Raw.Tensor+createRawTensor (TensorData dims dt byteVec) =+    withArrayLen (map safeConvert dims) $ \cdimsLen cdims -> do+        let len = S.length byteVec+        dest <- mallocArray len+        S.unsafeWith byteVec $ \x -> copyArray dest x len+        Raw.newTensor (toEnum $ fromEnum dt)+                      cdims (safeConvert cdimsLen)+                      (castPtr dest) (safeConvert len)+                      tensorDeallocFunPtr nullPtr++{-# NOINLINE tensorDeallocFunPtr #-}+tensorDeallocFunPtr :: FunPtr Raw.TensorDeallocFn+tensorDeallocFunPtr = unsafePerformIO $ Raw.wrapTensorDealloc $ \x _ _ -> free x++-- | Create a TensorData from a Raw.Tensor.+--+-- Takes ownership of the Raw.Tensor.+-- TODO: Currently, it just makes a copy of the Tensor (and then deletes it),+-- since the raw pointer may refer to storage inside a mutable TensorFlow+-- variable.  We should avoid that copy when it's not needed; for example,+-- by making TensorData wrap an IOVector, and changing the code that uses it.+createTensorData :: Raw.Tensor -> IO TensorData+createTensorData t = do+    -- Read dimensions.+    numDims <- Raw.numDims t+    dims <- mapM (Raw.dim t) [0..numDims-1]+    -- Read type.+    dtype <- toEnum . fromEnum <$> Raw.tensorType t+    -- Read data.+    len <- safeConvert <$> Raw.tensorByteSize t+    bytes <- castPtr <$> Raw.tensorData t :: IO (Ptr Word8)+    fp <- newForeignPtr_ bytes+    -- Make an explicit copy of the raw data, since it might point+    -- to a mutable variable's memory.+    v <- S.freeze (M.unsafeFromForeignPtr0 fp len)+    Raw.deleteTensor t+    return $ TensorData (map safeConvert dims) dtype v++-- | Runs the given action which does FFI calls updating a provided+-- status object. If the status is not OK it is thrown as+-- TensorFlowException.+checkStatus :: (Raw.Status -> IO a) -> IO a+checkStatus fn =+    bracket Raw.newStatus Raw.deleteStatus $ \status -> do+        result <- fn status+        code <- Raw.getCode status+        when (code /= Raw.TF_OK) $ do+            msg <- T.decodeUtf8With T.lenientDecode <$>+                   (Raw.message status >>= B.packCString)+            throwIO $ TensorFlowException code msg+        return result++setSessionConfig :: ConfigProto -> Raw.SessionOptions -> IO ()+setSessionConfig pb opt =+    useProtoAsVoidPtrLen pb $ \ptr len ->+        checkStatus (Raw.setConfig opt ptr len)++setSessionTarget :: B.ByteString -> Raw.SessionOptions -> IO ()+setSessionTarget target = B.useAsCString target . Raw.setTarget++-- | Serializes the given msg and provides it as (ptr,len) argument+-- to the given action.+useProtoAsVoidPtrLen :: (Message msg, Integral c, Show c, Bits c) =>+                        msg -> (Ptr b -> c -> IO a) -> IO a+useProtoAsVoidPtrLen msg f = B.useAsCStringLen (encodeMessage msg) $+        \(bytes, len) -> f (castPtr bytes) (safeConvert len)++-- | Returns the serialized OpList of all OpDefs defined in this+-- address space.+getAllOpList :: IO B.ByteString+getAllOpList = do+    foreignPtr <-+        mask_ (newForeignPtr Raw.deleteBuffer =<< checkCall)+    -- Makes a copy because it is more reliable than eviscerating+    -- Buffer to steal its memory (including custom deallocator).+    withForeignPtr foreignPtr $+        \ptr -> B.packCStringLen =<< (,)+                <$> (castPtr <$> Raw.getBufferData ptr)+                <*> (safeConvert <$> Raw.getBufferLength ptr)+    where+      checkCall = do+          p <- Raw.getAllOpList+          when (p == nullPtr) (throwIO exception)+          return p+      exception = TensorFlowException+                Raw.TF_UNKNOWN "GetAllOpList failure, check logs"

@@ -0,0 +1,158 @@+-- 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 ForeignFunctionInterface #-}++module TensorFlow.Internal.Raw where++#include "third_party/tensorflow/c/c_api.h"++import Foreign+import Foreign.C++{#enum TF_DataType as DataType {} deriving (Show, Eq) #}+{#enum TF_Code as Code {} deriving (Show, Eq) #}+++-- Status.+{#pointer *TF_Status as Status newtype #}++newStatus :: IO Status+newStatus = {# call TF_NewStatus as ^ #}++deleteStatus :: Status -> IO ()+deleteStatus = {# call TF_DeleteStatus as ^ #}++setStatus :: Status -> Code -> CString -> IO ()+setStatus s c = {# call TF_SetStatus as ^ #} s (fromIntegral $ fromEnum c)++getCode :: Status -> IO Code+getCode s = toEnum . fromIntegral <$> {# call TF_GetCode as ^ #} s++message :: Status -> IO CString+message = {# call TF_Message as ^ #}+++-- Buffer.+data Buffer+{#pointer *TF_Buffer as BufferPtr -> Buffer #}++getBufferData :: BufferPtr -> IO (Ptr ())+getBufferData = {#get TF_Buffer->data #}++getBufferLength :: BufferPtr -> IO CULong+getBufferLength ={#get TF_Buffer->length #}++-- Tensor.+{#pointer *TF_Tensor as Tensor newtype #}++instance Storable Tensor where+    sizeOf (Tensor t) = sizeOf t+    alignment (Tensor t) = alignment t+    peek p = fmap Tensor (peek (castPtr p))+    poke p (Tensor t) = poke (castPtr p) t++-- A synonym for the int64_t type, which is used in the TensorFlow API.+-- On some platforms it's `long`; on others (e.g., Mac OS X) it's `long long`;+-- and as far as Haskell is concerned, those are distinct types (`CLong` vs+-- `CLLong`).+type CInt64 = {#type int64_t #}++newTensor :: DataType+          -> Ptr CInt64   -- dimensions array+          -> CInt         -- num dimensions+          -> Ptr ()       -- data+          -> CULong       -- data len+          -> FunPtr (Ptr () -> CULong -> Ptr () -> IO ())  -- deallocator+          -> Ptr ()       -- deallocator arg+          -> IO Tensor+newTensor dt = {# call TF_NewTensor as ^ #} (fromIntegral $ fromEnum dt)++deleteTensor :: Tensor -> IO ()+deleteTensor = {# call TF_DeleteTensor as ^ #}++tensorType :: Tensor -> IO DataType+tensorType t = toEnum . fromIntegral <$> {# call TF_TensorType as ^ #} t++numDims :: Tensor -> IO CInt+numDims = {# call TF_NumDims as ^ #}++dim :: Tensor -> CInt -> IO CInt64+dim = {# call TF_Dim as ^ #}++tensorByteSize :: Tensor -> IO CULong+tensorByteSize = {# call TF_TensorByteSize as ^ #}++tensorData :: Tensor -> IO (Ptr ())+tensorData = {# call TF_TensorData as ^ #}+++-- Session Options.+{# pointer *TF_SessionOptions as SessionOptions newtype #}++newSessionOptions :: IO SessionOptions+newSessionOptions = {# call TF_NewSessionOptions as ^ #}++setTarget :: SessionOptions -> CString -> IO ()+setTarget = {# call TF_SetTarget as ^ #}++setConfig :: SessionOptions -> Ptr () -> CULong -> Status -> IO ()+setConfig = {# call TF_SetConfig as ^ #}++deleteSessionOptions :: SessionOptions -> IO ()+deleteSessionOptions = {# call TF_DeleteSessionOptions as ^ #}+++-- Session.+{# pointer *TF_DeprecatedSession as Session newtype #}++newSession :: SessionOptions -> Status -> IO Session+newSession = {# call TF_NewDeprecatedSession as ^ #}++closeSession :: Session -> Status -> IO ()+closeSession = {# call TF_CloseDeprecatedSession as ^ #}++deleteSession :: Session -> Status -> IO ()+deleteSession = {# call TF_DeleteDeprecatedSession as ^ #}++extendGraph :: Session -> Ptr () -> CULong -> Status -> IO ()+extendGraph = {# call TF_ExtendGraph as ^ #}++run :: Session+    -> BufferPtr                          -- RunOptions proto.+    -> Ptr CString -> Ptr Tensor -> CInt  -- Input (names, tensors, count).+    -> Ptr CString -> Ptr Tensor -> CInt  -- Output (names, tensors, count).+    -> Ptr CString -> CInt                -- Target nodes (names, count).+    -> BufferPtr                          -- RunMetadata proto.+    -> Status+    -> IO ()+run = {# call TF_Run as ^ #}++-- FFI helpers.+type TensorDeallocFn = Ptr () -> CULong -> Ptr () -> IO ()+foreign import ccall "wrapper"+    wrapTensorDealloc :: TensorDeallocFn -> IO (FunPtr TensorDeallocFn)+++-- | Get the OpList of all OpDefs defined in this address space.+-- Returns a BufferPtr, ownership of which is transferred to the caller+-- (and can be freed using deleteBuffer).+--+-- The data in the buffer will be the serialized OpList proto for ops registered+-- in this address space.+getAllOpList :: IO BufferPtr+getAllOpList = {# call TF_GetAllOpList as ^ #}++foreign import ccall "&TF_DeleteBuffer"+  deleteBuffer :: FunPtr (BufferPtr -> IO ())

@@ -0,0 +1,50 @@+-- 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 BangPatterns #-}++{-|+Module      : TensorFlow.Internal.VarInt+Description : Encoders and decoders for varint types.++Originally taken from internal proto-lens code.+-}+module TensorFlow.Internal.VarInt+    ( getVarInt+    , putVarInt+    ) where++import Data.Attoparsec.ByteString as Parse+import Data.Bits+import Data.ByteString.Lazy.Builder as Builder+import Data.Monoid ((<>))+import Data.Word (Word64)++-- | Decode an unsigned varint.+getVarInt :: Parser Word64+getVarInt = loop 1 0+  where+    loop !s !n = do+        b <- anyWord8+        let n' = n + s * fromIntegral (b .&. 127)+        if (b .&. 128) == 0+            then return n'+            else loop (128*s) n'++-- | Encode a Word64.+putVarInt :: Word64 -> Builder+putVarInt n+    | n < 128 = Builder.word8 (fromIntegral n)+    | otherwise = Builder.word8 (fromIntegral $ n .&. 127 .|. 128)+                      <> putVarInt (n `shiftR` 7)

@@ -0,0 +1,140 @@+-- 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 DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}  -- For Fetchable (TensorExpr a)+module TensorFlow.Nodes where++import Control.Applicative (liftA2, liftA3)+import Data.Functor.Identity (Identity)+import Data.Map.Strict (Map)+import Data.Monoid ((<>))+import Data.Set (Set)+import Data.Text (Text)+import qualified Data.Map.Strict as Map+import qualified Data.Set as Set++import TensorFlow.Build+import TensorFlow.Output+import TensorFlow.Tensor+import TensorFlow.Types+import qualified TensorFlow.Internal.FFI as FFI++-- | Types that contain ops which can be run.+class Nodes t where+    getNodes :: t -> Build (Set NodeName)++-- | Types that tensor representations (e.g. 'Tensor', 'ControlNode') can be+-- fetched into.+--+-- Includes collections of tensors (e.g. tuples).+class Nodes t => Fetchable t a where+    getFetch :: t -> Build (Fetch a)++-- | Fetch action. Keeps track of what needs to be fetched and how to decode+-- the fetched data.+data Fetch a = Fetch+          { -- | Nodes to fetch+            fetches :: Set Text+            -- | Function to create an 'a' from the fetched data.+          , fetchRestore :: Map Text FFI.TensorData -> a+          }++instance Functor Fetch where+    fmap f (Fetch fetch restore) = Fetch fetch (f . restore)++instance Applicative Fetch where+    pure x = Fetch Set.empty (const x)+    Fetch fetch restore <*> Fetch fetch' restore' =+        Fetch (fetch <> fetch') (restore <*> restore')++nodesUnion :: (Monoid b, Traversable t, Applicative f) => t (f b) -> f b+nodesUnion = fmap (foldMap id) . sequenceA++instance (Nodes t1, Nodes t2) => Nodes (t1, t2) where+    getNodes (x, y) = nodesUnion [getNodes x, getNodes y]++instance (Nodes t1, Nodes t2, Nodes t3) => Nodes (t1, t2, t3) where+    getNodes (x, y, z) = nodesUnion [getNodes x, getNodes y, getNodes z]++instance (Fetchable t1 a1, Fetchable t2 a2) => Fetchable (t1, t2) (a1, a2) where+    getFetch (x, y) = liftA2 (,) <$> getFetch x <*> getFetch y++instance (Fetchable t1 a1, Fetchable t2 a2, Fetchable t3 a3)+         => Fetchable (t1, t2, t3) (a1, a2, a3) where+    getFetch (x, y, z) =+        liftA3 (,,) <$> getFetch x <*> getFetch y <*> getFetch z++instance Nodes t => Nodes [t] where+    getNodes = nodesUnion . map getNodes++instance Fetchable t a => Fetchable [t] [a] where+    getFetch ts  = sequenceA <$> mapM getFetch ts++instance Nodes ControlNode where+    getNodes (ControlNode o) = pure $ Set.singleton o++-- We use the constraint @(a ~ ())@ to help with type inference.  For example,+-- if @t :: ControlNode@, then this constraint ensures that @run t :: Session+-- ()@.  If we used @instance Fetchable ControlNode ()@ instead, then that+-- expression would be ambiguous without explicitly specifying the return type.+instance a ~ () => Fetchable ControlNode a where+    getFetch _ = return $ pure ()++instance Nodes (ListOf f '[]) where+    getNodes _ = return Set.empty++instance (Nodes (f a), Nodes (ListOf f as)) => Nodes (ListOf f (a ': as)) where+    getNodes (x :/ xs) = liftA2 Set.union (getNodes x) (getNodes xs)++instance l ~ List '[] => Fetchable (ListOf f '[]) l where+    getFetch _ = return $ pure Nil++instance (Fetchable (f t) a, Fetchable (ListOf f ts) (List as), i ~ Identity)+    => Fetchable (ListOf f (t ': ts)) (ListOf i (a ': as)) where+    getFetch (x :/ xs) = liftA2 (\y ys -> y /:/ ys) <$> getFetch x <*> getFetch xs++instance Nodes (Tensor v a) where+    getNodes (Tensor o) = Set.singleton . outputNodeName <$> toBuild o++fetchTensorVector :: forall a v . (TensorType a)+                  => Tensor v a -> Build (Fetch (TensorData a))+fetchTensorVector (Tensor o) = do+    outputName <- encodeOutput <$> toBuild o+    pure $ Fetch (Set.singleton outputName) $ \tensors ->+        let tensorData = tensors Map.! outputName+            expectedType = tensorType (undefined :: a)+            actualType = FFI.tensorDataType tensorData+            badTypeError = error $ "Bad tensor type: expected "+                                   ++ show expectedType+                                   ++ ", got "+                                   ++ show actualType+        in if expectedType /= actualType+               then badTypeError+               else TensorData tensorData++-- The constraint "a ~ a'" means that the input/output of fetch can constrain+-- the TensorType of each other.+instance (TensorType a, a ~ a') => Fetchable (Tensor v a) (TensorData a') where+    getFetch = fetchTensorVector++instance (TensorType a, TensorDataType s a, a ~ a') => Fetchable (Tensor v a) (s a') where+    getFetch t = fmap decodeTensorData <$> fetchTensorVector t

@@ -0,0 +1,46 @@+-- 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 StandaloneDeriving #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+-- Orphan instances for certain proto messages/enums, used internally.+-- TODO(judahjacobson): consider making proto-lens generate some or all of+-- these automatically; or, alternately, make new Haskell datatypes.+module TensorFlow.Orphans() where++import Proto.Tensorflow.Core.Framework.AttrValue+    ( AttrValue(..)+    , AttrValue'ListValue(..)+    , NameAttrList(..)+    )+import Proto.Tensorflow.Core.Framework.NodeDef+    ( NodeDef(..))+import Proto.Tensorflow.Core.Framework.ResourceHandle+    ( ResourceHandle(..))+import Proto.Tensorflow.Core.Framework.Tensor+    (TensorProto(..))+import Proto.Tensorflow.Core.Framework.TensorShape+    (TensorShapeProto(..), TensorShapeProto'Dim(..))+import Proto.Tensorflow.Core.Framework.Types (DataType(..))++deriving instance Ord AttrValue+deriving instance Ord AttrValue'ListValue+deriving instance Ord DataType+deriving instance Ord NameAttrList+deriving instance Ord NodeDef+deriving instance Ord ResourceHandle+deriving instance Ord TensorProto+deriving instance Ord TensorShapeProto+deriving instance Ord TensorShapeProto'Dim

@@ -0,0 +1,128 @@+-- 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 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 Data.Default (def)+import TensorFlow.Types (Attribute, attrLens)+import TensorFlow.Orphans ()++-- | A type of graph node which has no outputs. These nodes are+-- valuable for causing side effects when they are run.+newtype ControlNode = ControlNode { unControlNode :: NodeName }++-- | The type of op of a node in the graph.  This corresponds to the proto field+-- NodeDef.op.+newtype OpType = OpType { unOpType :: Text }+    deriving (Eq, Ord, Show)++instance IsString OpType where+    fromString = OpType . Text.pack++-- | An output of a TensorFlow node.+data Output = Output {outputIndex :: !OutputIx, outputNodeName :: !NodeName}+    deriving (Eq, Ord, Show)++output :: OutputIx -> NodeName -> Output+output = Output++newtype OutputIx = OutputIx { unOutputIx :: Int }+    deriving (Eq, Ord, Num, Enum, 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 {deviceName :: Text}+    deriving (Eq, Ord, IsString)++instance Show Device where+    show (Device d) = show d++-- | Op definition. This corresponds somewhat to the 'NodeDef' proto.+data OpDef = OpDef+    { _opName :: !PendingNodeName+    , _opType :: !OpType+    , _opAttrs :: !(Map.Map Text AttrValue)+    , _opInputs :: [Output]+    , _opControlInputs :: [NodeName]+    }  deriving (Eq, 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 (Eq, Ord, Show)++instance IsString PendingNodeName where+    fromString = ExplicitName . 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 { unNodeName :: Text }+    deriving (Eq, Ord, Show)++opName :: Lens' OpDef PendingNodeName+opName = lens _opName (\o x -> o {_opName = x})++opType :: Lens' OpDef OpType+opType = lens _opType (\o x -> o { _opType = x})++opAttr :: Attribute a => Text -> Lens' OpDef a+opAttr n = lens _opAttrs (\o x -> o {_opAttrs = x})+              . lens (Map.findWithDefault def n) (flip (Map.insert n))+              . attrLens++opInputs :: Lens' OpDef [Output]+opInputs = lens _opInputs (\o x -> o {_opInputs = x})++opControlInputs :: Lens' OpDef [NodeName]+opControlInputs = lens _opControlInputs (\o x -> o {_opControlInputs = x})++-- TODO(gnezdo): IsString instance is weird and we should move that+-- code into a Build function+instance IsString Output where+    fromString s = case break (==':') s of+        (n, ':':ixStr) | [(ix, "" :: String)] <- read ixStr+                         -> Output (fromInteger ix) $ assigned n+        _ -> Output 0 $ assigned s+     where assigned = NodeName . Text.pack

@@ -0,0 +1,211 @@+-- 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 #-}+{-# LANGUAGE TupleSections #-}++module TensorFlow.Session (+    Session,+    Options,+    sessionConfig,+    sessionTarget,+    sessionTracer,+    runSession,+    runSessionWithOptions,+    MonadBuild(..),+    extend,+    addGraphDef,+    run,+    runWithFeeds,+    run_,+    runWithFeeds_,+    asyncProdNodes,+    ) where++import Control.Monad (forever, unless, void)+import Control.Monad.Catch (MonadThrow, MonadCatch, MonadMask)+import Control.Monad.IO.Class (MonadIO, liftIO)+import Control.Monad.Trans.Class (lift)+import Control.Monad.Trans.Reader (ReaderT(..), ask, asks)+import Data.ByteString (ByteString)+import Data.Default (Default, def)+import Data.Monoid ((<>))+import Data.ProtoLens (showMessage)+import Data.Set (Set)+import Data.Text.Encoding (encodeUtf8)+import Lens.Family2 (Lens', (^.), (&), (.~))+import Lens.Family2.Unchecked (lens)+import Proto.Tensorflow.Core.Framework.Graph (GraphDef, node)+import Proto.Tensorflow.Core.Protobuf.Config (ConfigProto)+import TensorFlow.Build+import TensorFlow.Nodes+import TensorFlow.Output (NodeName, unNodeName)+import TensorFlow.Tensor++import qualified Data.ByteString.Builder as Builder+import qualified Data.Map.Strict as Map+import qualified Data.Set as Set+import qualified TensorFlow.Internal.FFI as FFI++-- | An action for logging.+type Tracer = Builder.Builder -> IO ()++-- Common state threaded through the session.+data SessionState+    = SessionState {+          rawSession :: FFI.Session+        , asyncCollector :: IO () -> IO ()+          -- ^ Starts the given action concurrently.+        , tracer :: Tracer+        }++newtype Session a+    = Session (ReaderT SessionState (BuildT IO) a)+    deriving (Functor, Applicative, Monad, MonadIO, MonadThrow, MonadCatch,+              MonadMask)++-- | Run 'Session' actions in a new TensorFlow session.+runSession :: Session a -> IO a+runSession = runSessionWithOptions def++-- | Customization for session. Use the lenses to update:+-- 'sessionTarget', 'sessionTracer', 'sessionConfig'.+data Options = Options+    { _sessionTarget :: ByteString+    , _sessionConfig :: ConfigProto+    , _sessionTracer :: Tracer+    }++instance Default Options where+    def = Options+          { _sessionTarget = ""+          , _sessionConfig = def+          , _sessionTracer = const (return ())+          }++-- | Target can be: "local", ip:port, host:port.+-- The set of supported factories depends on the linked in libraries.+sessionTarget :: Lens' Options ByteString+sessionTarget = lens _sessionTarget (\g x -> g { _sessionTarget = x })++-- | Uses the specified config for the created session.+sessionConfig :: Lens' Options ConfigProto+sessionConfig = lens _sessionConfig (\g x -> g { _sessionConfig = x })++-- | Uses the given logger to monitor session progress.+sessionTracer :: Lens' Options Tracer+sessionTracer = lens _sessionTracer (\g x -> g { _sessionTracer = x })++-- | Run 'Session' actions in a new TensorFlow session created with+-- the given option setter actions ('sessionTarget', 'sessionConfig').+runSessionWithOptions :: Options -> Session a -> IO a+runSessionWithOptions options (Session m) =+    FFI.withSession applyOptions $+        \as rs ->+            let initState = SessionState rs as (options ^. sessionTracer)+            in evalBuildT (runReaderT m initState)+  where applyOptions opt = do+            FFI.setSessionTarget (options ^. sessionTarget) opt+            FFI.setSessionConfig (options ^. sessionConfig) opt++instance MonadBuild Session where+    build = Session . lift . build++-- | Add all pending rendered nodes to the TensorFlow graph and runs+-- any pending initializers.+--+-- Note that run, runWithFeeds, etc. will all call this function implicitly.+extend :: Session ()+extend = do+    session <- Session (asks rawSession)+    trace <- Session (asks tracer)+    nodesToExtend <- build flushNodeBuffer+    unless (null nodesToExtend) $ liftIO $ do+        let graphDef = (def :: GraphDef) & node .~ nodesToExtend+        trace ("Session.extend " <> Builder.string8 (showMessage graphDef))+        FFI.extendGraph session graphDef+    -- Now that all the nodes are created, run the initializers.+    initializers <- build flushInitializers+    unless (null initializers) $+        void $ liftIO $ FFI.run session [] [] (toNodeNames initializers)++-- | Run a subgraph 't', rendering any dependent nodes that aren't already+-- rendered, and fetch the corresponding values for 'a'.+run :: Fetchable t a => t -> Session a+run = runWithFeeds []++-- | Run a subgraph 't', rendering any dependent nodes that aren't already+-- rendered, feed the given input values, and fetch the corresponding result+-- values for 'a'.+runWithFeeds :: Fetchable t a => [Feed] -> t -> Session a+runWithFeeds feeds t = do+    ns <- build $ getNodes t+    -- Note that this call to "fetch" shouldn't affect the following "extend"+    -- call, since all nodes in t and its inputs/deps will be rendered by the+    -- above call to getNodes.+    fetch <- build $ getFetch t+    runFetchWithFeeds feeds ns fetch++runFetchWithFeeds :: [Feed] -> Set NodeName -> Fetch a -> Session a+runFetchWithFeeds feeds target (Fetch fetch restore) = do+    extend+    let feeds' = fixFeeds feeds+    let fetchNames = encodeUtf8 <$> Set.toList fetch+        targetNames = toNodeNames $ Set.toList target+    session <- Session (asks rawSession)+    runResult <- liftIO $ FFI.run session+                                  feeds'+                                  fetchNames+                                  targetNames+    let resultTensorsMap = Map.fromList $ zip (Set.toList fetch) runResult+    return $ restore resultTensorsMap++toNodeNames :: [NodeName] -> [ByteString]+toNodeNames = map (encodeUtf8 . unNodeName)++-- | Run a subgraph 't', rendering and extending any dependent nodes that aren't+-- already rendered.  This behaves like 'run' except that it doesn't do any+-- fetches.+run_ :: Nodes t => t -> Session ()+run_ = runWithFeeds_ []++-- | Run a subgraph 't', rendering any dependent nodes that aren't already+-- rendered, feed the given input values, and fetch the corresponding result+-- values for 'a'.  This behaves like 'runWithFeeds' except that it doesn't do+-- any fetches.+runWithFeeds_ :: Nodes t => [Feed] -> t -> Session ()+runWithFeeds_ feeds t = do+    ns <- build $ getNodes t+    runFetchWithFeeds feeds ns (pure ())++fixFeeds :: [Feed] -> [(ByteString, FFI.TensorData)]+fixFeeds = map $ \(Feed o d) -> (encodeUtf8 $ encodeOutput o, d)++-- | Starts a concurrent thread which evaluates the given Nodes+-- forever until runSession exits or an exception occurs. Graph+-- extension happens synchronously, but the resultant run proceeds as+-- a separate thread.+asyncProdNodes :: Nodes t+                  => t  -- ^ Node to evaluate concurrently.+                  -> Session ()+asyncProdNodes nodes = do+    target <- build (getNodes nodes)+    extend+    let targetNames = toNodeNames $ Set.toList target+    state <- Session ask+    let loop = forever (void (FFI.run (rawSession state) [] [] targetNames))+    liftIO (asyncCollector state loop)

@@ -0,0 +1,193 @@+-- 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 DataKinds #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}  -- For the Render class++module TensorFlow.Tensor where++import Data.ByteString (ByteString)+import Data.String (IsString(..))+import qualified Data.Text as Text+import Lens.Family2 ((^.))+import Lens.Family2.State ((%=), use)++import Proto.Tensorflow.Core.Framework.NodeDef (device)+import TensorFlow.Build+import TensorFlow.Output (Output, NodeName, outputNodeName, Device(..))+import TensorFlow.Types+    ( TensorData(..)+    , ListOf(..)+    )+import qualified TensorFlow.Internal.FFI as FFI++-- | A named output of a TensorFlow operation.+--+-- The type parameter @a@ is the type of the elements in the 'Tensor'.  The+-- parameter @v@ is either:+--+--   * 'Build': An unrendered, immutable value.+--   * 'Value': A rendered, immutable value.+--   * 'Ref': A rendered stateful handle (e.g., a variable).+--+-- Note that 'expr', 'value', 'render' and 'renderValue' can help convert between+-- the different types of 'Tensor'.+data Tensor v a where+    Tensor :: TensorKind v => {tensorOutput :: v Output} -> Tensor v a++newtype Value a = Value {runValue :: a}+    deriving Functor++instance Applicative Value where+    pure = Value+    Value f <*> Value x = Value $ f x++instance Monad Value where+    f >>= g = g $ runValue f++newtype Ref a = Ref {runRef :: a}+    deriving Functor++instance Applicative Ref where+    pure = Ref+    Ref f <*> Ref x = Ref $ f x++instance Monad Ref where+    f >>= g = g $ runRef f++-- | Cast a 'Tensor Ref' into a 'Tensor Value'. This behaves like a no-op.+value :: Tensor Ref a -> Tensor Value a+value (Tensor o) = Tensor $ Value $ runRef o++renderValue :: MonadBuild m => Tensor v a -> m (Tensor Value a)+renderValue (Tensor o) = render $ Tensor $ toBuild o++-- | A pair of a 'Tensor' and some data that should be fed into that 'Tensor'+-- when running the graph.+data Feed = Feed Output FFI.TensorData++-- | A class ensuring that a given tensor is rendered, i.e., has a fixed+-- name, device, etc.+class TensorKind v => Rendered v where+    rendered :: v a -> a++instance Rendered Value where+    rendered = runValue++instance Rendered Ref where+    rendered = runRef++renderedOutput :: Rendered v => Tensor v a -> Output+renderedOutput = rendered . tensorOutput++tensorNodeName :: Rendered v => Tensor v a -> NodeName+tensorNodeName = outputNodeName . renderedOutput+++-- | Create a 'Feed' for feeding the given data into a 'Tensor' when running+-- the graph.+--+-- Note that if a 'Tensor' is rendered, its identity may change; so feeding the+-- rendered 'Tensor' may be different than feeding the original 'Tensor'.+feed :: Rendered v => Tensor v a -> TensorData a -> Feed+feed t (TensorData td) = Feed (renderedOutput t) td++-- | Create a 'Tensor' for a given name.  This can be used to reference nodes+-- in a 'GraphDef' that was loaded via 'addGraphDef'.+-- TODO(judahjacobson): add more safety checks here.+tensorFromName :: TensorKind v => Text.Text -> Tensor v a+tensorFromName = Tensor . pure . fromString . Text.unpack++-- | Like 'tensorFromName', but type-restricted to 'Value'.+tensorValueFromName :: Text.Text -> Tensor Value a+tensorValueFromName = tensorFromName++-- | Like 'tensorFromName', but type-restricted to 'Ref'.+tensorRefFromName :: Text.Text -> Tensor Ref a+tensorRefFromName = tensorFromName++type TensorList v = ListOf (Tensor v)++tensorListOutputs :: Rendered v => TensorList v as -> [Output]+tensorListOutputs Nil = []+tensorListOutputs (t :/ ts) = renderedOutput t : tensorListOutputs ts++-- | Places all nodes rendered in the given 'Build' action on the same+-- device as the given Tensor (see also 'withDevice'). Make sure that+-- the action has side effects of rendering the desired tensors. A pure+-- return would not have the desired effect.+colocateWith :: (MonadBuild m, Rendered v) => Tensor v b -> m a -> m a+colocateWith t x = do+    d <- build $ Device . (^. device)+               <$> lookupNode (outputNodeName $ renderedOutput t)+    withDevice (Just d) x+++-- | Render a 'Tensor', fixing its name, scope, device and control inputs from+-- the 'MonadBuild' context.  Also renders any dependencies of the 'Tensor' that+-- weren't already rendered.+--+-- This operation is idempotent; calling 'render' on the same input in the same+-- context will produce the same result.  However, rendering the same+-- @Tensor Build@ in two different contexts may result in two different+-- @Tensor Value@s.+render :: MonadBuild m => Tensor Build a -> m (Tensor Value a)+render (Tensor t) = Tensor . Value <$> build t++-- TODO: better name.+expr :: TensorKind v => Tensor v a -> Tensor Build a+expr (Tensor o) = Tensor $ toBuild o++-- | Records the given summary action in Build for retrieval with+-- Summary protocol buffer in string form. For safety, use the+-- pre-composed functions: Logging.scalarSummary and+-- Logging.histogramSummary.+addSummary :: (MonadBuild m, TensorKind v) => Tensor v ByteString -- ^ A 'SummaryTensor'+                        -> m ()+addSummary t = build $ do+    -- TODO: more generic way+    o <- toBuild $ tensorOutput t+    summaries %= (o :)++-- | Retrieves the summary ops collected thus far. Typically this only+-- happens once, but if 'TensorFlow.Session.buildWithSummary' is used+-- repeatedly, the values accumulate.+collectAllSummaries :: MonadBuild m => m [SummaryTensor]+collectAllSummaries = build $ map (Tensor . Value) <$> use summaries++-- | Synonym for the tensors that return serialized Summary proto.+type SummaryTensor = Tensor Value ByteString++-- | An internal class for kinds of Tensors.+class Monad v => TensorKind v where+    toBuild :: v a -> Build a++instance TensorKind Value where+    toBuild = return . rendered++instance TensorKind Ref where+    toBuild = return . rendered++instance TensorKind Build where+    toBuild = id

@@ -0,0 +1,539 @@+-- 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 ConstraintKinds #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+-- We use UndecidableInstances for type families with recursive definitions+-- like "\\".  Those instances will terminate since each equation unwraps one+-- cons cell of a type-level list.+{-# LANGUAGE UndecidableInstances #-}++module TensorFlow.Types+    ( TensorType(..)+    , TensorData(..)+    , TensorDataType(..)+    , Scalar(..)+    , Shape(..)+    , protoShape+    , Attribute(..)+    , DataType(..)+    , ResourceHandle+    -- * Lists+    , ListOf(..)+    , List+    , (/:/)+    , TensorTypeProxy(..)+    , TensorTypes(..)+    , TensorTypeList+    , fromTensorTypeList+    , fromTensorTypes+    -- * Type constraints+    , OneOf+    , type (/=)+    , OneOfs+    -- ** Implementation of constraints+    , TypeError+    , ExcludedCase+    , NoneOf+    , type (\\)+    , Delete+    , AllTensorTypes+    ) where++import Data.Functor.Identity (Identity(..))+import Data.Complex (Complex)+import Data.Default (def)+import Data.Int (Int8, Int16, Int32, Int64)+import Data.Monoid ((<>))+import Data.Proxy (Proxy(..))+import Data.String (IsString)+import Data.Word (Word8, Word16, Word64)+import Foreign.Storable (Storable)+import GHC.Exts (Constraint, IsList(..))+import Lens.Family2 (Lens', view, (&), (.~))+import Lens.Family2.Unchecked (iso)+import Text.Printf (printf)+import qualified Data.Attoparsec.ByteString as Atto+import Data.ByteString (ByteString)+import qualified Data.ByteString as B+import Data.ByteString.Builder (Builder)+import qualified Data.ByteString.Builder as Builder+import qualified Data.ByteString.Lazy as L+import qualified Data.Vector as V+import qualified Data.Vector.Storable as S+import Proto.Tensorflow.Core.Framework.AttrValue+    ( AttrValue(..)+    , AttrValue'ListValue(..)+    , b+    , f+    , i+    , s+    , list+    , type'+    , shape+    , tensor+    )+import Proto.Tensorflow.Core.Framework.ResourceHandle+    (ResourceHandle)+import Proto.Tensorflow.Core.Framework.Tensor as Tensor+    ( TensorProto(..)+    , boolVal+    , doubleVal+    , floatVal+    , intVal+    , int64Val+    , resourceHandleVal+    , stringVal+    , stringVal+    )+import Proto.Tensorflow.Core.Framework.TensorShape+    ( TensorShapeProto(..)+    , dim+    , size+    )+import Proto.Tensorflow.Core.Framework.Types (DataType(..))++import TensorFlow.Internal.VarInt (getVarInt, putVarInt)+import qualified TensorFlow.Internal.FFI as FFI++-- | The class of scalar types supported by tensorflow.+class TensorType a where+    tensorType :: a -> DataType+    tensorRefType :: a -> DataType+    tensorVal :: Lens' TensorProto [a]++instance TensorType Float where+    tensorType _ = DT_FLOAT+    tensorRefType _ = DT_FLOAT_REF+    tensorVal = floatVal++instance TensorType Double where+    tensorType _ = DT_DOUBLE+    tensorRefType _ = DT_DOUBLE_REF+    tensorVal = doubleVal++instance TensorType Int32 where+    tensorType _ = DT_INT32+    tensorRefType _ = DT_INT32_REF+    tensorVal = intVal++instance TensorType Int64 where+    tensorType _ = DT_INT64+    tensorRefType _ = DT_INT64_REF+    tensorVal = int64Val++integral :: Integral a => Lens' [Int32] [a]+integral = iso (fmap fromIntegral) (fmap fromIntegral)++instance TensorType Word8 where+    tensorType _ = DT_UINT8+    tensorRefType _ = DT_UINT8_REF+    tensorVal = intVal . integral++instance TensorType Word16 where+    tensorType _ = DT_UINT16+    tensorRefType _ = DT_UINT16_REF+    tensorVal = intVal . integral++instance TensorType Int16 where+    tensorType _ = DT_INT16+    tensorRefType _ = DT_INT16_REF+    tensorVal = intVal . integral++instance TensorType Int8 where+    tensorType _ = DT_INT8+    tensorRefType _ = DT_INT8_REF+    tensorVal = intVal . integral++instance TensorType ByteString where+    tensorType _ = DT_STRING+    tensorRefType _ = DT_STRING_REF+    tensorVal = stringVal++instance TensorType Bool where+    tensorType _ = DT_BOOL+    tensorRefType _ = DT_BOOL_REF+    tensorVal = boolVal++instance TensorType (Complex Float) where+    tensorType _ = DT_COMPLEX64+    tensorRefType _ = DT_COMPLEX64+    tensorVal = error "TODO (Complex Float)"++instance TensorType (Complex Double) where+    tensorType _ = DT_COMPLEX128+    tensorRefType _ = DT_COMPLEX128+    tensorVal = error "TODO (Complex Double)"++instance TensorType ResourceHandle where+    tensorType _ = DT_RESOURCE+    tensorRefType _ = DT_RESOURCE_REF+    tensorVal = resourceHandleVal++-- | Tensor data with the correct memory layout for tensorflow.+newtype TensorData a = TensorData { unTensorData :: FFI.TensorData }++-- | Types that can be converted to and from 'TensorData'.+--+-- 'S.Vector' is the most efficient to encode/decode for most element types.+class TensorType a => TensorDataType s a where+    -- | Decode the bytes of a 'TensorData' into an 's'.+    decodeTensorData :: TensorData a -> s a+    -- | Encode an 's' into a 'TensorData'.+    --+    -- The values should be in row major order, e.g.,+    --+    --   element 0:   index (0, ..., 0)+    --   element 1:   index (0, ..., 1)+    --   ...+    encodeTensorData :: Shape -> s a -> TensorData a++-- All types, besides ByteString and Bool, are encoded as simple arrays and we+-- can use Vector.Storable to encode/decode by type casting pointers.++-- TODO(fmayle): Assert that the data type matches the return type.+simpleDecode :: Storable a => TensorData a -> S.Vector a+simpleDecode = S.unsafeCast . FFI.tensorDataBytes . unTensorData++simpleEncode :: forall a . (TensorType a, Storable a)+             => Shape -> S.Vector a -> TensorData a+simpleEncode (Shape xs) v =+    if product xs /= fromIntegral (S.length v)+        then error $ printf+            "simpleEncode: bad vector length for shape %v: expected=%d got=%d"+            (show xs) (product xs) (S.length v)+        else TensorData (FFI.TensorData xs dt (S.unsafeCast v))+  where+    dt = tensorType (undefined :: a)++instance TensorDataType S.Vector Float where+    decodeTensorData = simpleDecode+    encodeTensorData = simpleEncode++instance TensorDataType S.Vector Double where+    decodeTensorData = simpleDecode+    encodeTensorData = simpleEncode++instance TensorDataType S.Vector Int8 where+    decodeTensorData = simpleDecode+    encodeTensorData = simpleEncode++instance TensorDataType S.Vector Int16 where+    decodeTensorData = simpleDecode+    encodeTensorData = simpleEncode++instance TensorDataType S.Vector Int32 where+    decodeTensorData = simpleDecode+    encodeTensorData = simpleEncode++instance TensorDataType S.Vector Int64 where+    decodeTensorData = simpleDecode+    encodeTensorData = simpleEncode++instance TensorDataType S.Vector Word8 where+    decodeTensorData = simpleDecode+    encodeTensorData = simpleEncode++instance TensorDataType S.Vector Word16 where+    decodeTensorData = simpleDecode+    encodeTensorData = simpleEncode++-- TODO: Haskell and tensorflow use different byte sizes for bools, which makes+-- encoding more expensive. It may make sense to define a custom boolean type.+instance TensorDataType S.Vector Bool where+    decodeTensorData =+        S.convert . S.map (/= 0) . FFI.tensorDataBytes . unTensorData+    encodeTensorData (Shape xs) =+        TensorData . FFI.TensorData xs DT_BOOL . S.map fromBool . S.convert+      where+        fromBool x = if x then 1 else 0 :: Word8++instance {-# OVERLAPPABLE #-} (Storable a, TensorDataType S.Vector a, TensorType a)+    => TensorDataType V.Vector a where+    decodeTensorData = (S.convert :: S.Vector a -> V.Vector a) . decodeTensorData+    encodeTensorData x = encodeTensorData x . (S.convert :: V.Vector a -> S.Vector a)++instance {-# OVERLAPPING #-} TensorDataType V.Vector (Complex Float) where+    decodeTensorData = error "TODO (Complex Float)"+    encodeTensorData = error "TODO (Complex Float)"++instance {-# OVERLAPPING #-} TensorDataType V.Vector (Complex Double) where+    decodeTensorData = error "TODO (Complex Double)"+    encodeTensorData = error "TODO (Complex Double)"++instance {-# OVERLAPPING #-} TensorDataType V.Vector ByteString where+    -- Encoded data layout (described in third_party/tensorflow/c/c_api.h):+    --   table offsets for each element :: [Word64]+    --   at each element offset:+    --     string length :: VarInt64+    --     string data   :: [Word8]+    decodeTensorData tensorData =+        either (\err -> error $ "Malformed TF_STRING tensor; " ++ err) id $+            if expected /= count+                then Left $ "decodeTensorData for ByteString count mismatch " +++                            show (expected, count)+                else V.mapM decodeString (S.convert offsets)+      where+        expected = S.length offsets+        count = fromIntegral $ product $ FFI.tensorDataDimensions+                    $ unTensorData tensorData+        bytes = FFI.tensorDataBytes $ unTensorData tensorData+        offsets = S.take count $ S.unsafeCast bytes :: S.Vector Word64+        dataBytes = B.pack $ S.toList $ S.drop (count * 8) bytes+        decodeString :: Word64 -> Either String ByteString+        decodeString offset =+            let stringDataStart = B.drop (fromIntegral offset) dataBytes+            in Atto.eitherResult $ Atto.parse stringParser stringDataStart+        stringParser :: Atto.Parser ByteString+        stringParser = getVarInt >>= Atto.take . fromIntegral+    encodeTensorData (Shape xs) vec =+        TensorData $ FFI.TensorData xs dt byteVector+      where+        dt = tensorType (undefined :: ByteString)+        -- Add a string to an offset table and data blob.+        addString :: (Builder, Builder, Word64)+                  -> ByteString+                  -> (Builder, Builder, Word64)+        addString (table, strings, offset) str =+            ( table <> Builder.word64LE offset+            , strings <> lengthBytes <> Builder.byteString str+            , offset + lengthBytesLen + strLen+            )+          where+            strLen = fromIntegral $ B.length str+            lengthBytes = putVarInt $ fromIntegral $ B.length str+            lengthBytesLen =+                fromIntegral $ L.length $ Builder.toLazyByteString lengthBytes+        -- Encode all strings.+        (table', strings', _) = V.foldl' addString (mempty, mempty, 0) vec+        -- Concat offset table with data.+        bytes = table' <> strings'+        -- Convert to Vector Word8.+        byteVector = S.fromList $ L.unpack $ Builder.toLazyByteString bytes++newtype Scalar a = Scalar {unScalar :: a}+    deriving (Show, Eq, Ord, Num, Fractional, Floating, Real, RealFloat,+              RealFrac, IsString)++instance (TensorDataType V.Vector a, TensorType a) => TensorDataType Scalar a where+    decodeTensorData = Scalar . headFromSingleton . decodeTensorData+    encodeTensorData x (Scalar y) = encodeTensorData x (V.fromList [y])++headFromSingleton :: V.Vector a -> a+headFromSingleton x+    | V.length x == 1 = V.head x+    | otherwise = error $+                  "Unable to extract singleton from tensor of length "+                  ++ show (V.length x)+++-- | Shape (dimensions) of a tensor.+newtype Shape = Shape [Int64] deriving Show++instance IsList Shape where+    type Item Shape = Int64+    fromList = Shape . fromList+    toList (Shape ss) = toList ss++protoShape :: Lens' TensorShapeProto Shape+protoShape = iso protoToShape shapeToProto+  where+    protoToShape = Shape . fmap (view size) . view dim+    shapeToProto (Shape ds) = (def :: TensorShapeProto) & dim .~ fmap (\d -> def & size .~ d) ds+++class Attribute a where+    attrLens :: Lens' AttrValue a++instance Attribute Float where+    attrLens = f++instance Attribute ByteString where+    attrLens = s++instance Attribute Int64 where+    attrLens = i++instance Attribute DataType where+    attrLens = type'++instance Attribute TensorProto where+    attrLens = tensor++instance Attribute Bool where+    attrLens = b++instance Attribute Shape where+    attrLens = shape . protoShape++-- TODO(gnezdo): support generating list(Foo) from [Foo].+instance Attribute AttrValue'ListValue where+    attrLens = list++instance Attribute [DataType] where+    attrLens = list . type'++instance Attribute [Int64] where+    attrLens = list . i++-- | A heterogeneous list type.+data ListOf f as where+    Nil :: ListOf f '[]+    (:/) :: f a -> ListOf f as -> ListOf f (a ': as)++infixr 5 :/++type family All f as :: Constraint where+    All f '[] = ()+    All f (a ': as) = (f a, All f as)++type family Map f as where+    Map f '[] = '[]+    Map f (a ': as) = f a ': Map f as++instance All Eq (Map f as) => Eq (ListOf f as) where+    Nil == Nil = True+    (x :/ xs) == (y :/ ys) = x == y && xs == ys+    -- Newer versions of GHC use the GADT to tell that the previous cases are+    -- exhaustive.+#if __GLASGOW_HASKELL__ < 800+    _ == _ = False+#endif++instance All Show (Map f as) => Show (ListOf f as) where+    showsPrec _ Nil = showString "Nil"+    showsPrec d (x :/ xs) = showParen (d > 10)+                                $ showsPrec 6 x . showString " :/ "+                                    . showsPrec 6 xs++type List = ListOf Identity++-- | Equivalent of ':/' for lists.+(/:/) :: a -> List as -> List (a ': as)+(/:/) = (:/) . Identity++infixr 5 /:/++-- | A 'Constraint' specifying the possible choices of a 'TensorType'.+--+-- We implement a 'Constraint' like @OneOf '[Double, Float] a@ by turning the+-- natural representation as a conjunction, i.e.,+--+-- @+--    a == Double || a == Float+-- @+--+-- into a disjunction like+--+-- @+--     a \/= Int32 && a \/= Int64 && a \/= ByteString && ...+-- @+--+-- using an enumeration of all the possible 'TensorType's.+type OneOf ts a+    -- Assert `TensorTypes ts` to make error messages a little better.+    = (TensorType a, TensorTypes ts, NoneOf (AllTensorTypes \\ ts) a)++type OneOfs ts as = (TensorTypes as, TensorTypes ts,+                        NoneOfs (AllTensorTypes \\ ts) as)++type family NoneOfs ts as :: Constraint where+    NoneOfs ts '[] = ()+    NoneOfs ts (a ': as) = (NoneOf ts a, NoneOfs ts as)++data TensorTypeProxy a where+    TensorTypeProxy :: TensorType a => TensorTypeProxy a++type TensorTypeList = ListOf TensorTypeProxy++fromTensorTypeList :: TensorTypeList ts -> [DataType]+fromTensorTypeList Nil = []+fromTensorTypeList ((TensorTypeProxy :: TensorTypeProxy t) :/ ts)+    = tensorType (undefined :: t) : fromTensorTypeList ts++fromTensorTypes :: forall as . TensorTypes as => Proxy as -> [DataType]+fromTensorTypes _ = fromTensorTypeList (tensorTypes :: TensorTypeList as)++class TensorTypes (ts :: [*]) where+    tensorTypes :: TensorTypeList ts++instance TensorTypes '[] where+    tensorTypes = Nil++-- | A constraint that the input is a list of 'TensorTypes'.+instance (TensorType t, TensorTypes ts) => TensorTypes (t ': ts) where+    tensorTypes = TensorTypeProxy :/ tensorTypes++-- | A constraint checking that two types are different.+type family a /= b :: Constraint where+    a /= a = TypeError a ~ ExcludedCase+    a /= b = ()++-- | Helper types to produce a reasonable type error message when the Constraint+-- "a /= a" fails.+-- TODO(judahjacobson): Use ghc-8's CustomTypeErrors for this.+data TypeError a+data ExcludedCase++-- | An enumeration of all valid 'TensorType's.+type AllTensorTypes =+    -- NOTE: This list should be kept in sync with+    -- TensorFlow.OpGen.dtTypeToHaskell.+    -- TODO: Add support for Complex Float/Double.+    '[ Float+     , Double+     , Int8+     , Int16+     , Int32+     , Int64+     , Word8+     , Word16+     , ByteString+     , Bool+     ]++-- | Removes a type from the given list of types.+type family Delete a as where+    Delete a '[] = '[]+    Delete a (a ': as) = Delete a as+    Delete a (b ': as) = b ': Delete a as++-- | Takes the difference of two lists of types.+type family as \\ bs where+    as \\ '[] = as+    as \\ (b ': bs) = Delete b as \\ bs++-- | A constraint that the type @a@ doesn't appear in the type list @ts@.+-- Assumes that @a@ and each of the elements of @ts@ are 'TensorType's.+type family NoneOf ts a :: Constraint where+    -- Specialize this type family when `ts` is a long list, to avoid deeply+    -- nested tuples of constraints.  Works around a bug in ghc-8:+    -- https://ghc.haskell.org/trac/ghc/ticket/12175+    NoneOf (t1 ': t2 ': t3 ': t4 ': ts) a+        = (a /= t1, a /= t2, a /= t3, a /= t4, NoneOf ts a)+    NoneOf (t1 ': t2 ': t3 ': ts) a = (a /= t1, a /= t2, a /= t3, NoneOf ts a)+    NoneOf (t1 ': t2 ': ts) a = (a /= t1, a /= t2, NoneOf ts a)+    NoneOf (t1 ': ts) a = (a /= t1, NoneOf ts a)+    NoneOf '[] a = ()

@@ -0,0 +1,94 @@+name:                tensorflow+version:             0.1.0.0+synopsis:            TensorFlow bindings.+description:+    This library provides an interface to the TensorFlow+    bindings.  "TensorFlow.Core" contains the base API for+    building and running computational graphs.  Other packages+    such as @tensorflow-ops@ contain bindings to the actual+    computational kernels.+    .+    For more documentation and examples, see+    <https://github.com/tensorflow/haskell#readme>+homepage:            https://github.com/tensorflow/haskell#readme+license:             Apache+license-file:        LICENSE+author:              TensorFlow authors+maintainer:          tensorflow-haskell@googlegroups.com+copyright:           Google Inc.+category:            Machine Learning+build-type:          Simple+cabal-version:       >=1.22++library+  hs-source-dirs:   src+  exposed-modules:  TensorFlow.Build+                  , TensorFlow.BuildOp+                  , TensorFlow.ControlFlow+                  , TensorFlow.Core+                  , TensorFlow.Internal.FFI+                  , TensorFlow.Internal.VarInt+                  , TensorFlow.Nodes+                  , TensorFlow.Output+                  , TensorFlow.Session+                  , TensorFlow.Tensor+                  , TensorFlow.Types+  other-modules:    TensorFlow.Internal.Raw+                  , TensorFlow.Orphans+  build-tools:      c2hs+  build-depends:  proto-lens == 0.2.*+                -- Used by the custom Setup script (for the test-suite).+                , proto-lens-protoc == 0.2.*+                , tensorflow-proto == 0.1.*+                , base >= 4.7 && < 5+                , async+                , attoparsec+                , bytestring+                , containers+                , data-default+                , exceptions+                , fgl+                , lens-family+                , mainland-pretty+                , mtl+                , semigroups+                , split+                , text+                , temporary+                , transformers+                , vector+  extra-libraries:     tensorflow+  default-language:    Haskell2010+  include-dirs: .++Test-Suite FFITest+  default-language: Haskell2010+  type: exitcode-stdio-1.0+  main-is: FFITest.hs+  hs-source-dirs: tests+  build-depends: HUnit+               , base+               , bytestring+               , lens-family+               , proto-lens+               , tensorflow+               , tensorflow-proto+               , test-framework+               , test-framework-hunit+++Test-Suite VarIntTest+  default-language: Haskell2010+  type: exitcode-stdio-1.0+  main-is: VarIntTest.hs+  hs-source-dirs: tests+  build-depends: base+               , attoparsec+               , bytestring+               , tensorflow+               , test-framework+               , test-framework-quickcheck2++source-repository head+  type:     git+  location: https://github.com/tensorflow/haskell

@@ -0,0 +1,39 @@+-- 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.++-- | Tests for FFI.++module Main where++import Data.ProtoLens (decodeMessage)+import Lens.Family2 (view)+import TensorFlow.Internal.FFI (getAllOpList)+import Test.HUnit (assertBool, assertFailure)+import Test.Framework (defaultMain)+import Test.Framework.Providers.HUnit (testCase)+import Proto.Tensorflow.Core.Framework.OpDef (OpList, op)++testParseAll :: IO ()+testParseAll = do+    opList <- getAllOpList+    either+        assertFailure+        (assertBool "Expected non-empty list of default Ops"+         . not . null . view op)+        (decodeMessage opList :: Either String OpList)++main :: IO ()+main = defaultMain+    [ testCase "ParseAllOps" testParseAll+    ]

@@ -0,0 +1,33 @@+-- 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.++module Main where++import Data.ByteString.Builder (toLazyByteString)+import Test.Framework (defaultMain, Test)+import Test.Framework.Providers.QuickCheck2 (testProperty)+import qualified Data.Attoparsec.ByteString.Lazy as Atto++import TensorFlow.Internal.VarInt++testEncodeDecode :: Test+testEncodeDecode = testProperty "testEncodeDecode" $ \x ->+    let bytes = toLazyByteString (putVarInt x)+    in case Atto.eitherResult $ Atto.parse getVarInt bytes of+        Left _ -> False+        Right y -> x == y++main :: IO ()+main = defaultMain [ testEncodeDecode+                   ]