Argonaut.purs 4.58 KB
Newer Older
1 2 3 4 5 6 7
module Gargantext.Utils.Argonaut where

import Prelude

import Control.Alt ((<|>))
import Data.Argonaut (Json)
import Data.Argonaut as Argonaut
8
import Data.Argonaut.Decode.Error (JsonDecodeError(..))
9
import Data.Either (Either(..))
10
import Data.Generic.Rep as GR
11 12
import Data.Symbol (class IsSymbol, reflectSymbol)
import Type.Proxy (Proxy(..))
13 14 15 16 17 18 19

-- | Provide a generic sum JSON decoding for sum types deriving Generic
genericSumDecodeJson
  :: forall a rep
   . GR.Generic a rep
  => GenericSumDecodeJsonRep rep
  => Json
20
  -> Either JsonDecodeError a
21 22 23 24 25 26 27 28 29 30 31 32 33 34
genericSumDecodeJson f =
  GR.to <$> genericSumDecodeJsonRep f

-- | Provide a generic sum JSON encoding for sum types deriving Generic
genericSumEncodeJson
  :: forall a rep
   . GR.Generic a rep
  => GenericSumEncodeJsonRep rep
  => a
  -> Json
genericSumEncodeJson f =
  genericSumEncodeJsonRep $ GR.from f

class GenericSumDecodeJsonRep rep where
35
  genericSumDecodeJsonRep :: Json -> Either JsonDecodeError rep
36 37 38 39

class GenericSumEncodeJsonRep rep where
  genericSumEncodeJsonRep :: rep -> Json

40
instance
41 42 43 44 45 46 47
  ( GenericSumDecodeJsonRep a
  , GenericSumDecodeJsonRep b
  ) => GenericSumDecodeJsonRep (GR.Sum a b) where
  genericSumDecodeJsonRep f
      = GR.Inl <$> genericSumDecodeJsonRep f
    <|> GR.Inr <$> genericSumDecodeJsonRep f

48
instance
49 50 51 52 53 54
  ( GenericSumDecodeJsonRep a
  , IsSymbol name
  ) => GenericSumDecodeJsonRep (GR.Constructor name a) where
  genericSumDecodeJsonRep f = do
    -- here we attempt to read the following json:
    -- { "ConstructorName": argument }
55
    let name = reflectSymbol (Proxy :: _ name)
56 57 58 59 60
    obj <- Argonaut.decodeJson f
    inner <- Argonaut.getField obj name
    argument <- genericSumDecodeJsonRep inner
    pure $ GR.Constructor argument

61
instance
62 63 64 65
  GenericSumDecodeJsonRep (GR.NoArguments) where
  genericSumDecodeJsonRep _ = do
    pure GR.NoArguments

66
instance
67 68 69 70
  ( Argonaut.DecodeJson a
  ) => GenericSumDecodeJsonRep (GR.Argument a) where
  genericSumDecodeJsonRep f = GR.Argument <$> Argonaut.decodeJson f

71
instance
72 73 74 75 76 77
  ( GenericSumEncodeJsonRep a
  , GenericSumEncodeJsonRep b
  ) => GenericSumEncodeJsonRep (GR.Sum a b) where
  genericSumEncodeJsonRep (GR.Inl f) = genericSumEncodeJsonRep f
  genericSumEncodeJsonRep (GR.Inr f) = genericSumEncodeJsonRep f

78
instance
79 80 81 82 83 84
  ( GenericSumEncodeJsonRep a
  , IsSymbol name
  ) => GenericSumEncodeJsonRep (GR.Constructor name a) where
  genericSumEncodeJsonRep (GR.Constructor inner) = do
    -- here we attempt to write the following json:
    -- { "ConstructorName": argument }
85
    let name = reflectSymbol (Proxy :: _ name)
86 87 88
    let argument = genericSumEncodeJsonRep inner
    Argonaut.jsonSingletonObject name argument

89
instance
90 91 92
  GenericSumEncodeJsonRep GR.NoArguments where
  genericSumEncodeJsonRep GR.NoArguments = Argonaut.jsonNull

93
instance
94 95 96
  ( Argonaut.EncodeJson a
  ) => GenericSumEncodeJsonRep (GR.Argument a) where
  genericSumEncodeJsonRep (GR.Argument f) = Argonaut.encodeJson f
97 98 99 100 101

genericEnumDecodeJson :: forall a rep
   . GR.Generic a rep
  => GenericEnumDecodeJson rep
  => Json
102
  -> Either JsonDecodeError a
103 104 105 106 107
genericEnumDecodeJson f =
  GR.to <$> genericEnumDecodeJsonRep f

-- | Generic Enum Sum Representations, with constructor names as strings
class GenericEnumDecodeJson rep where
108
  genericEnumDecodeJsonRep :: Json -> Either JsonDecodeError rep
109

110
instance
111 112 113 114 115 116 117
  ( GenericEnumDecodeJson a
  , GenericEnumDecodeJson b
  ) => GenericEnumDecodeJson (GR.Sum a b) where
  genericEnumDecodeJsonRep f
      = GR.Inl <$> genericEnumDecodeJsonRep f
    <|> GR.Inr <$> genericEnumDecodeJsonRep f

118
instance
119 120 121 122 123 124
  ( IsSymbol name
  ) => GenericEnumDecodeJson (GR.Constructor name GR.NoArguments) where
  genericEnumDecodeJsonRep f = do
    s <- Argonaut.decodeJson f
    if s == name
       then pure $ GR.Constructor GR.NoArguments
125
       else Left $ Named s $ TypeMismatch $ "Enum did not match expected string " <> name
126
    where
127
      name = reflectSymbol (Proxy :: Proxy name)
128 129 130 131 132 133 134 135 136 137 138 139 140

genericEnumEncodeJson :: forall a rep
   . GR.Generic a rep
  => GenericEnumEncodeJson rep
  => a
  -> Json
genericEnumEncodeJson f =
  genericEnumEncodeJsonRep $ GR.from f

-- | Generic Enum Sum Representations, with constructor names as strings
class GenericEnumEncodeJson rep where
  genericEnumEncodeJsonRep :: rep -> Json

141
instance
142 143 144 145 146 147
  ( GenericEnumEncodeJson a
  , GenericEnumEncodeJson b
  ) => GenericEnumEncodeJson (GR.Sum a b) where
  genericEnumEncodeJsonRep (GR.Inl x) = genericEnumEncodeJsonRep x
  genericEnumEncodeJsonRep (GR.Inr x) = genericEnumEncodeJsonRep x

148
instance
149 150
  ( IsSymbol name
  ) => GenericEnumEncodeJson (GR.Constructor name GR.NoArguments) where
151
  genericEnumEncodeJsonRep _ = Argonaut.encodeJson $ reflectSymbol (Proxy :: Proxy name)