Property.hs

module Graql.Property
    ( Property (..)
    , Var
    , Name
    , VarOrName
    , Value (..)
    , IsVarOrName
    , IsRolePlayer
    , IsResource
    , var
    , name
    , (.:)
    , rp
    , toVarOrName
    , toRolePlayer
    , toResource
    ) where

import           Graql.Util
import           Data.Text        (Text, unpack)
import           Data.Scientific  (Scientific)
import           Text.Regex.Posix ((=~))
import           Control.Applicative (empty)
import           Data.Aeson       (FromJSON, FromJSONKey,
                                   FromJSONKeyFunction (FromJSONKeyText),
                                   parseJSON)
import qualified Data.Aeson       as Aeson

-- |A property of a concept
data Property = Isa VarOrName
              | NameProperty Name
              | Rel [RolePlayer]
              | Has Name (Either Value Var)

-- |A variable name wildcard that will represent a concept in the results
data Var = Var Text deriving (Eq, Ord)

-- |A name of something in the graph
data Name = Name Text

-- |Something that may be a variable name or a type name
data VarOrName = VarName Var | TypeName Name

-- |A value of a resource
data Value = ValueString Text | ValueNumber Scientific | ValueBool Bool

-- |A casting, relating a role type and role player
data RolePlayer = RolePlayer (Maybe VarOrName) Var

-- |Something that can be converted into a variable or a type name
class IsVarOrName a where
    toVarOrName :: a -> VarOrName

-- |Something that can be converted into a casting
class IsRolePlayer a where
    toRolePlayer :: a -> RolePlayer

-- |Something that can be converted into a resource value or variable
class IsResource a where
    toResource :: a -> Either Value Var

-- |Create a variable
var :: Text -> Var
var = Var

-- |Create a name of something in the graph
name :: Text -> Name
name = Name

-- |A casting in a relation between a role type and a role player
(.:) :: IsVarOrName a => a -> Var -> RolePlayer
rt .: player = RolePlayer (Just $ toVarOrName rt) player

-- |A casting in a relation without a role type
rp :: Var -> RolePlayer
rp = RolePlayer Nothing


nameRegex :: String
nameRegex = "^[a-zA-Z_][a-zA-Z0-9_-]*$"

instance Show Property where
    show (Isa varOrName ) = "isa " ++ show varOrName
    show (NameProperty n) = "type-name " ++ show n
    show (Rel castings  ) = "(" ++ commas castings ++ ")"
    show (Has rt value  ) = "has " ++ show rt ++ " " ++ showEither value

instance Show RolePlayer where
    show (RolePlayer roletype player) = roletype `with` ": " ++ show player

instance Show Value where
    show (ValueString text) = show text
    show (ValueNumber num ) = show num
    show (ValueBool   bool) = show bool

instance Show Name where
    show (Name text)
      | str =~ nameRegex = str
      | otherwise      = show text
        where str = unpack text

instance Show Var where
    show (Var v) = '$' : unpack v

instance Show VarOrName where
    show (VarName  v) = show v
    show (TypeName t) = show t

instance IsVarOrName Var where
    toVarOrName = VarName

instance IsVarOrName Name where
    toVarOrName = TypeName

instance IsRolePlayer RolePlayer where
    toRolePlayer = id

instance IsRolePlayer Var where
    toRolePlayer = rp

instance IsResource Var where
    toResource = Right

instance IsResource Text where
    toResource = Left . ValueString

instance IsResource Scientific where
    toResource = Left . ValueNumber

instance IsResource Bool where
    toResource = Left . ValueBool

instance FromJSON Value where
  parseJSON (Aeson.String s) = return $ ValueString s
  parseJSON (Aeson.Number n) = return $ ValueNumber n
  parseJSON (Aeson.Bool   b) = return $ ValueBool b
  parseJSON _                = empty

instance FromJSON Name where
  parseJSON (Aeson.String s) = return $ name s
  parseJSON _                = empty

instance FromJSON Var where
  parseJSON (Aeson.String s) = return $ var s
  parseJSON _                = empty

instance FromJSONKey Var where
  fromJSONKey = FromJSONKeyText var

showEither :: (Show a, Show b) => Either a b -> String
showEither = either show show