module Ribosome.Msgpack.Decode where

import qualified Data.ByteString.UTF8 as ByteString (toString)
import qualified Data.Map.Strict as Map (empty, fromList, toList)
import Data.MessagePack (Object(..))
import Data.Text.Prettyprint.Doc (pretty, viaShow)
import GHC.Float (double2Float, float2Double)
import GHC.Generics (
  C1,
  Constructor,
  D1,
  K1(..),
  M1(..),
  Rep,
  S1,
  Selector,
  conIsRecord,
  selName,
  to,
  (:*:)(..),
  (:+:)(..),
  )
import Neovim (CommandArguments)
import Path (Abs, Dir, File, Path, Rel, parseAbsDir, parseAbsFile, parseRelDir, parseRelFile)

import Ribosome.Msgpack.Error (DecodeError)
import qualified Ribosome.Msgpack.Error as DecodeError (DecodeError(Failed))
import Ribosome.Msgpack.Util (Err)
import qualified Ribosome.Msgpack.Util as Util (illegalType, invalid, lookupObjectMap, missingRecordKey)

class MsgpackDecode a where
  fromMsgpack :: Object -> Either Err a
  default fromMsgpack :: (Generic a, GMsgpackDecode (Rep a)) => Object -> Either Err a
  fromMsgpack = (Rep a Any -> a) -> Either Err (Rep a Any) -> Either Err a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Rep a Any -> a
forall a x. Generic a => Rep a x -> a
to (Either Err (Rep a Any) -> Either Err a)
-> (Object -> Either Err (Rep a Any)) -> Object -> Either Err a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Object -> Either Err (Rep a Any)
forall k (f :: k -> *) (a :: k).
GMsgpackDecode f =>
Object -> Either Err (f a)
gMsgpackDecode

  missingKey :: String -> Object -> Either Err a
  missingKey = String -> Object -> Either Err a
forall a. String -> Object -> Either Err a
Util.missingRecordKey

class GMsgpackDecode f where
  gMsgpackDecode :: Object -> Either Err (f a)

  gMissingKey :: String -> Object -> Either Err (f a)
  gMissingKey = String -> Object -> Either Err (f a)
forall a. String -> Object -> Either Err a
Util.missingRecordKey

class MsgpackDecodeProd f where
  msgpackDecodeRecord :: Map Object Object -> Either Err (f a)
  msgpackDecodeProd :: [Object] -> Either Err ([Object], f a)

instance (GMsgpackDecode f) => GMsgpackDecode (D1 c f) where
  gMsgpackDecode :: Object -> Either Err (D1 c f a)
gMsgpackDecode =
    (f a -> D1 c f a) -> Either Err (f a) -> Either Err (D1 c f a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f a -> D1 c f a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (Either Err (f a) -> Either Err (D1 c f a))
-> (Object -> Either Err (f a)) -> Object -> Either Err (D1 c f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: k). GMsgpackDecode f => Object -> Either Err (f a)
forall k (f :: k -> *) (a :: k).
GMsgpackDecode f =>
Object -> Either Err (f a)
gMsgpackDecode @f

instance (Constructor c, MsgpackDecodeProd f) => GMsgpackDecode (C1 c f) where
  gMsgpackDecode :: Object -> Either Err (C1 c f a)
gMsgpackDecode =
    (f a -> C1 c f a) -> Either Err (f a) -> Either Err (C1 c f a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f a -> C1 c f a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (Either Err (f a) -> Either Err (C1 c f a))
-> (Object -> Either Err (f a)) -> Object -> Either Err (C1 c f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Object -> Either Err (f a)
decode
    where
      isRec :: Bool
isRec = Any c f Any -> Bool
forall k (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> Bool
conIsRecord (forall k (t :: Meta -> (k -> *) -> k -> *) (p :: k). t c f p
forall a. HasCallStack => a
undefined :: t c f p)
      decode :: Object -> Either Err (f a)
decode o :: Object
o@(ObjectMap Map Object Object
om) =
        if Bool
isRec then Map Object Object -> Either Err (f a)
forall k (f :: k -> *) (a :: k).
MsgpackDecodeProd f =>
Map Object Object -> Either Err (f a)
msgpackDecodeRecord Map Object Object
om else Text -> Object -> Either Err (f a)
forall a. Text -> Object -> Either Err a
Util.invalid Text
"illegal ObjectMap for product" Object
o
      decode Object
o | Bool
isRec =
        Text -> Object -> Either Err (f a)
forall a. Text -> Object -> Either Err a
Util.invalid Text
"illegal non-ObjectMap for record" Object
o
      decode Object
o =
        [Object] -> Either Err ([Object], f a)
forall k (f :: k -> *) (a :: k).
MsgpackDecodeProd f =>
[Object] -> Either Err ([Object], f a)
msgpackDecodeProd (Object -> [Object]
prod Object
o) Either Err ([Object], f a)
-> (([Object], f a) -> Either Err (f a)) -> Either Err (f a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([Object], f a) -> Either Err (f a)
check
        where
          check :: ([Object], f a) -> Either Err (f a)
check ([], f a
a) = f a -> Either Err (f a)
forall a b. b -> Either a b
Right f a
a
          check ([Object], f a)
_ = Text -> Object -> Either Err (f a)
forall a. Text -> Object -> Either Err a
Util.invalid Text
"too many values for product" Object
o
          prod :: Object -> [Object]
prod (ObjectArray [Object]
oa) = [Object]
oa
          prod Object
ob = [Item [Object]
Object
ob]

instance (MsgpackDecodeProd f, MsgpackDecodeProd g) => MsgpackDecodeProd (f :*: g) where
  msgpackDecodeRecord :: Map Object Object -> Either Err ((:*:) f g a)
msgpackDecodeRecord Map Object Object
o = do
    f a
left <- Map Object Object -> Either Err (f a)
forall k (f :: k -> *) (a :: k).
MsgpackDecodeProd f =>
Map Object Object -> Either Err (f a)
msgpackDecodeRecord Map Object Object
o
    g a
right <- Map Object Object -> Either Err (g a)
forall k (f :: k -> *) (a :: k).
MsgpackDecodeProd f =>
Map Object Object -> Either Err (f a)
msgpackDecodeRecord Map Object Object
o
    return $ f a
left f a -> g a -> (:*:) f g a
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: g a
right
  msgpackDecodeProd :: [Object] -> Either Err ([Object], (:*:) f g a)
msgpackDecodeProd [Object]
o = do
    ([Object]
rest, f a
left) <- [Object] -> Either Err ([Object], f a)
forall k (f :: k -> *) (a :: k).
MsgpackDecodeProd f =>
[Object] -> Either Err ([Object], f a)
msgpackDecodeProd [Object]
o
    ([Object]
rest1, g a
right) <- [Object] -> Either Err ([Object], g a)
forall k (f :: k -> *) (a :: k).
MsgpackDecodeProd f =>
[Object] -> Either Err ([Object], f a)
msgpackDecodeProd [Object]
rest
    ([Object], (:*:) f g a) -> Either Err ([Object], (:*:) f g a)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Object]
rest1, f a
left f a -> g a -> (:*:) f g a
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: g a
right)

instance (GMsgpackDecode f, GMsgpackDecode g) => GMsgpackDecode (f :+: g) where
  gMsgpackDecode :: Object -> Either Err ((:+:) f g a)
gMsgpackDecode Object
o = Either Err ((:+:) f g a)
-> Either Err (Either Err ((:+:) f g a))
-> Either Err ((:+:) f g a)
forall b a. b -> Either a b -> b
fromRight (f a -> (:+:) f g a
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (f a -> (:+:) f g a)
-> Either Err (f a) -> Either Err ((:+:) f g a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Either Err (f a)
forall k (f :: k -> *) (a :: k).
GMsgpackDecode f =>
Object -> Either Err (f a)
gMsgpackDecode @f Object
o) ((:+:) f g a -> Either Err ((:+:) f g a)
forall a b. b -> Either a b
Right ((:+:) f g a -> Either Err ((:+:) f g a))
-> (g a -> (:+:) f g a) -> g a -> Either Err ((:+:) f g a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g a -> (:+:) f g a
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (g a -> Either Err ((:+:) f g a))
-> Either Err (g a) -> Either Err (Either Err ((:+:) f g a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Either Err (g a)
forall k (f :: k -> *) (a :: k).
GMsgpackDecode f =>
Object -> Either Err (f a)
gMsgpackDecode @g Object
o)

-- TODO use Proxy instead of undefined
instance (Selector s, GMsgpackDecode f) => MsgpackDecodeProd (S1 s f) where
  msgpackDecodeRecord :: Map Object Object -> Either Err (S1 s f a)
msgpackDecodeRecord Map Object Object
o =
    f a -> S1 s f a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (f a -> S1 s f a) -> Either Err (f a) -> Either Err (S1 s f a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either Err (f a)
-> (Object -> Either Err (f a)) -> Maybe Object -> Either Err (f a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Object -> Either Err (f a)
forall k (f :: k -> *) (a :: k).
GMsgpackDecode f =>
String -> Object -> Either Err (f a)
gMissingKey String
key (Map Object Object -> Object
ObjectMap Map Object Object
o)) Object -> Either Err (f a)
forall k (f :: k -> *) (a :: k).
GMsgpackDecode f =>
Object -> Either Err (f a)
gMsgpackDecode Maybe Object
lookup
    where
      lookup :: Maybe Object
lookup =
        String -> Map Object Object -> Maybe Object
forall a.
ConvertUtf8 a ByteString =>
a -> Map Object Object -> Maybe Object
Util.lookupObjectMap String
key Map Object Object
o Maybe Object -> Maybe Object -> Maybe Object
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Object
lookupUnderscore
      lookupUnderscore :: Maybe Object
lookupUnderscore =
        if Bool
hasUnderscore
        then String -> Map Object Object -> Maybe Object
forall a.
ConvertUtf8 a ByteString =>
a -> Map Object Object -> Maybe Object
Util.lookupObjectMap ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char
'_' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==) String
key) Map Object Object
o
        else Maybe Object
forall a. Maybe a
Nothing
      hasUnderscore :: Bool
hasUnderscore =
        Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 String
key String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"_"
      key :: String
key =
        Any s f Any -> String
forall k (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> String
selName (forall k (t :: Meta -> (k -> *) -> k -> *) (p :: k). t s f p
forall a. HasCallStack => a
undefined :: t s f p)
  msgpackDecodeProd :: [Object] -> Either Err ([Object], S1 s f a)
msgpackDecodeProd (Object
cur:[Object]
rest) = do
    f a
a <- Object -> Either Err (f a)
forall k (f :: k -> *) (a :: k).
GMsgpackDecode f =>
Object -> Either Err (f a)
gMsgpackDecode Object
cur
    return ([Object]
rest, f a -> S1 s f a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 f a
a)
  msgpackDecodeProd [] = Text -> Object -> Either Err ([Object], S1 s f a)
forall a. Text -> Object -> Either Err a
Util.invalid Text
"too few values for product" Object
ObjectNil

instance MsgpackDecode a => GMsgpackDecode (K1 i a) where
  gMsgpackDecode :: Object -> Either Err (K1 i a a)
gMsgpackDecode = (a -> K1 i a a) -> Either Err a -> Either Err (K1 i a a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> K1 i a a
forall k i c (p :: k). c -> K1 i c p
K1 (Either Err a -> Either Err (K1 i a a))
-> (Object -> Either Err a) -> Object -> Either Err (K1 i a a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Object -> Either Err a
forall a. MsgpackDecode a => Object -> Either Err a
fromMsgpack

  gMissingKey :: String -> Object -> Either Err (K1 i a a)
gMissingKey String
key =
    (a -> K1 i a a) -> Either Err a -> Either Err (K1 i a a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> K1 i a a
forall k i c (p :: k). c -> K1 i c p
K1 (Either Err a -> Either Err (K1 i a a))
-> (Object -> Either Err a) -> Object -> Either Err (K1 i a a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Object -> Either Err a
forall a. MsgpackDecode a => String -> Object -> Either Err a
missingKey String
key

instance (Ord k, MsgpackDecode k, MsgpackDecode v) => MsgpackDecode (Map k v) where
  fromMsgpack :: Object -> Either Err (Map k v)
fromMsgpack (ObjectMap Map Object Object
om) = do
    [(k, v)]
m <- ((Object, Object) -> Either Err (k, v))
-> [(Object, Object)] -> Either Err [(k, v)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Object, Object) -> Either Err (k, v)
forall a b.
(MsgpackDecode a, MsgpackDecode b) =>
(Object, Object) -> Either Err (a, b)
decodePair ([(Object, Object)] -> Either Err [(k, v)])
-> [(Object, Object)] -> Either Err [(k, v)]
forall a b. (a -> b) -> a -> b
$ Map Object Object -> [(Object, Object)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Object Object
om
    Map k v -> Either Err (Map k v)
forall a b. b -> Either a b
Right (Map k v -> Either Err (Map k v))
-> Map k v -> Either Err (Map k v)
forall a b. (a -> b) -> a -> b
$ [(k, v)] -> Map k v
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(k, v)]
m
    where
      decodePair :: (Object, Object) -> Either Err (a, b)
decodePair (Object
k, Object
v) = do
        a
k1 <- Object -> Either Err a
forall a. MsgpackDecode a => Object -> Either Err a
fromMsgpack Object
k
        b
v1 <- Object -> Either Err b
forall a. MsgpackDecode a => Object -> Either Err a
fromMsgpack Object
v
        return (a
k1, b
v1)
  fromMsgpack Object
o = Text -> Object -> Either Err (Map k v)
forall a. Text -> Object -> Either Err a
Util.illegalType Text
"Map" Object
o
  missingKey :: String -> Object -> Either Err (Map k v)
missingKey String
_ Object
_ = Map k v -> Either Err (Map k v)
forall a b. b -> Either a b
Right Map k v
forall k a. Map k a
Map.empty

integralFromString ::
  Read a =>
  ByteString ->
  Either Err a
integralFromString :: ByteString -> Either Err a
integralFromString =
  (Text -> Err) -> Either Text a -> Either Err a
forall a c b. (a -> c) -> Either a b -> Either c b
mapLeft Text -> Err
forall a ann. Pretty a => a -> Doc ann
pretty (Either Text a -> Either Err a)
-> (ByteString -> Either Text a) -> ByteString -> Either Err a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either Text a
forall a. Read a => String -> Either Text a
readEither (String -> Either Text a)
-> (ByteString -> String) -> ByteString -> Either Text a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
ByteString.toString

msgpackIntegral ::
  Integral a =>
  Read a =>
  Object ->
  Either Err a
msgpackIntegral :: Object -> Either Err a
msgpackIntegral (ObjectInt Int64
i) = a -> Either Err a
forall a b. b -> Either a b
Right (a -> Either Err a) -> a -> Either Err a
forall a b. (a -> b) -> a -> b
$ Int64 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
i
msgpackIntegral (ObjectUInt Word64
i) = a -> Either Err a
forall a b. b -> Either a b
Right (a -> Either Err a) -> a -> Either Err a
forall a b. (a -> b) -> a -> b
$ Word64 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
i
msgpackIntegral (ObjectString ByteString
s) = ByteString -> Either Err a
forall a. Read a => ByteString -> Either Err a
integralFromString ByteString
s
msgpackIntegral (ObjectBinary ByteString
s) = ByteString -> Either Err a
forall a. Read a => ByteString -> Either Err a
integralFromString ByteString
s
msgpackIntegral Object
o = Text -> Object -> Either Err a
forall a. Text -> Object -> Either Err a
Util.illegalType Text
"Integral" Object
o

msgpackText :: ConvertUtf8 t ByteString => Text -> (t -> Either Err a) -> Object -> Either Err a
msgpackText :: Text -> (t -> Either Err a) -> Object -> Either Err a
msgpackText Text
typeName t -> Either Err a
decode =
  Object -> Either Err a
run
  where
    run :: Object -> Either Err a
run (ObjectString ByteString
os) = t -> Either Err a
decode (t -> Either Err a) -> t -> Either Err a
forall a b. (a -> b) -> a -> b
$ ByteString -> t
forall a b. ConvertUtf8 a b => b -> a
decodeUtf8 ByteString
os
    run (ObjectBinary ByteString
os) = t -> Either Err a
decode (t -> Either Err a) -> t -> Either Err a
forall a b. (a -> b) -> a -> b
$ ByteString -> t
forall a b. ConvertUtf8 a b => b -> a
decodeUtf8 ByteString
os
    run Object
o = Text -> Object -> Either Err a
forall a. Text -> Object -> Either Err a
Util.illegalType Text
typeName Object
o

instance MsgpackDecode Int where
  fromMsgpack :: Object -> Either Err Int
fromMsgpack = Object -> Either Err Int
forall a. (Integral a, Read a) => Object -> Either Err a
msgpackIntegral

instance MsgpackDecode Int64 where
  fromMsgpack :: Object -> Either Err Int64
fromMsgpack = Object -> Either Err Int64
forall a. (Integral a, Read a) => Object -> Either Err a
msgpackIntegral

instance MsgpackDecode Float where
  fromMsgpack :: Object -> Either Err Float
fromMsgpack (ObjectFloat Float
a) = Float -> Either Err Float
forall a b. b -> Either a b
Right Float
a
  fromMsgpack (ObjectDouble Double
a) = Float -> Either Err Float
forall a b. b -> Either a b
Right (Double -> Float
double2Float Double
a)
  fromMsgpack (ObjectInt Int64
a) = Float -> Either Err Float
forall a b. b -> Either a b
Right (Int64 -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
a)
  fromMsgpack (ObjectUInt Word64
a) = Float -> Either Err Float
forall a b. b -> Either a b
Right (Word64 -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
a)
  fromMsgpack Object
o = Text -> Object -> Either Err Float
forall a. Text -> Object -> Either Err a
Util.illegalType Text
"Float" Object
o

instance MsgpackDecode Double where
  fromMsgpack :: Object -> Either Err Double
fromMsgpack (ObjectFloat Float
a) = Double -> Either Err Double
forall a b. b -> Either a b
Right (Float -> Double
float2Double Float
a)
  fromMsgpack (ObjectDouble Double
a) = Double -> Either Err Double
forall a b. b -> Either a b
Right Double
a
  fromMsgpack (ObjectInt Int64
a) = Double -> Either Err Double
forall a b. b -> Either a b
Right (Int64 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
a)
  fromMsgpack (ObjectUInt Word64
a) = Double -> Either Err Double
forall a b. b -> Either a b
Right (Word64 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
a)
  fromMsgpack Object
o = Text -> Object -> Either Err Double
forall a. Text -> Object -> Either Err a
Util.illegalType Text
"Double" Object
o

instance {-# OVERLAPPING #-} MsgpackDecode String where
  fromMsgpack :: Object -> Either Err String
fromMsgpack = Text
-> (String -> Either Err String) -> Object -> Either Err String
forall t a.
ConvertUtf8 t ByteString =>
Text -> (t -> Either Err a) -> Object -> Either Err a
msgpackText Text
"String" String -> Either Err String
forall a b. b -> Either a b
Right

instance {-# OVERLAPPABLE #-} MsgpackDecode a => MsgpackDecode [a] where
  fromMsgpack :: Object -> Either Err [a]
fromMsgpack (ObjectArray [Object]
oa) = (Object -> Either Err a) -> [Object] -> Either Err [a]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Object -> Either Err a
forall a. MsgpackDecode a => Object -> Either Err a
fromMsgpack [Object]
oa
  fromMsgpack Object
o = Text -> Object -> Either Err [a]
forall a. Text -> Object -> Either Err a
Util.illegalType Text
"List" Object
o
  missingKey :: String -> Object -> Either Err [a]
missingKey String
_ Object
_ = [a] -> Either Err [a]
forall a b. b -> Either a b
Right []

instance MsgpackDecode Text where
  fromMsgpack :: Object -> Either Err Text
fromMsgpack =
    Text -> (Text -> Either Err Text) -> Object -> Either Err Text
forall t a.
ConvertUtf8 t ByteString =>
Text -> (t -> Either Err a) -> Object -> Either Err a
msgpackText Text
"Text" Text -> Either Err Text
forall a b. b -> Either a b
Right

instance MsgpackDecode ByteString where
  fromMsgpack :: Object -> Either Err ByteString
fromMsgpack (ObjectString ByteString
os) = ByteString -> Either Err ByteString
forall a b. b -> Either a b
Right ByteString
os
  fromMsgpack (ObjectBinary ByteString
os) = ByteString -> Either Err ByteString
forall a b. b -> Either a b
Right ByteString
os
  fromMsgpack Object
o = Text -> Object -> Either Err ByteString
forall a. Text -> Object -> Either Err a
Util.illegalType Text
"ByteString" Object
o

instance MsgpackDecode Char where
  fromMsgpack :: Object -> Either Err Char
fromMsgpack Object
o =
    Text -> (String -> Either Err Char) -> Object -> Either Err Char
forall t a.
ConvertUtf8 t ByteString =>
Text -> (t -> Either Err a) -> Object -> Either Err a
msgpackText Text
"Char" String -> Either Err Char
check Object
o
    where
      check :: [Char] -> Either Err Char
      check :: String -> Either Err Char
check [Item String
c] = Char -> Either Err Char
forall a b. b -> Either a b
Right Char
Item String
c
      check String
_ = Text -> Object -> Either Err Char
forall a. Text -> Object -> Either Err a
Util.invalid Text
"multiple characters when decoding Char" Object
o

instance MsgpackDecode a => MsgpackDecode (Maybe a) where
  fromMsgpack :: Object -> Either Err (Maybe a)
fromMsgpack Object
ObjectNil = Maybe a -> Either Err (Maybe a)
forall a b. b -> Either a b
Right Maybe a
forall a. Maybe a
Nothing
  fromMsgpack Object
o = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> Either Err a -> Either Err (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Either Err a
forall a. MsgpackDecode a => Object -> Either Err a
fromMsgpack Object
o
  missingKey :: String -> Object -> Either Err (Maybe a)
missingKey String
_ Object
_ = Maybe a -> Either Err (Maybe a)
forall a b. b -> Either a b
Right Maybe a
forall a. Maybe a
Nothing

instance (MsgpackDecode a, MsgpackDecode b) => MsgpackDecode (Either a b) where
  fromMsgpack :: Object -> Either Err (Either a b)
fromMsgpack Object
o =
    Either Err (Either a b)
-> Either Err (Either Err (Either a b)) -> Either Err (Either a b)
forall b a. b -> Either a b -> b
fromRight (a -> Either a b
forall a b. a -> Either a b
Left (a -> Either a b) -> Either Err a -> Either Err (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Either Err a
forall a. MsgpackDecode a => Object -> Either Err a
fromMsgpack Object
o) (Either a b -> Either Err (Either a b)
forall a b. b -> Either a b
Right (Either a b -> Either Err (Either a b))
-> (b -> Either a b) -> b -> Either Err (Either a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Either a b
forall a b. b -> Either a b
Right (b -> Either Err (Either a b))
-> Either Err b -> Either Err (Either Err (Either a b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Either Err b
forall a. MsgpackDecode a => Object -> Either Err a
fromMsgpack Object
o)

instance MsgpackDecode Bool where
  fromMsgpack :: Object -> Either Err Bool
fromMsgpack (ObjectBool Bool
a) = Bool -> Either Err Bool
forall a b. b -> Either a b
Right Bool
a
  fromMsgpack (ObjectInt Int64
0) = Bool -> Either Err Bool
forall a b. b -> Either a b
Right Bool
False
  fromMsgpack (ObjectInt Int64
1) = Bool -> Either Err Bool
forall a b. b -> Either a b
Right Bool
True
  fromMsgpack Object
o = Text -> Object -> Either Err Bool
forall a. Text -> Object -> Either Err a
Util.illegalType Text
"Bool" Object
o

instance MsgpackDecode () where
  fromMsgpack :: Object -> Either Err ()
fromMsgpack Object
_ = () -> Either Err ()
forall a b. b -> Either a b
Right ()

instance MsgpackDecode Object where
  fromMsgpack :: Object -> Either Err Object
fromMsgpack = Object -> Either Err Object
forall a b. b -> Either a b
Right

instance (MsgpackDecode a, MsgpackDecode b) => MsgpackDecode (a, b) where
  fromMsgpack :: Object -> Either Err (a, b)
fromMsgpack (ObjectArray [Item [Object]
a, Item [Object]
b]) =
    (,) (a -> b -> (a, b)) -> Either Err a -> Either Err (b -> (a, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Either Err a
forall a. MsgpackDecode a => Object -> Either Err a
fromMsgpack Item [Object]
Object
a Either Err (b -> (a, b)) -> Either Err b -> Either Err (a, b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object -> Either Err b
forall a. MsgpackDecode a => Object -> Either Err a
fromMsgpack Item [Object]
Object
b
  fromMsgpack o :: Object
o@(ObjectArray [Object]
_) =
    Text -> Object -> Either Err (a, b)
forall a. Text -> Object -> Either Err a
Util.invalid Text
"invalid array length for pair" Object
o
  fromMsgpack Object
o =
    Text -> Object -> Either Err (a, b)
forall a. Text -> Object -> Either Err a
Util.illegalType Text
"pair" Object
o

instance MsgpackDecode CommandArguments where

class DecodePath b t where
  decodePath :: FilePath -> Either SomeException (Path b t)

instance DecodePath Abs File where
  decodePath :: String -> Either SomeException (Path Abs File)
decodePath =
    String -> Either SomeException (Path Abs File)
forall (m :: * -> *). MonadThrow m => String -> m (Path Abs File)
parseAbsFile

instance DecodePath Abs Dir where
  decodePath :: String -> Either SomeException (Path Abs Dir)
decodePath =
    String -> Either SomeException (Path Abs Dir)
forall (m :: * -> *). MonadThrow m => String -> m (Path Abs Dir)
parseAbsDir

instance DecodePath Rel File where
  decodePath :: String -> Either SomeException (Path Rel File)
decodePath =
    String -> Either SomeException (Path Rel File)
forall (m :: * -> *). MonadThrow m => String -> m (Path Rel File)
parseRelFile

instance DecodePath Rel Dir where
  decodePath :: String -> Either SomeException (Path Rel Dir)
decodePath =
    String -> Either SomeException (Path Rel Dir)
forall (m :: * -> *). MonadThrow m => String -> m (Path Rel Dir)
parseRelDir

decodePathE ::
  ∀ b t .
  DecodePath b t =>
  Text ->
  Either Err (Path b t)
decodePathE :: Text -> Either Err (Path b t)
decodePathE =
  (SomeException -> Err)
-> Either SomeException (Path b t) -> Either Err (Path b t)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first SomeException -> Err
forall a ann. Show a => a -> Doc ann
viaShow (Either SomeException (Path b t) -> Either Err (Path b t))
-> (Text -> Either SomeException (Path b t))
-> Text
-> Either Err (Path b t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either SomeException (Path b t)
forall b t.
DecodePath b t =>
String -> Either SomeException (Path b t)
decodePath (String -> Either SomeException (Path b t))
-> (Text -> String) -> Text -> Either SomeException (Path b t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
forall a. ToString a => a -> String
toString

instance DecodePath b t => MsgpackDecode (Path b t) where
  fromMsgpack :: Object -> Either Err (Path b t)
fromMsgpack =
    Text
-> (Text -> Either Err (Path b t))
-> Object
-> Either Err (Path b t)
forall t a.
ConvertUtf8 t ByteString =>
Text -> (t -> Either Err a) -> Object -> Either Err a
msgpackText Text
"Path" Text -> Either Err (Path b t)
forall b t. DecodePath b t => Text -> Either Err (Path b t)
decodePathE

fromMsgpack' ::
  ∀ a e m.
  MonadDeepError e DecodeError m =>
  MsgpackDecode a =>
  Object ->
  m a
fromMsgpack' :: Object -> m a
fromMsgpack' =
  (Err -> DecodeError) -> Either Err a -> m a
forall e e'' (m :: * -> *) e' a.
MonadDeepError e e'' m =>
(e' -> e'') -> Either e' a -> m a
hoistEitherWith Err -> DecodeError
DecodeError.Failed (Either Err a -> m a) -> (Object -> Either Err a) -> Object -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Object -> Either Err a
forall a. MsgpackDecode a => Object -> Either Err a
fromMsgpack

msgpackFromString :: IsString a => Text -> Object -> Either Err a
msgpackFromString :: Text -> Object -> Either Err a
msgpackFromString Text
name Object
o =
  Either Err String -> Either Err a
adapt (Either Err String -> Either Err a)
-> Either Err String -> Either Err a
forall a b. (a -> b) -> a -> b
$ Object -> Either Err String
forall a. MsgpackDecode a => Object -> Either Err a
fromMsgpack Object
o
  where
    adapt :: Either Err String -> Either Err a
adapt (Right String
a) =
      a -> Either Err a
forall a b. b -> Either a b
Right (a -> Either Err a) -> a -> Either Err a
forall a b. (a -> b) -> a -> b
$ String -> a
forall a. IsString a => String -> a
fromString String
a
    adapt (Left Err
_) =
      Text -> Object -> Either Err a
forall a. Text -> Object -> Either Err a
Util.illegalType Text
name Object
o