Argonaut.purs 4.56 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 11 12 13 14 15 16 17 18
import Data.Generic.Rep as GR
import Data.Symbol (class IsSymbol, SProxy(..), reflectSymbol)

-- | Provide a generic sum JSON decoding for sum types deriving Generic
genericSumDecodeJson
  :: forall a rep
   . GR.Generic a rep
  => GenericSumDecodeJsonRep rep
  => Json
19
  -> Either JsonDecodeError a
20 21 22 23 24 25 26 27 28 29 30 31 32 33
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
34
  genericSumDecodeJsonRep :: Json -> Either JsonDecodeError rep
35 36 37 38

class GenericSumEncodeJsonRep rep where
  genericSumEncodeJsonRep :: rep -> Json

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

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

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

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

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

77
instance
78 79 80 81 82 83 84 85 86 87
  ( 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 }
    let name = reflectSymbol (SProxy :: _ name)
    let argument = genericSumEncodeJsonRep inner
    Argonaut.jsonSingletonObject name argument

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

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

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

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

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

117
instance
118 119 120 121 122 123
  ( 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
124
       else Left $ Named s $ TypeMismatch $ "Enum did not match expected string " <> name
125 126 127 128 129 130 131 132 133 134 135 136 137 138 139
    where
      name = reflectSymbol (SProxy :: SProxy name)

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

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

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