{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE OverloadedStrings #-}
module Arion.Services
  ( getDefaultExec
  ) where

import Prelude()
import Protolude hiding (to)

import qualified Data.Aeson as Aeson
import qualified Data.Aeson.Key as AK
import           Arion.Aeson (decodeFile)

import Control.Lens
import Data.Aeson.Lens

-- | Subject to change
getDefaultExec :: FilePath -> Text -> IO [Text]
getDefaultExec :: FilePath -> Text -> IO [Text]
getDefaultExec FilePath
fp Text
service = do

  Value
v <- forall a. FromJSON a => FilePath -> IO a
decodeFile FilePath
fp

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