{- |
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 (Int -> MyData -> ShowS
[MyData] -> ShowS
MyData -> String
(Int -> MyData -> ShowS)
-> (MyData -> String) -> ([MyData] -> ShowS) -> Show MyData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MyData] -> ShowS
$cshowList :: [MyData] -> ShowS
show :: MyData -> String
$cshow :: MyData -> String
showsPrec :: Int -> MyData -> ShowS
$cshowsPrec :: Int -> MyData -> ShowS
Show, MyData -> MyData -> Bool
(MyData -> MyData -> Bool)
-> (MyData -> MyData -> Bool) -> Eq MyData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MyData -> MyData -> Bool
$c/= :: MyData -> MyData -> Bool
== :: MyData -> MyData -> Bool
$c== :: MyData -> MyData -> Bool
Eq, Eq MyData
Eq MyData =>
(MyData -> MyData -> Ordering)
-> (MyData -> MyData -> Bool)
-> (MyData -> MyData -> Bool)
-> (MyData -> MyData -> Bool)
-> (MyData -> MyData -> Bool)
-> (MyData -> MyData -> MyData)
-> (MyData -> MyData -> MyData)
-> Ord MyData
MyData -> MyData -> Bool
MyData -> MyData -> Ordering
MyData -> MyData -> MyData
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: MyData -> MyData -> MyData
$cmin :: MyData -> MyData -> MyData
max :: MyData -> MyData -> MyData
$cmax :: MyData -> MyData -> MyData
>= :: MyData -> MyData -> Bool
$c>= :: MyData -> MyData -> Bool
> :: MyData -> MyData -> Bool
$c> :: MyData -> MyData -> Bool
<= :: MyData -> MyData -> Bool
$c<= :: MyData -> MyData -> Bool
< :: MyData -> MyData -> Bool
$c< :: MyData -> MyData -> Bool
compare :: MyData -> MyData -> Ordering
$ccompare :: MyData -> MyData -> Ordering
$cp1Ord :: Eq MyData
Ord)

{- | conversion with special treatment for numbers, booleans, strings,
characters, ranges, ids, IRIs and other lists. -}
dataToMyData :: Data a => a -> MyData
dataToMyData :: a -> MyData
dataToMyData a :: a
a = let
    l :: [MyData]
l = (forall d. Data d => d -> MyData) -> a -> [MyData]
forall a u. Data a => (forall d. Data d => d -> u) -> a -> [u]
gmapQ forall d. Data d => d -> MyData
dataToMyData a
a
    c :: Constr
c = a -> Constr
forall a. Data a => a -> Constr
toConstr a
a
    fs :: [String]
fs = Constr -> [String]
constrFields Constr
c
    s :: String
s = Constr -> String
showConstr Constr
c
    bool :: Bool -> MyData
bool = MyData -> Bool -> MyData
forall a b. a -> b -> a
const (MyData -> Bool -> MyData) -> MyData -> Bool -> MyData
forall a b. (a -> b) -> a -> b
$ String -> String -> MyData
Builtin "bool" String
s :: Bool -> MyData
    res :: MyData
res = case [MyData]
l of
      [] -> case String
s of
        "[]" -> Bool -> [MyData] -> MyData
ListOrTuple Bool
True []
        "()" -> Bool -> [MyData] -> MyData
ListOrTuple Bool
False []
        _ -> String -> Maybe [String] -> [MyData] -> MyData
Cons String
s Maybe [String]
forall a. Maybe a
Nothing []
      [hd :: MyData
hd, ListOrTuple True rt :: [MyData]
rt] | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "(:)" -> Bool -> [MyData] -> MyData
ListOrTuple Bool
True ([MyData] -> MyData) -> [MyData] -> MyData
forall a b. (a -> b) -> a -> b
$ MyData
hd MyData -> [MyData] -> [MyData]
forall a. a -> [a] -> [a]
: [MyData]
rt
      _ | String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf "(," String
s -> Bool -> [MyData] -> MyData
ListOrTuple Bool
False [MyData]
l
      _ -> String -> Maybe [String] -> [MyData] -> MyData
Cons String
s
        (if [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
fs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [MyData] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [MyData]
l Bool -> Bool -> Bool
&& (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) [String]
fs
         then [String] -> Maybe [String]
forall a. a -> Maybe a
Just [String]
fs else Maybe [String]
forall a. Maybe a
Nothing) [MyData]
l
  in case DataType -> DataRep
dataTypeRep (DataType -> DataRep) -> DataType -> DataRep
forall a b. (a -> b) -> a -> b
$ a -> DataType
forall a. Data a => a -> DataType
dataTypeOf a
a of
  r :: DataRep
r | DataRep -> [DataRep] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem DataRep
r [DataRep
IntRep, DataRep
FloatRep] -> String -> String -> MyData
Builtin "number" String
s
  CharRep -> String -> String -> MyData
Builtin "char" String
s
  _ -> MyData -> (Bool -> MyData) -> Maybe Bool -> MyData
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
       (MyData -> (String -> MyData) -> Maybe String -> MyData
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
        (MyData -> (Range -> MyData) -> Maybe Range -> MyData
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
         (MyData -> (Id -> MyData) -> Maybe Id -> MyData
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
          (MyData -> (IRI -> MyData) -> Maybe IRI -> MyData
forall b a. b -> (a -> b) -> Maybe a -> b
maybe MyData
res
           (String -> String -> MyData
Builtin "iri" (String -> MyData) -> (IRI -> String) -> IRI -> MyData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IRI -> String
iriToStringUnsecure) (Maybe IRI -> MyData) -> Maybe IRI -> MyData
forall a b. (a -> b) -> a -> b
$ a -> Maybe IRI
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a
a)
          (String -> String -> MyData
Builtin "id" (String -> MyData) -> (Id -> String) -> Id -> MyData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Id -> ShowS
`showId` "")) (Maybe Id -> MyData) -> Maybe Id -> MyData
forall a b. (a -> b) -> a -> b
$ a -> Maybe Id
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a
a)
         (String -> String -> MyData
Builtin "range" (String -> MyData) -> (Range -> String) -> Range -> MyData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> String
forall a. Show a => a -> String
show (Doc -> String) -> (Range -> Doc) -> Range -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pos] -> Doc
prettyRange ([Pos] -> Doc) -> (Range -> [Pos]) -> Range -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Range -> [Pos]
rangeToList) (Maybe Range -> MyData) -> Maybe Range -> MyData
forall a b. (a -> b) -> a -> b
$ a -> Maybe Range
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a
a)
       (String -> String -> MyData
Builtin "string") (Maybe String -> MyData) -> Maybe String -> MyData
forall a b. (a -> b) -> a -> b
$ a -> Maybe String
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a
a) Bool -> MyData
bool (Maybe Bool -> MyData) -> Maybe Bool -> MyData
forall a b. (a -> b) -> a -> b
$ a -> Maybe Bool
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a
a

normalizeMyDataForSerialization :: MyData -> MyData
normalizeMyDataForSerialization :: MyData -> MyData
normalizeMyDataForSerialization = MyData -> MyData
stripDeleted (MyData -> MyData) -> (MyData -> MyData) -> MyData -> MyData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MyData -> MyData
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 :: MyData
deletedData = String -> Maybe [String] -> [MyData] -> MyData
Cons "_deleted" Maybe [String]
forall a. Maybe a
Nothing []

    isNotDeleted :: MyData -> Bool
    isNotDeleted :: MyData -> Bool
isNotDeleted d :: MyData
d = MyData
d MyData -> MyData -> Bool
forall a. Eq a => a -> a -> Bool
/= MyData
deletedData

    stripSpecialConstructors :: MyData -> MyData
    stripSpecialConstructors :: MyData -> MyData
stripSpecialConstructors md :: MyData
md = case MyData
md of
      Cons "Nothing" Nothing [] -> MyData
deletedData
      Cons "Just" Nothing [value :: MyData
value] -> MyData
value
      Cons "Left" Nothing [value :: MyData
value] -> MyData
value
      Cons "Right" Nothing [value :: MyData
value] -> MyData
value
      Cons constructor :: String
constructor fieldsM :: Maybe [String]
fieldsM values :: [MyData]
values ->
        String -> Maybe [String] -> [MyData] -> MyData
Cons String
constructor Maybe [String]
fieldsM ([MyData] -> MyData) -> [MyData] -> MyData
forall a b. (a -> b) -> a -> b
$ (MyData -> MyData) -> [MyData] -> [MyData]
forall a b. (a -> b) -> [a] -> [b]
map MyData -> MyData
stripSpecialConstructors [MyData]
values
      ListOrTuple isList :: Bool
isList values :: [MyData]
values ->
        Bool -> [MyData] -> MyData
ListOrTuple Bool
isList ([MyData] -> MyData) -> [MyData] -> MyData
forall a b. (a -> b) -> a -> b
$ (MyData -> MyData) -> [MyData] -> [MyData]
forall a b. (a -> b) -> [a] -> [b]
map MyData -> MyData
stripSpecialConstructors [MyData]
values
      _ -> MyData
md

    stripDeletedList :: [MyData] -> [MyData]
    stripDeletedList :: [MyData] -> [MyData]
stripDeletedList values :: [MyData]
values = (MyData -> Bool) -> [MyData] -> [MyData]
forall a. (a -> Bool) -> [a] -> [a]
filter MyData -> Bool
isNotDeleted ([MyData] -> [MyData]) -> [MyData] -> [MyData]
forall a b. (a -> b) -> a -> b
$ (MyData -> MyData) -> [MyData] -> [MyData]
forall a b. (a -> b) -> [a] -> [b]
map MyData -> MyData
stripDeleted [MyData]
values

    stripDeletedFieldsList :: [String] -> [MyData] -> ([String], [MyData])
    stripDeletedFieldsList :: [String] -> [MyData] -> ([String], [MyData])
stripDeletedFieldsList fields :: [String]
fields values :: [MyData]
values =
      [(String, MyData)] -> ([String], [MyData])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(String, MyData)] -> ([String], [MyData]))
-> [(String, MyData)] -> ([String], [MyData])
forall a b. (a -> b) -> a -> b
$
      ((String, MyData) -> Bool)
-> [(String, MyData)] -> [(String, MyData)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\ (_, v :: MyData
v) -> MyData -> Bool
isNotDeleted MyData
v) ([(String, MyData)] -> [(String, MyData)])
-> [(String, MyData)] -> [(String, MyData)]
forall a b. (a -> b) -> a -> b
$
      ((String, MyData) -> (String, MyData))
-> [(String, MyData)] -> [(String, MyData)]
forall a b. (a -> b) -> [a] -> [b]
map (\ (f :: String
f, v :: MyData
v) -> (String
f, MyData -> MyData
stripDeleted MyData
v)) ([(String, MyData)] -> [(String, MyData)])
-> [(String, MyData)] -> [(String, MyData)]
forall a b. (a -> b) -> a -> b
$
      [String] -> [MyData] -> [(String, MyData)]
forall a b. [a] -> [b] -> [(a, b)]
zip [String]
fields [MyData]
values

    stripDeleted :: MyData -> MyData
    stripDeleted :: MyData -> MyData
stripDeleted md :: MyData
md = case MyData
md of
      ListOrTuple isList :: Bool
isList values :: [MyData]
values ->
        Bool -> [MyData] -> MyData
ListOrTuple Bool
isList ([MyData] -> MyData) -> [MyData] -> MyData
forall a b. (a -> b) -> a -> b
$ [MyData] -> [MyData]
stripDeletedList [MyData]
values
      Cons constructor :: String
constructor Nothing values :: [MyData]
values ->
        String -> Maybe [String] -> [MyData] -> MyData
Cons String
constructor Maybe [String]
forall a. Maybe a
Nothing ([MyData] -> MyData) -> [MyData] -> MyData
forall a b. (a -> b) -> a -> b
$ [MyData] -> [MyData]
stripDeletedList [MyData]
values
      Cons constructor :: String
constructor (Just fields :: [String]
fields) values :: [MyData]
values ->
        let (fields' :: [String]
fields', values' :: [MyData]
values') = [String] -> [MyData] -> ([String], [MyData])
stripDeletedFieldsList [String]
fields [MyData]
values
        in String -> Maybe [String] -> [MyData] -> MyData
Cons String
constructor ([String] -> Maybe [String]
forall a. a -> Maybe a
Just [String]
fields') [MyData]
values'
      _ -> MyData
md