module Network.IPFS.BinPath.Types (BinPath (..)) where

import qualified RIO.Text as Text

import System.Envy

import Network.IPFS.Internal.Orphanage.Natural ()
import Network.IPFS.Prelude

-- | Path to the IPFS binary
newtype BinPath = BinPath { BinPath -> FilePath
getBinPath :: FilePath }
  deriving          ( Int -> BinPath -> ShowS
[BinPath] -> ShowS
BinPath -> FilePath
(Int -> BinPath -> ShowS)
-> (BinPath -> FilePath) -> ([BinPath] -> ShowS) -> Show BinPath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [BinPath] -> ShowS
$cshowList :: [BinPath] -> ShowS
show :: BinPath -> FilePath
$cshow :: BinPath -> FilePath
showsPrec :: Int -> BinPath -> ShowS
$cshowsPrec :: Int -> BinPath -> ShowS
Show
                    , BinPath -> BinPath -> Bool
(BinPath -> BinPath -> Bool)
-> (BinPath -> BinPath -> Bool) -> Eq BinPath
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BinPath -> BinPath -> Bool
$c/= :: BinPath -> BinPath -> Bool
== :: BinPath -> BinPath -> Bool
$c== :: BinPath -> BinPath -> Bool
Eq
                    , (forall x. BinPath -> Rep BinPath x)
-> (forall x. Rep BinPath x -> BinPath) -> Generic BinPath
forall x. Rep BinPath x -> BinPath
forall x. BinPath -> Rep BinPath x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BinPath x -> BinPath
$cfrom :: forall x. BinPath -> Rep BinPath x
Generic
                    )
  deriving newtype  ( FilePath -> BinPath
(FilePath -> BinPath) -> IsString BinPath
forall a. (FilePath -> a) -> IsString a
fromString :: FilePath -> BinPath
$cfromString :: FilePath -> BinPath
IsString )

instance FromEnv BinPath where
  fromEnv :: Maybe BinPath -> Parser BinPath
fromEnv Maybe BinPath
_ = FilePath -> BinPath
BinPath (FilePath -> BinPath) -> Parser FilePath -> Parser BinPath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> Parser FilePath
forall a. Var a => FilePath -> Parser a
env FilePath
"IPFS_PATH"

instance FromJSON BinPath where
  parseJSON :: Value -> Parser BinPath
parseJSON = FilePath -> (Text -> Parser BinPath) -> Value -> Parser BinPath
forall a. FilePath -> (Text -> Parser a) -> Value -> Parser a
withText FilePath
"IPFS.BinPath" \Text
txt ->
    FilePath -> BinPath
BinPath (FilePath -> BinPath) -> Parser FilePath -> Parser BinPath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser FilePath
forall a. FromJSON a => Value -> Parser a
parseJSON (Text -> Value
String Text
txt)

instance Display BinPath where
  textDisplay :: BinPath -> Text
textDisplay (BinPath FilePath
path) = FilePath -> Text
Text.pack FilePath
path