Argonaut.purs 4.95 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 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59

class GenericSumEncodeJsonRep rep where
  genericSumEncodeJsonRep :: rep -> Json

instance genericSumDecodeJsonRepSum ::
  ( GenericSumDecodeJsonRep a
  , GenericSumDecodeJsonRep b
  ) => GenericSumDecodeJsonRep (GR.Sum a b) where
  genericSumDecodeJsonRep f
      = GR.Inl <$> genericSumDecodeJsonRep f
    <|> GR.Inr <$> genericSumDecodeJsonRep f

instance genericSumDecodeJsonRepConstructor ::
  ( 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 61 62 63 64
instance genericSumDecodeJsonRepNoArguments ::
  GenericSumDecodeJsonRep (GR.NoArguments) where
  genericSumDecodeJsonRep _ = do
    pure GR.NoArguments

65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87
instance genericSumDecodeJsonRepArgument ::
  ( Argonaut.DecodeJson a
  ) => GenericSumDecodeJsonRep (GR.Argument a) where
  genericSumDecodeJsonRep f = GR.Argument <$> Argonaut.decodeJson f

instance genericSumEncodeJsonRepSum ::
  ( GenericSumEncodeJsonRep a
  , GenericSumEncodeJsonRep b
  ) => GenericSumEncodeJsonRep (GR.Sum a b) where
  genericSumEncodeJsonRep (GR.Inl f) = genericSumEncodeJsonRep f
  genericSumEncodeJsonRep (GR.Inr f) = genericSumEncodeJsonRep f

instance genericSumEncodeJsonRepConstructor ::
  ( 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 89 90 91
instance genericSumEncodeJsonRepNoArguments ::
  GenericSumEncodeJsonRep GR.NoArguments where
  genericSumEncodeJsonRep GR.NoArguments = Argonaut.jsonNull

92 93 94 95
instance genericSumEncodeJsonRepArgument ::
  ( 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 110 111 112 113 114 115 116 117 118 119 120 121 122 123

instance sumEnumDecodeJsonRep ::
  ( GenericEnumDecodeJson a
  , GenericEnumDecodeJson b
  ) => GenericEnumDecodeJson (GR.Sum a b) where
  genericEnumDecodeJsonRep f
      = GR.Inl <$> genericEnumDecodeJsonRep f
    <|> GR.Inr <$> genericEnumDecodeJsonRep f

instance constructorEnumSumRep ::
  ( 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 140 141 142 143 144 145 146 147 148 149 150
    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

instance sumGenericEnumEncodeJson ::
  ( GenericEnumEncodeJson a
  , GenericEnumEncodeJson b
  ) => GenericEnumEncodeJson (GR.Sum a b) where
  genericEnumEncodeJsonRep (GR.Inl x) = genericEnumEncodeJsonRep x
  genericEnumEncodeJsonRep (GR.Inr x) = genericEnumEncodeJsonRep x

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