Property.hs

module Grakn.Property
  ( Property(Isa, Has, Rel)
  , RolePlayer
  , Var
  , Label
  , VarOrLabel
  , Value(ValueString, ValueNumber, ValueBool)
  , var
  , label
  , (.:)
  , rp
  ) where

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

-- |A property of a concept
data Property
  = Isa VarOrLabel
  | LabelProperty Label
  | Rel [RolePlayer]
  | Has Label
        (Either Value Var)

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

-- |A label of something in the knowledge base
newtype Label =
  Label Text
  deriving (Eq)

-- |Something that may be a variable or a type label
data VarOrLabel
  = VarName Var
  | TypeLabel Label

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

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

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

-- |Create a label of something in the knowledge base
label :: Text -> Label
label = Label

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

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

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

instance Show Property where
  show (Isa varOrLabel)  = "isa " ++ show varOrLabel
  show (LabelProperty n) = "label " ++ 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 Label where
  show (Label text)
    | str =~ labelRegex = str
    | otherwise = show text
    where
      str = unpack text

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

instance Show VarOrLabel where
  show (VarName v)   = show v
  show (TypeLabel t) = show t

instance Convert Var VarOrLabel where
  convert = VarName

instance Convert Label VarOrLabel where
  convert = TypeLabel

instance Convert Var RolePlayer where
  convert = rp

instance Convert Var (Either Value Var) where
  convert = Right

instance Convert Text (Either Value Var) where
  convert = Left . ValueString

instance Convert Scientific (Either Value Var) where
  convert = Left . ValueNumber

instance Convert Bool (Either Value Var) where
  convert = 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 Label where
  parseJSON (Aeson.String s) = return $ label 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