{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
module Elm2Nix.ElmJson
  ( Dep
  , Elm2NixError(..), toErrorMessage
  , readElmJson
  ) where

import Control.Monad (liftM2)
import Data.Aeson (Value(..))
import Data.List (nub)
import Data.Text (Text)

#if MIN_VERSION_aeson(2,0,0)
import qualified Data.Aeson.Key as AK
import qualified Data.Aeson.KeyMap as HM
#else
import qualified Data.HashMap.Strict as HM
#endif

import qualified Data.ByteString.Lazy as LBS
import qualified Data.Aeson as Json
import qualified Data.Text as Text


type Dep = (String, String)

data Elm2NixError =
    ElmJsonReadError String
  | UnexpectedValue Value
  | KeyNotFound Text
  deriving Int -> Elm2NixError -> ShowS
[Elm2NixError] -> ShowS
Elm2NixError -> [Char]
(Int -> Elm2NixError -> ShowS)
-> (Elm2NixError -> [Char])
-> ([Elm2NixError] -> ShowS)
-> Show Elm2NixError
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Elm2NixError -> ShowS
showsPrec :: Int -> Elm2NixError -> ShowS
$cshow :: Elm2NixError -> [Char]
show :: Elm2NixError -> [Char]
$cshowList :: [Elm2NixError] -> ShowS
showList :: [Elm2NixError] -> ShowS
Show

toErrorMessage :: Elm2NixError -> String
toErrorMessage :: Elm2NixError -> [Char]
toErrorMessage Elm2NixError
err =
  case Elm2NixError
err of
    UnexpectedValue Value
v -> [Char]
"Unexpected Value: \n" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Value -> [Char]
forall a. Show a => a -> [Char]
show Value
v
    ElmJsonReadError [Char]
s -> [Char]
"Error reading json: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
s
    KeyNotFound Text
key -> [Char]
"Key not found in json: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
Text.unpack Text
key

readElmJson :: FilePath -> IO (Either Elm2NixError [Dep])
readElmJson :: [Char] -> IO (Either Elm2NixError [Dep])
readElmJson [Char]
path = do
  Either [Char] Value
res <- ByteString -> Either [Char] Value
forall a. FromJSON a => ByteString -> Either [Char] a
Json.eitherDecode (ByteString -> Either [Char] Value)
-> IO ByteString -> IO (Either [Char] Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO ByteString
LBS.readFile [Char]
path
  Either Elm2NixError [Dep] -> IO (Either Elm2NixError [Dep])
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Elm2NixError [Dep] -> IO (Either Elm2NixError [Dep]))
-> Either Elm2NixError [Dep] -> IO (Either Elm2NixError [Dep])
forall a b. (a -> b) -> a -> b
$
    ([Char] -> Either Elm2NixError [Dep])
-> (Value -> Either Elm2NixError [Dep])
-> Either [Char] Value
-> Either Elm2NixError [Dep]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
      (Elm2NixError -> Either Elm2NixError [Dep]
forall a b. a -> Either a b
Left (Elm2NixError -> Either Elm2NixError [Dep])
-> ([Char] -> Elm2NixError) -> [Char] -> Either Elm2NixError [Dep]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Elm2NixError
ElmJsonReadError)
      Value -> Either Elm2NixError [Dep]
parseElmJson
      Either [Char] Value
res

parseElmJson :: Value -> Either Elm2NixError [Dep]
parseElmJson :: Value -> Either Elm2NixError [Dep]
parseElmJson Value
obj =
  [Dep] -> [Dep]
forall a. Eq a => [a] -> [a]
nub ([Dep] -> [Dep])
-> Either Elm2NixError [Dep] -> Either Elm2NixError [Dep]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Dep] -> [Dep] -> [Dep])
-> Either Elm2NixError [Dep]
-> Either Elm2NixError [Dep]
-> Either Elm2NixError [Dep]
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 [Dep] -> [Dep] -> [Dep]
forall a. [a] -> [a] -> [a]
(++)
    (Text -> Value -> Either Elm2NixError [Dep]
parseElmJsonDeps Text
"dependencies" Value
obj)
    (Text -> Value -> Either Elm2NixError [Dep]
parseElmJsonDeps Text
"test-dependencies" Value
obj)

parseElmJsonDeps :: Text -> Value -> Either Elm2NixError [Dep]
parseElmJsonDeps :: Text -> Value -> Either Elm2NixError [Dep]
parseElmJsonDeps Text
depsKey Value
obj =
  case Value
obj of
    Object Object
hm -> do
      Value
deps <- Object -> Text -> Either Elm2NixError Value
tryLookup Object
hm Text
depsKey
      case Value
deps of
        Object Object
dhm -> do
          Value
direct   <- Object -> Text -> Either Elm2NixError Value
tryLookup Object
dhm Text
"direct"
          Value
indirect <- Object -> Text -> Either Elm2NixError Value
tryLookup Object
dhm Text
"indirect"
          ([Dep] -> [Dep] -> [Dep])
-> Either Elm2NixError [Dep]
-> Either Elm2NixError [Dep]
-> Either Elm2NixError [Dep]
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 [Dep] -> [Dep] -> [Dep]
forall a. [a] -> [a] -> [a]
(++) (Value -> Either Elm2NixError [Dep]
parseDeps Value
direct) (Value -> Either Elm2NixError [Dep]
parseDeps Value
indirect)
        Value
v -> Elm2NixError -> Either Elm2NixError [Dep]
forall a b. a -> Either a b
Left (Value -> Elm2NixError
UnexpectedValue Value
v)
    Value
v -> Elm2NixError -> Either Elm2NixError [Dep]
forall a b. a -> Either a b
Left (Value -> Elm2NixError
UnexpectedValue Value
v)
  where
#if MIN_VERSION_aeson(2,0,0)
    parseDep :: Json.Key -> Value -> Either Elm2NixError Dep
    parseDep :: Key -> Value -> Either Elm2NixError Dep
parseDep Key
name (String Text
ver) = Dep -> Either Elm2NixError Dep
forall a b. b -> Either a b
Right (Text -> [Char]
Text.unpack (Key -> Text
AK.toText Key
name), Text -> [Char]
Text.unpack Text
ver)
#else
    parseDep :: Text -> Value -> Either Elm2NixError Dep
    parseDep name (String ver) = Right (Text.unpack name, Text.unpack ver)
#endif
    parseDep Key
_ Value
v               = Elm2NixError -> Either Elm2NixError Dep
forall a b. a -> Either a b
Left (Value -> Elm2NixError
UnexpectedValue Value
v)

    parseDeps :: Value -> Either Elm2NixError [Dep]
    parseDeps :: Value -> Either Elm2NixError [Dep]
parseDeps (Object Object
hm) = ((Key, Value) -> Either Elm2NixError Dep)
-> [(Key, Value)] -> Either Elm2NixError [Dep]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((Key -> Value -> Either Elm2NixError Dep)
-> (Key, Value) -> Either Elm2NixError Dep
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Key -> Value -> Either Elm2NixError Dep
parseDep) (Object -> [(Key, Value)]
forall v. KeyMap v -> [(Key, v)]
HM.toList Object
hm)
    parseDeps Value
v           = Elm2NixError -> Either Elm2NixError [Dep]
forall a b. a -> Either a b
Left (Value -> Elm2NixError
UnexpectedValue Value
v)

    maybeToRight :: b -> Maybe a -> Either b a
    maybeToRight :: forall b a. b -> Maybe a -> Either b a
maybeToRight b
_ (Just a
x) = a -> Either b a
forall a b. b -> Either a b
Right a
x
    maybeToRight b
y Maybe a
Nothing  = b -> Either b a
forall a b. a -> Either a b
Left b
y

#if MIN_VERSION_aeson(2,0,0)
    tryLookup :: HM.KeyMap Value -> Text -> Either Elm2NixError Value
    tryLookup :: Object -> Text -> Either Elm2NixError Value
tryLookup Object
hm Text
key =
      Elm2NixError -> Maybe Value -> Either Elm2NixError Value
forall b a. b -> Maybe a -> Either b a
maybeToRight (Text -> Elm2NixError
KeyNotFound Text
key) (Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
HM.lookup (Text -> Key
AK.fromText Text
key) Object
hm)
#else
    tryLookup :: HM.HashMap Text Value -> Text -> Either Elm2NixError Value
    tryLookup hm key =
      maybeToRight (KeyNotFound key) (HM.lookup key hm)
#endif