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) = Relation -> Either RelationalError Relation
forall a b. b -> Either a b
Right Relation
rel
relationForAtom Atom
_ = RelationalError -> Either RelationalError Relation
forall a b. a -> Either a b
Left (RelationalError -> Either RelationalError Relation)
-> RelationalError -> Either RelationalError Relation
forall a b. (a -> b) -> a -> b
$ AttributeName -> RelationalError
AttributeIsNotRelationValuedError AttributeName
""

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

atomToText (RelationAtom Relation
i) = (String -> AttributeName
T.pack (String -> AttributeName)
-> (Relation -> String) -> Relation -> AttributeName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relation -> String
forall a. Show a => a -> String
show) Relation
i
atomToText (ConstructedAtom AttributeName
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 :: AttributeName
beginp = if Bool
bo then AttributeName
"(" else AttributeName
"["
          begin :: AttributeName
begin = Atom -> AttributeName
atomToText Atom
b
          end :: AttributeName
end = Atom -> AttributeName
atomToText Atom
e 
          endp :: AttributeName
endp = if Bool
be then AttributeName
")" else AttributeName
"]" in 
      AttributeName
beginp AttributeName -> AttributeName -> AttributeName
forall a. Semigroup a => a -> a -> a
<> AttributeName
begin AttributeName -> AttributeName -> AttributeName
forall a. Semigroup a => a -> a -> a
<> AttributeName
"," AttributeName -> AttributeName -> AttributeName
forall a. Semigroup a => a -> a -> a
<> AttributeName
end AttributeName -> AttributeName -> AttributeName
forall a. Semigroup a => a -> a -> a
<> AttributeName
endp
    [Atom]
_ -> AttributeName
"invalid interval"
  | Bool
otherwise = AttributeName
dConsName AttributeName -> AttributeName -> AttributeName
forall a. Semigroup a => a -> a -> a
<> AttributeName
dConsArgs
  where
    parensAtomToText :: Atom -> AttributeName
parensAtomToText a :: Atom
a@(ConstructedAtom AttributeName
_ AtomType
_ []) = Atom -> AttributeName
atomToText Atom
a
    parensAtomToText a :: Atom
a@ConstructedAtom{} = AttributeName
"(" AttributeName -> AttributeName -> AttributeName
forall a. Semigroup a => a -> a -> a
<> Atom -> AttributeName
atomToText Atom
a AttributeName -> AttributeName -> AttributeName
forall a. Semigroup a => a -> a -> a
<> AttributeName
")"
    parensAtomToText Atom
a = Atom -> AttributeName
atomToText Atom
a
    
    dConsArgs :: AttributeName
dConsArgs = case [Atom]
atoms of
      [] -> AttributeName
""
      [Atom]
args -> AttributeName
" " AttributeName -> AttributeName -> AttributeName
forall a. Semigroup a => a -> a -> a
<> AttributeName -> [AttributeName] -> AttributeName
T.intercalate AttributeName
" " ((Atom -> AttributeName) -> [Atom] -> [AttributeName]
forall a b. (a -> b) -> [a] -> [b]
map Atom -> AttributeName
parensAtomToText [Atom]
args)