<commit_before>-- GSoC 2015 - Haskell bindings for OpenCog.
{-# LANGUAGE GADTs         #-}
{-# LANGUAGE DataKinds     #-}
{-# LANGUAGE TypeOperators #-}

-- | This Module defines some useful data types for proper interaction
-- with the AtomSpace C wrapper library.
-- Intended for internal use only.
module OpenCog.AtomSpace.Internal (
      UUID(..)
    , AtomTypeRaw(..)
    , AtomRaw(..)
    , toRaw
    , fromRaw
    , fromRawGen
    , TVRaw(..)
    , fromTVRaw
    , toTVRaw
    , TVTypeEnum(..)
    , tvMAX_PARAMS
    ) where

import Foreign.C.Types               (CULong(..))
import Data.Functor                  ((<$>))
import Data.Typeable                 (cast,Typeable)
import OpenCog.AtomSpace.Filter      (FilterIsChild(..))
import OpenCog.AtomSpace.Sugar       (noTv)
import OpenCog.AtomSpace.AtomType    (AtomType(..),fromAtomTypeRaw,toAtomTypeRaw)
import OpenCog.AtomSpace.Types       (Atom(..),AtomName(..),getType,TruthVal(..),
                                      appGen,Gen(..),AtomGen)
import OpenCog.AtomSpace.Inheritance

-- Data type to hold atoms's UUID.
type UUID = CULong
type AtomTypeRaw = String

-- Main general atom representation.
data AtomRaw = Link AtomTypeRaw [AtomRaw] TVRaw
             | Node AtomTypeRaw AtomName  TVRaw
        deriving (Eq,Show)

-- Function to convert an Atom to its general representation.
toRaw :: (Typeable a) => Atom a -> AtomRaw
toRaw at = let atype     = getType at
               defaultTv = toTVRaw noTv
           in case at of
    PredicateNode n tv         -> Node atype n $ toTVRaw tv
    DefinedPredicateNode n tv  -> Node atype n $ toTVRaw tv
    ConceptNode n tv           -> Node atype n $ toTVRaw tv
    NumberNode d               -> Node atype (show d) defaultTv
    SchemaNode n               -> Node atype n defaultTv
    GroundedSchemaNode n       -> Node atype n defaultTv
    VariableNode n             -> Node atype n defaultTv
    AnchorNode n               -> Node atype n defaultTv
    AndLink tv list            -> Link atype (map (appGen toRaw) list) $ toTVRaw tv
    OrLink tv list             -> Link atype (map (appGen toRaw) list) $ toTVRaw tv
    ImplicationLink tv a1 a2   -> Link atype [toRaw a1,toRaw a2] $ toTVRaw tv
    EquivalenceLink tv a1 a2   -> Link atype [toRaw a1,toRaw a2] $ toTVRaw tv
    EvaluationLink tv a1 a2    -> Link atype [toRaw a1,toRaw a2] $ toTVRaw tv
    InheritanceLink tv a1 a2   -> Link atype [toRaw a1,toRaw a2] $ toTVRaw tv
    SimilarityLink tv a1 a2    -> Link atype [toRaw a1,toRaw a2] $ toTVRaw tv
    MemberLink tv a1 a2        -> Link atype [toRaw a1,toRaw a2] $ toTVRaw tv
    SatisfyingSetLink a1       -> Link atype [toRaw a1] defaultTv
    ExecutionLink a1 a2 a3     -> Link atype [toRaw a1,toRaw a2,toRaw a3] defaultTv
    ListLink list              -> Link atype (map (appGen toRaw) list) defaultTv
    SetLink list               -> Link atype (map (appGen toRaw) list) defaultTv
    SatisfactionLink (VariableList []) a2 -> Link atype [toRaw a2] defaultTv
    SatisfactionLink a1 a2     -> Link atype [toRaw a1,toRaw a2] defaultTv
    ForAllLink tv a1 a2        -> Link atype [toRaw a1,toRaw a2] $ toTVRaw tv
    ExistsLink tv a1 a2        -> Link atype [toRaw a1,toRaw a2] $ toTVRaw tv
    AverageLink tv a1 a2       -> Link atype [toRaw a1,toRaw a2] $ toTVRaw tv
    QuoteLink a1               -> Link atype [toRaw a1] defaultTv
    VariableList list          -> Link atype (map (appGen toRaw) list) defaultTv
    BindLink a1 a2 a3          -> Link atype [toRaw a1,toRaw a2,toRaw a3] defaultTv
    ContextLink tv c e         -> Link atype [toRaw c,toRaw e] $ toTVRaw tv
    LambdaLink v a             -> Link atype [toRaw v,toRaw a] defaultTv
    NotLink tv a               -> Link atype [toRaw a] $ toTVRaw tv
    SubsetLink tv a1 a2        -> Link atype [toRaw a1,toRaw a2] $ toTVRaw tv
    EqualLink a1 a2            -> Link atype [toRaw a1,toRaw a2] defaultTv
    TrueLink                   -> Link atype [] defaultTv
    FalseLink                  -> Link atype [] defaultTv
    DefineLink a1 a2           -> Link atype [toRaw a1,toRaw a2] defaultTv
    SequentialAndLink list     -> Link atype (map (appGen toRaw) list) defaultTv
    SequentialOrLink list      -> Link atype (map (appGen toRaw) list) defaultTv
    _                          -> error $ "You should complete the code of toRaw"
                                      ++ " with an instance for: " ++ show at

-- Function to get an Atom back from its general representation (if possible).
fromRaw :: (Typeable a) => AtomRaw -> Atom a -> Maybe (Atom a)
fromRaw raw _ = fromRawGen raw >>= appGen cast

-- Function to get an Atom back from its general representation (if possible).
fromRawGen :: AtomRaw -> Maybe AtomGen
fromRawGen (Node araw n tvraw) = let tv = fromTVRaw tvraw in do
    atype <- fromAtomTypeRaw araw
    case atype of
      ConceptT          -> Just $ Gen $ ConceptNode n tv
      PredicateT        -> Just $ Gen $ PredicateNode n tv
      DefinedPredicateT -> Just $ Gen $ DefinedPredicateNode n tv
      SchemaT           -> Just $ Gen $ SchemaNode n
      GroundedSchemaT   -> Just $ Gen $ GroundedSchemaNode n
      VariableT         -> Just $ Gen $ VariableNode n
      AnchorT           -> Just $ Gen $ AnchorNode n
      NumberT           -> readMaybe n >>= Just . Gen . NumberNode
      x                 -> error $ "You should complete the code of fromRawGen"
                               ++ " with an instance for: " ++ show x
    where
        readMaybe :: (Read a) => String -> Maybe a
        readMaybe s = case reads s of
                        [(x, "")] -> Just x
                        _ -> Nothing
fromRawGen (Link araw out tvraw) = let tv = fromTVRaw tvraw in do
    atype <- fromAtomTypeRaw araw
    case (atype,out) of
      (AndT,_) -> do
        lnew <- mapM fromRawGen out
        Just $ Gen $ AndLink tv lnew
      (OrT,_) -> do
        lnew <- mapM fromRawGen out
        Just $ Gen $ OrLink tv lnew
      (SequentialAndT,_) -> do
        lnew <- mapM fromRawGen out
        Just $ Gen $ SequentialAndLink lnew
      (SequentialOrT, _     ) -> do
        lnew <- mapM fromRawGen out
        Just $ Gen $ SequentialOrLink lnew
      (ImplicationT ,[ar,br]) -> do
        a <- filt ar :: Maybe (Gen AtomT)
        b <- filt br :: Maybe (Gen AtomT)
        case (a,b) of
          (Gen a1,Gen b1) -> Just $ Gen $ ImplicationLink tv a1 b1
      (EquivalenceT ,[ar,br]) -> do
        a <- filt ar :: Maybe (Gen AtomT)
        b <- filt br :: Maybe (Gen AtomT)
        case (a,b) of
          (Gen a1,Gen b1) -> Just $ Gen $ EquivalenceLink tv a1 b1
      (EvaluationT ,[ar,br]) -> do
        a <- filt ar :: Maybe (Gen PredicateT)
        b <- filt br :: Maybe (Gen AtomT)
        case (a,b) of
          (Gen a1,Gen b1) -> Just $ Gen $ EvaluationLink tv a1 b1
      (InheritanceT ,[ar,br]) -> do
        a <- filt ar :: Maybe (Gen AtomT)
        b <- filt br :: Maybe (Gen AtomT)
        case (a,b) of
          (Gen a1,Gen b1) -> Just $ Gen $ InheritanceLink tv a1 b1
      (SimilarityT ,[ar,br]) -> do
        a <- filt ar :: Maybe (Gen AtomT)
        b <- filt br :: Maybe (Gen AtomT)
        case (a,b) of
          (Gen a1,Gen b1) -> Just $ Gen $ SimilarityLink tv a1 b1
      (MemberT ,[ar,br]) -> do
        a <- filt ar :: Maybe (Gen AtomT)
        b <- filt br :: Maybe (Gen ConceptT)
        case (a,b) of
          (Gen a1,Gen b1) -> Just $ Gen $ MemberLink tv a1 b1
      (SatisfyingSetT ,[ar]) -> do
        a <- filt ar :: Maybe (Gen PredicateT)
        case a of
          (Gen a1) -> Just $ Gen $ SatisfyingSetLink a1
      (ExecutionT ,[ar,br,cr]) -> do
        a <- filt ar :: Maybe (Gen SchemaT)
        b <- filt br :: Maybe (Gen AtomT)
        c <- filt cr :: Maybe (Gen AtomT)
        case (a,b,c) of
          (Gen a1,Gen b1,Gen c1) -> Just $ Gen $ ExecutionLink a1 b1 c1
      (ListT, _     ) -> do
        lnew <- mapM fromRawGen out
        Just $ Gen $ ListLink lnew
      (SetT, _     ) -> do
        lnew <- mapM fromRawGen out
        Just $ Gen $ SetLink lnew
      (SatisfactionT ,[ar,br]) -> do
        a <- filt ar :: Maybe (Gen VariableListT)
        b <- filt br :: Maybe (Gen LinkT)
        case (a,b) of
          (Gen a1,Gen b1) -> Just $ Gen $ SatisfactionLink a1 b1
      (ForAllT ,[ar,br]) -> do
        a <- filt ar :: Maybe (Gen VariableListT)
        b <- filt br :: Maybe (Gen AtomT)
        case (a,b) of
          (Gen a1,Gen b1) -> Just $ Gen $ ForAllLink tv a1 b1
      (ExistsT ,[ar,br]) -> do
        a <- filt ar :: Maybe (Gen VariableListT)
        b <- filt br :: Maybe (Gen AtomT)
        case (a,b) of
          (Gen a1,Gen b1) -> Just $ Gen $ ExistsLink tv a1 b1
      (AverageT ,[ar,br]) -> do
        a <- filt ar :: Maybe (Gen VariableT)
        b <- filt br :: Maybe (Gen AtomT)
        case (a,b) of
          (Gen a1,Gen b1) -> Just $ Gen $ AverageLink tv a1 b1<commit_msg>Fixed missing handeling for Unary SatisfactionLink<commit_after>-- GSoC 2015 - Haskell bindings for OpenCog.
{-# LANGUAGE GADTs         #-}
{-# LANGUAGE DataKinds     #-}
{-# LANGUAGE TypeOperators #-}

-- | This Module defines some useful data types for proper interaction
-- with the AtomSpace C wrapper library.
-- Intended for internal use only.
module OpenCog.AtomSpace.Internal (
      UUID(..)
    , AtomTypeRaw(..)
    , AtomRaw(..)
    , toRaw
    , fromRaw
    , fromRawGen
    , TVRaw(..)
    , fromTVRaw
    , toTVRaw
    , TVTypeEnum(..)
    , tvMAX_PARAMS
    ) where

import Foreign.C.Types               (CULong(..))
import Data.Functor                  ((<$>))
import Data.Typeable                 (cast,Typeable)
import OpenCog.AtomSpace.Filter      (FilterIsChild(..))
import OpenCog.AtomSpace.Sugar       (noTv)
import OpenCog.AtomSpace.AtomType    (AtomType(..),fromAtomTypeRaw,toAtomTypeRaw)
import OpenCog.AtomSpace.Types       (Atom(..),AtomName(..),getType,TruthVal(..),
                                      appGen,Gen(..),AtomGen)
import OpenCog.AtomSpace.Inheritance

-- Data type to hold atoms's UUID.
type UUID = CULong
type AtomTypeRaw = String

-- Main general atom representation.
data AtomRaw = Link AtomTypeRaw [AtomRaw] TVRaw
             | Node AtomTypeRaw AtomName  TVRaw
        deriving (Eq,Show)

-- Function to convert an Atom to its general representation.
toRaw :: (Typeable a) => Atom a -> AtomRaw
toRaw at = let atype     = getType at
               defaultTv = toTVRaw noTv
           in case at of
    PredicateNode n tv         -> Node atype n $ toTVRaw tv
    DefinedPredicateNode n tv  -> Node atype n $ toTVRaw tv
    ConceptNode n tv           -> Node atype n $ toTVRaw tv
    NumberNode d               -> Node atype (show d) defaultTv
    SchemaNode n               -> Node atype n defaultTv
    GroundedSchemaNode n       -> Node atype n defaultTv
    VariableNode n             -> Node atype n defaultTv
    AnchorNode n               -> Node atype n defaultTv
    AndLink tv list            -> Link atype (map (appGen toRaw) list) $ toTVRaw tv
    OrLink tv list             -> Link atype (map (appGen toRaw) list) $ toTVRaw tv
    ImplicationLink tv a1 a2   -> Link atype [toRaw a1,toRaw a2] $ toTVRaw tv
    EquivalenceLink tv a1 a2   -> Link atype [toRaw a1,toRaw a2] $ toTVRaw tv
    EvaluationLink tv a1 a2    -> Link atype [toRaw a1,toRaw a2] $ toTVRaw tv
    InheritanceLink tv a1 a2   -> Link atype [toRaw a1,toRaw a2] $ toTVRaw tv
    SimilarityLink tv a1 a2    -> Link atype [toRaw a1,toRaw a2] $ toTVRaw tv
    MemberLink tv a1 a2        -> Link atype [toRaw a1,toRaw a2] $ toTVRaw tv
    SatisfyingSetLink a1       -> Link atype [toRaw a1] defaultTv
    ExecutionLink a1 a2 a3     -> Link atype [toRaw a1,toRaw a2,toRaw a3] defaultTv
    ListLink list              -> Link atype (map (appGen toRaw) list) defaultTv
    SetLink list               -> Link atype (map (appGen toRaw) list) defaultTv
    SatisfactionLink (VariableList []) a2 -> Link atype [toRaw a2] defaultTv
    SatisfactionLink a1 a2     -> Link atype [toRaw a1,toRaw a2] defaultTv
    ForAllLink tv a1 a2        -> Link atype [toRaw a1,toRaw a2] $ toTVRaw tv
    ExistsLink tv a1 a2        -> Link atype [toRaw a1,toRaw a2] $ toTVRaw tv
    AverageLink tv a1 a2       -> Link atype [toRaw a1,toRaw a2] $ toTVRaw tv
    QuoteLink a1               -> Link atype [toRaw a1] defaultTv
    VariableList list          -> Link atype (map (appGen toRaw) list) defaultTv
    BindLink a1 a2 a3          -> Link atype [toRaw a1,toRaw a2,toRaw a3] defaultTv
    ContextLink tv c e         -> Link atype [toRaw c,toRaw e] $ toTVRaw tv
    LambdaLink v a             -> Link atype [toRaw v,toRaw a] defaultTv
    NotLink tv a               -> Link atype [toRaw a] $ toTVRaw tv
    SubsetLink tv a1 a2        -> Link atype [toRaw a1,toRaw a2] $ toTVRaw tv
    EqualLink a1 a2            -> Link atype [toRaw a1,toRaw a2] defaultTv
    TrueLink                   -> Link atype [] defaultTv
    FalseLink                  -> Link atype [] defaultTv
    DefineLink a1 a2           -> Link atype [toRaw a1,toRaw a2] defaultTv
    SequentialAndLink list     -> Link atype (map (appGen toRaw) list) defaultTv
    SequentialOrLink list      -> Link atype (map (appGen toRaw) list) defaultTv
    _                          -> error $ "You should complete the code of toRaw"
                                      ++ " with an instance for: " ++ show at

-- Function to get an Atom back from its general representation (if possible).
fromRaw :: (Typeable a) => AtomRaw -> Atom a -> Maybe (Atom a)
fromRaw raw _ = fromRawGen raw >>= appGen cast

-- Function to get an Atom back from its general representation (if possible).
fromRawGen :: AtomRaw -> Maybe AtomGen
fromRawGen (Node araw n tvraw) = let tv = fromTVRaw tvraw in do
    atype <- fromAtomTypeRaw araw
    case atype of
      ConceptT          -> Just $ Gen $ ConceptNode n tv
      PredicateT        -> Just $ Gen $ PredicateNode n tv
      DefinedPredicateT -> Just $ Gen $ DefinedPredicateNode n tv
      SchemaT           -> Just $ Gen $ SchemaNode n
      GroundedSchemaT   -> Just $ Gen $ GroundedSchemaNode n
      VariableT         -> Just $ Gen $ VariableNode n
      AnchorT           -> Just $ Gen $ AnchorNode n
      NumberT           -> readMaybe n >>= Just . Gen . NumberNode
      x                 -> error $ "You should complete the code of fromRawGen"
                               ++ " with an instance for: " ++ show x
    where
        readMaybe :: (Read a) => String -> Maybe a
        readMaybe s = case reads s of
                        [(x, "")] -> Just x
                        _ -> Nothing
fromRawGen (Link araw out tvraw) = let tv = fromTVRaw tvraw in do
    atype <- fromAtomTypeRaw araw
    case (atype,out) of
      (AndT,_) -> do
        lnew <- mapM fromRawGen out
        Just $ Gen $ AndLink tv lnew
      (OrT,_) -> do
        lnew <- mapM fromRawGen out
        Just $ Gen $ OrLink tv lnew
      (SequentialAndT,_) -> do
        lnew <- mapM fromRawGen out
        Just $ Gen $ SequentialAndLink lnew
      (SequentialOrT, _     ) -> do
        lnew <- mapM fromRawGen out
        Just $ Gen $ SequentialOrLink lnew
      (ImplicationT ,[ar,br]) -> do
        a <- filt ar :: Maybe (Gen AtomT)
        b <- filt br :: Maybe (Gen AtomT)
        case (a,b) of
          (Gen a1,Gen b1) -> Just $ Gen $ ImplicationLink tv a1 b1
      (EquivalenceT ,[ar,br]) -> do
        a <- filt ar :: Maybe (Gen AtomT)
        b <- filt br :: Maybe (Gen AtomT)
        case (a,b) of
          (Gen a1,Gen b1) -> Just $ Gen $ EquivalenceLink tv a1 b1
      (EvaluationT ,[ar,br]) -> do
        a <- filt ar :: Maybe (Gen PredicateT)
        b <- filt br :: Maybe (Gen AtomT)
        case (a,b) of
          (Gen a1,Gen b1) -> Just $ Gen $ EvaluationLink tv a1 b1
      (InheritanceT ,[ar,br]) -> do
        a <- filt ar :: Maybe (Gen AtomT)
        b <- filt br :: Maybe (Gen AtomT)
        case (a,b) of
          (Gen a1,Gen b1) -> Just $ Gen $ InheritanceLink tv a1 b1
      (SimilarityT ,[ar,br]) -> do
        a <- filt ar :: Maybe (Gen AtomT)
        b <- filt br :: Maybe (Gen AtomT)
        case (a,b) of
          (Gen a1,Gen b1) -> Just $ Gen $ SimilarityLink tv a1 b1
      (MemberT ,[ar,br]) -> do
        a <- filt ar :: Maybe (Gen AtomT)
        b <- filt br :: Maybe (Gen ConceptT)
        case (a,b) of
          (Gen a1,Gen b1) -> Just $ Gen $ MemberLink tv a1 b1
      (SatisfyingSetT ,[ar]) -> do
        a <- filt ar :: Maybe (Gen PredicateT)
        case a of
          (Gen a1) -> Just $ Gen $ SatisfyingSetLink a1
      (ExecutionT ,[ar,br,cr]) -> do
        a <- filt ar :: Maybe (Gen SchemaT)
        b <- filt br :: Maybe (Gen AtomT)
        c <- filt cr :: Maybe (Gen AtomT)
        case (a,b,c) of
          (Gen a1,Gen b1,Gen c1) -> Just $ Gen $ ExecutionLink a1 b1 c1
      (ListT, _     ) -> do
        lnew <- mapM fromRawGen out
        Just $ Gen $ ListLink lnew
      (SetT, _     ) -> do
        lnew <- mapM fromRawGen out
        Just $ Gen $ SetLink lnew
      (SatisfactionT ,[br]) -> do
        b <- filt br :: Maybe (Gen LinkT)
        case (b) of
          (Gen b1) -> Just $ Gen $ SatisfactionLink (VariableList []) b1
      (SatisfactionT ,[ar,br]) -> do
        a <- filt ar :: Maybe (Gen VariableListT)
        b <- filt br :: Maybe (Gen LinkT)
        case (a,b) of
          (Gen a1,Gen b1) -> Just $ Gen $ SatisfactionLink a1 b1
      (ForAllT ,[ar,br]) -> do
        a <- filt ar :: Maybe (Gen VariableListT)
        b <- filt br :: Maybe (Gen AtomT)
        case (a,b) of
          (Gen a1,Gen b1) -> Just $ Gen $ ForAllLink tv a1 b1
      (ExistsT ,[ar,br]) -> do
        a <- filt ar :: Maybe (Gen VariableListT)
        b <- filt br :: Maybe (Gen AtomT)
        case (a,b) of
          (Gen a1,Gen b1) -> Just $ Gen $ ExistsLink tv a1 b1
      (AverageT ,[ar,br]) -> do
        a <- filt ar :: Maybe (Gen VariableT)
        b <- filt br :: Maybe (Gen AtomT)
        case (a,b) of
          (Gen a1,Gen b1) -> Just $ Gen $ AverageLink tv a1 b1
{'fraction_non_alphanumeric': 0.1010679719657359, 'fraction_numerical': 0.013683390810991212, 'mean_word_length': 1.8488353668198383, 'pattern_counts': {'":': 0, '<': 70, '<?xml version=': 0, '>': 191, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 12, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '3945342', 'n_tokens_mistral': 6105, 'n_tokens_neox': 5936, 'n_words': 2057}