module Present
(Presentation(..)
,ID
,present
,asData)
where
import qualified Present.String as P
import qualified Present.Text as P
import Present.Types
import Data.Data
import Data.Data.Exists
import Data.Data.Indexed
import Data.Default
import Present.ID (ID)
import qualified Present.ID as ID
import Data.Semigroup
import Data.Text (pack)
present :: Data a => ID -> a -> Maybe Presentation
present iq =
hunt def iq
where
hunt :: Data d => ID -> ID -> d -> Maybe Presentation
hunt c q d =
case cast d of
Just t -> hunt c q (P.normalizeText t)
Nothing ->
case cast d of
Just s -> hunt c q (P.normalizeStrictText s)
Nothing ->
case cast d of
Just s -> hunt c q (P.normalizeString s)
Nothing -> dissect c q d
dissect :: Data d => ID -> ID -> d -> Maybe Presentation
dissect c q d =
case ID.split q of
(i,Nothing) ->
if ID.singleton i == c
then presentation iq d
else Nothing
(i,Just q') ->
if ID.singleton i == c
then case gindex i' d of
Nothing -> Nothing
Just (D d') -> hunt (ID.singleton i') q' d'
else Nothing
where (i',_) = ID.split q'
presentation :: Data a => ID -> a -> Maybe Presentation
presentation iq d =
case dataTypeRep dtype of
AlgRep{} -> Just (presentAlgebraic iq d)
IntRep -> Just (Integer ty text)
FloatRep -> Just (Floating ty text)
CharRep -> Just (Char ty text)
NoRep -> Nothing
where text = pack (show (toConstr d))
ty = pack (show (typeOf d))
dtype = dataTypeOf d
presentAlgebraic :: Data a => ID -> a -> Presentation
presentAlgebraic iq d =
case cast d of
Just (_ :: P.String) -> String ty ids
Nothing ->
case cast d of
Just (_ :: P.Text) -> String ty ids
Nothing ->
case show (toConstr d) of
"[]" -> List ty []
"()" -> Tuple ty []
"(:)" -> List ty ids
"(,)" -> Tuple ty ids
_ -> Alg ty text ids
where ty = pack (show (typeOf d))
text = pack (show (toConstr d))
ids = gappend makeId d
where makeId d_i i =
return (pack (show (typeOf d_i))
,iq <> ID.singleton i)
asData :: Data a => a -> a
asData = id