module ProjectM36.Atom where
import ProjectM36.Base
import ProjectM36.Error
import ProjectM36.DataTypes.Interval
import qualified Data.Text as T
#if __GLASGOW_HASKELL__ < 804
import Data.Monoid
#endif

relationForAtom :: Atom -> Either RelationalError Relation
relationForAtom :: Atom -> Either RelationalError Relation
relationForAtom (RelationAtom Relation
rel) = forall a b. b -> Either a b
Right Relation
rel
relationForAtom Atom
_ = forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Text -> RelationalError
AttributeIsNotRelationValuedError Text
""

atomToText :: Atom -> T.Text
atomToText :: Atom -> Text
atomToText (IntegerAtom Integer
i) = (String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) Integer
i
atomToText (IntAtom Int
i) = (String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) Int
i
atomToText (ScientificAtom Scientific
s) = (String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) Scientific
s
atomToText (DoubleAtom Double
i) = (String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) Double
i
atomToText (TextAtom Text
i) = (String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) Text
i --quotes necessary for ConstructedAtom subatoms
atomToText (DayAtom Day
i) = (String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) Day
i
atomToText (DateTimeAtom UTCTime
i) = (String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) UTCTime
i
atomToText (ByteStringAtom ByteString
i) = (String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) ByteString
i
atomToText (BoolAtom Bool
i) = (String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) Bool
i
atomToText (UUIDAtom UUID
u) = (String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) UUID
u
atomToText (RelationalExprAtom RelationalExpr
re) = (String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) RelationalExpr
re

atomToText (RelationAtom Relation
i) = (String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) Relation
i
atomToText (ConstructedAtom Text
dConsName AtomType
typ [Atom]
atoms) 
  | AtomType -> Bool
isIntervalAtomType AtomType
typ = case [Atom]
atoms of --special handling for printing intervals
    [Atom
b, Atom
e, BoolAtom Bool
bo, BoolAtom Bool
be] -> 
      let beginp :: Text
beginp = if Bool
bo then Text
"(" else Text
"["
          begin :: Text
begin = Atom -> Text
atomToText Atom
b
          end :: Text
end = Atom -> Text
atomToText Atom
e 
          endp :: Text
endp = if Bool
be then Text
")" else Text
"]" in 
      Text
beginp forall a. Semigroup a => a -> a -> a
<> Text
begin forall a. Semigroup a => a -> a -> a
<> Text
"," forall a. Semigroup a => a -> a -> a
<> Text
end forall a. Semigroup a => a -> a -> a
<> Text
endp
    [Atom]
_ -> Text
"invalid interval"
  | Bool
otherwise = Text
dConsName forall a. Semigroup a => a -> a -> a
<> Text
dConsArgs
  where
    parensAtomToText :: Atom -> Text
parensAtomToText a :: Atom
a@(ConstructedAtom Text
_ AtomType
_ []) = Atom -> Text
atomToText Atom
a
    parensAtomToText a :: Atom
a@ConstructedAtom{} = Text
"(" forall a. Semigroup a => a -> a -> a
<> Atom -> Text
atomToText Atom
a forall a. Semigroup a => a -> a -> a
<> Text
")"
    parensAtomToText Atom
a = Atom -> Text
atomToText Atom
a
    
    dConsArgs :: Text
dConsArgs = case [Atom]
atoms of
      [] -> Text
""
      [Atom]
args -> Text
" " forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
" " (forall a b. (a -> b) -> [a] -> [b]
map Atom -> Text
parensAtomToText [Atom]
args)