{-# LANGUAGE DeriveAnyClass #-}

module Hercules.Formats.Mountable where

import qualified Data.Aeson as A
import Data.Text (Text)
import GHC.Generics (Generic)
import Hercules.Formats.Secret (Condition)
import Prelude (Bool, Eq, Show)

data Mountable = Mountable
  { -- | A path on the host.
    Mountable -> Text
source :: !Text,
    Mountable -> Bool
readOnly :: !Bool,
    Mountable -> Condition
condition :: !Condition
  }
  deriving ((forall x. Mountable -> Rep Mountable x)
-> (forall x. Rep Mountable x -> Mountable) -> Generic Mountable
forall x. Rep Mountable x -> Mountable
forall x. Mountable -> Rep Mountable x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Mountable -> Rep Mountable x
from :: forall x. Mountable -> Rep Mountable x
$cto :: forall x. Rep Mountable x -> Mountable
to :: forall x. Rep Mountable x -> Mountable
Generic, Int -> Mountable -> ShowS
[Mountable] -> ShowS
Mountable -> String
(Int -> Mountable -> ShowS)
-> (Mountable -> String)
-> ([Mountable] -> ShowS)
-> Show Mountable
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Mountable -> ShowS
showsPrec :: Int -> Mountable -> ShowS
$cshow :: Mountable -> String
show :: Mountable -> String
$cshowList :: [Mountable] -> ShowS
showList :: [Mountable] -> ShowS
Show, Mountable -> Mountable -> Bool
(Mountable -> Mountable -> Bool)
-> (Mountable -> Mountable -> Bool) -> Eq Mountable
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Mountable -> Mountable -> Bool
== :: Mountable -> Mountable -> Bool
$c/= :: Mountable -> Mountable -> Bool
/= :: Mountable -> Mountable -> Bool
Eq, [Mountable] -> Value
[Mountable] -> Encoding
Mountable -> Value
Mountable -> Encoding
(Mountable -> Value)
-> (Mountable -> Encoding)
-> ([Mountable] -> Value)
-> ([Mountable] -> Encoding)
-> ToJSON Mountable
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: Mountable -> Value
toJSON :: Mountable -> Value
$ctoEncoding :: Mountable -> Encoding
toEncoding :: Mountable -> Encoding
$ctoJSONList :: [Mountable] -> Value
toJSONList :: [Mountable] -> Value
$ctoEncodingList :: [Mountable] -> Encoding
toEncodingList :: [Mountable] -> Encoding
A.ToJSON, Value -> Parser [Mountable]
Value -> Parser Mountable
(Value -> Parser Mountable)
-> (Value -> Parser [Mountable]) -> FromJSON Mountable
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser Mountable
parseJSON :: Value -> Parser Mountable
$cparseJSONList :: Value -> Parser [Mountable]
parseJSONList :: Value -> Parser [Mountable]
A.FromJSON)