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

import Prelude()
import Protolude hiding (to)

import qualified Data.Aeson as Aeson
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 <- FilePath -> IO Value
forall a. FromJSON a => FilePath -> IO a
decodeFile FilePath
fp

  [Text] -> IO [Text]
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]
^.. Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"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
. Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"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
. Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key 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
. Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"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)
_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)
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. AsPrimitive t => Prism' t Text
_String)