content: {- |
  Module      :  ./Common/Data.hs
  Description :  generate output from Data instances
  Copyright   :  (c) Christian Maeder, DFKI GmbH 2014
  License     :  GPLv2 or higher, see LICENSE.txt
  Maintainer  :  Christian.Maeder@dfki.de
  Stability   :  provisional
  Portability :  portable
  
  preprocess some known data types
  -}
  
  module Common.Data where
  
  import Common.Id
  import Common.IRI
  import Common.Result
  
  import Data.Data
  import Data.List
  
  data MyData = Builtin String String -- label and content
    | ListOrTuple Bool [MyData] -- True means list
    | Cons String (Maybe [String]) [MyData] -- with optional field names
    deriving (Show, Eq, Ord)
  
  {- | conversion with special treatment for numbers, booleans, strings,
  characters, ranges, ids, IRIs and other lists. -}
  dataToMyData :: Data a => a -> MyData
  dataToMyData a = let
      l = gmapQ dataToMyData a
      c = toConstr a
      fs = constrFields c
      s = showConstr c
      bool = const $ Builtin "bool" s :: Bool -> MyData
      res = case l of
        [] -> case s of
          "[]" -> ListOrTuple True []
          "()" -> ListOrTuple False []
          _ -> Cons s Nothing []
        [hd, ListOrTuple True rt] | s == "(:)" -> ListOrTuple True $ hd : rt
        _ | isPrefixOf "(," s -> ListOrTuple False l
        _ -> Cons s
          (if length fs == length l && all (not . null) fs
           then Just fs else Nothing) l
    in case dataTypeRep $ dataTypeOf a of
    r | elem r [IntRep, FloatRep] -> Builtin "number" s
    CharRep -> Builtin "char" s
    _ -> maybe
         (maybe
          (maybe
           (maybe
            (maybe res
             (Builtin "iri" . iriToStringUnsecure) $ cast a)
            (Builtin "id" . (`showId` "")) $ cast a)
           (Builtin "range" . show . prettyRange . rangeToList) $ cast a)
         (Builtin "string") $ cast a) bool $ cast a
  
  normalizeMyDataForSerialization :: MyData -> MyData
  normalizeMyDataForSerialization = stripDeleted . stripSpecialConstructors
    where
      {- "_deleted" is not a valid Haskell constructor and can't clash with real
      data. It is used for marking a deleted data item. -}
      deletedData :: MyData
      deletedData = Cons "_deleted" Nothing []
  
      isNotDeleted :: MyData -> Bool
      isNotDeleted d = d /= deletedData
  
      stripSpecialConstructors :: MyData -> MyData
      stripSpecialConstructors md = case md of
        Cons "Nothing" Nothing [] -> deletedData
        Cons "Just" Nothing [value] -> value
        Cons "Left" Nothing [value] -> value
        Cons "Right" Nothing [value] -> value
        Cons constructor fieldsM values ->
          Cons constructor fieldsM $ map stripSpecialConstructors values
        ListOrTuple isList values ->
          ListOrTuple isList $ map stripSpecialConstructors values
        _ -> md
  
      stripDeletedList :: [MyData] -> [MyData]
      stripDeletedList values = filter isNotDeleted $ map stripDeleted values
  
      stripDeletedFieldsList :: [String] -> [MyData] -> ([String], [MyData])
      stripDeletedFieldsList fields values =
        unzip $
        filter (\ (_, v) -> isNotDeleted v) $
        map (\ (f, v) -> (f, stripDeleted v)) $
        zip fields values
  
      stripDeleted :: MyData -> MyData
      stripDeleted md = case md of
        ListOrTuple isList values ->
          ListOrTuple isList $ stripDeletedList values
        Cons constructor Nothing values ->
          Cons constructor Nothing $ stripDeletedList values
        Cons constructor (Just fields) values ->
          let (fields', values') = stripDeletedFieldsList fields values
          in Cons constructor (Just fields') values'
        _ -> md
  