{-# LANGUAGE CPP #-}

module Arion.Services
  ( getDefaultExec,
  )
where

import qualified Data.Aeson as Aeson
import Protolude hiding (to)
import Prelude ()
#if MIN_VERSION_lens_aeson(1,2,0)
import qualified Data.Aeson.Key as AK
#endif
import Arion.Aeson (decodeFile)
import Control.Lens
import Data.Aeson.Lens

#if MIN_VERSION_lens_aeson(1,2,0)
type Key = AK.Key
mkKey :: Text -> Key
mkKey :: Text -> Key
mkKey = Text -> Key
AK.fromText
#else
type Key = Text
mkKey :: Text -> Key
mkKey = identity
#endif

-- | Subject to change
getDefaultExec :: FilePath -> Text -> IO [Text]
getDefaultExec :: FilePath -> Text -> IO [Text]
getDefaultExec FilePath
fp Text
service = do
  Value
v <- FilePath -> IO Value
forall a. FromJSON a => FilePath -> IO a
decodeFile FilePath
fp

  [Text] -> IO [Text]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Value
v :: Aeson.Value) Value -> Getting (Endo [Text]) Value Text -> [Text]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"x-arion" ((Value -> Const (Endo [Text]) Value)
 -> Value -> Const (Endo [Text]) Value)
-> Getting (Endo [Text]) Value Text
-> Getting (Endo [Text]) Value Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"serviceInfo" ((Value -> Const (Endo [Text]) Value)
 -> Value -> Const (Endo [Text]) Value)
-> Getting (Endo [Text]) Value Text
-> Getting (Endo [Text]) Value Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key (Text -> Key
mkKey Text
service) ((Value -> Const (Endo [Text]) Value)
 -> Value -> Const (Endo [Text]) Value)
-> Getting (Endo [Text]) Value Text
-> Getting (Endo [Text]) Value Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"defaultExec" ((Value -> Const (Endo [Text]) Value)
 -> Value -> Const (Endo [Text]) Value)
-> Getting (Endo [Text]) Value Text
-> Getting (Endo [Text]) Value Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vector Value -> Const (Endo [Text]) (Vector Value))
-> Value -> Const (Endo [Text]) Value
forall t. AsValue t => Prism' t (Vector Value)
Prism' Value (Vector Value)
_Array ((Vector Value -> Const (Endo [Text]) (Vector Value))
 -> Value -> Const (Endo [Text]) Value)
-> ((Text -> Const (Endo [Text]) Text)
    -> Vector Value -> Const (Endo [Text]) (Vector Value))
-> Getting (Endo [Text]) Value Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Const (Endo [Text]) Value)
-> Vector Value -> Const (Endo [Text]) (Vector Value)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Vector a -> f (Vector b)
traverse ((Value -> Const (Endo [Text]) Value)
 -> Vector Value -> Const (Endo [Text]) (Vector Value))
-> Getting (Endo [Text]) Value Text
-> (Text -> Const (Endo [Text]) Text)
-> Vector Value
-> Const (Endo [Text]) (Vector Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (Endo [Text]) Value Text
forall t. AsValue t => Prism' t Text
Prism' Value Text
_String)