{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

module Options.Harg.Sources.Types
  ( GetSource (..),
    RunSource (..),
    ConfigFile (..),
    SourceRunResult (..),
    SourceRunError (..),
    sourceRunError,
  )
where

import Data.Functor.Compose (Compose (..))
import Data.Kind (Type)
import Data.String (IsString (..))
import Options.Harg.Het.Prod ((:*) (..))
import Options.Harg.Types

-- | Holds errors that occur when running a source.
data SourceRunResult a
  = -- | Source doesn't include the option
    OptNotFound
  | -- | Successful parsing
    OptParsed a
  deriving (a -> SourceRunResult b -> SourceRunResult a
(a -> b) -> SourceRunResult a -> SourceRunResult b
(forall a b. (a -> b) -> SourceRunResult a -> SourceRunResult b)
-> (forall a b. a -> SourceRunResult b -> SourceRunResult a)
-> Functor SourceRunResult
forall a b. a -> SourceRunResult b -> SourceRunResult a
forall a b. (a -> b) -> SourceRunResult a -> SourceRunResult b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> SourceRunResult b -> SourceRunResult a
$c<$ :: forall a b. a -> SourceRunResult b -> SourceRunResult a
fmap :: (a -> b) -> SourceRunResult a -> SourceRunResult b
$cfmap :: forall a b. (a -> b) -> SourceRunResult a -> SourceRunResult b
Functor)

data SourceRunError = SourceRunError
  { SourceRunError -> Maybe SomeOpt
_sreOpt :: Maybe SomeOpt,
    SourceRunError -> String
_sreSourceName :: String,
    SourceRunError -> String
_sreError :: String
  }

-- | Create a 'SourceRunError' by existentially wrapping an option in 'SomeOpt'.
sourceRunError ::
  forall a.
  Opt a ->
  String ->
  String ->
  SourceRunError
sourceRunError :: Opt a -> String -> String -> SourceRunError
sourceRunError =
  Maybe SomeOpt -> String -> String -> SourceRunError
SourceRunError (Maybe SomeOpt -> String -> String -> SourceRunError)
-> (Opt a -> Maybe SomeOpt)
-> Opt a
-> String
-> String
-> SourceRunError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeOpt -> Maybe SomeOpt
forall a. a -> Maybe a
Just (SomeOpt -> Maybe SomeOpt)
-> (Opt a -> SomeOpt) -> Opt a -> Maybe SomeOpt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Opt a -> SomeOpt
forall a. Opt a -> SomeOpt
SomeOpt

-- | This class enables a type that describes a source to fetch the source
-- contents, potentially producing side effects (e.g. reading a file).
class
  GetSource
    (c :: (Type -> Type) -> Type)
    (f :: (Type -> Type))
  where
  -- | The type that will be returned when the source is read.
  type SourceVal c :: Type

  getSource :: HargCtx -> c f -> IO (SourceVal c)

instance
  ( GetSource l f,
    GetSource r f
  ) =>
  GetSource (l :* r) f
  where
  type SourceVal (l :* r) = (SourceVal l, SourceVal r)
  getSource :: HargCtx -> (:*) l r f -> IO (SourceVal (l :* r))
getSource ctx :: HargCtx
ctx (l :: l f
l :* r :: r f
r) =
    (,) (SourceVal l -> SourceVal r -> (SourceVal l, SourceVal r))
-> IO (SourceVal l)
-> IO (SourceVal r -> (SourceVal l, SourceVal r))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HargCtx -> l f -> IO (SourceVal l)
forall (c :: (* -> *) -> *) (f :: * -> *).
GetSource c f =>
HargCtx -> c f -> IO (SourceVal c)
getSource HargCtx
ctx l f
l IO (SourceVal r -> (SourceVal l, SourceVal r))
-> IO (SourceVal r) -> IO (SourceVal l, SourceVal r)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> HargCtx -> r f -> IO (SourceVal r)
forall (c :: (* -> *) -> *) (f :: * -> *).
GetSource c f =>
HargCtx -> c f -> IO (SourceVal c)
getSource HargCtx
ctx r f
r

-- | This class is used to run the result of running 'getSource' on the
-- configuration options. In order for it to work, all types used in the
-- source configuration need to have a 'GetSource' instance, and their
-- associated 'SourceVal' types need to have a 'RunSource' instance.
class RunSource s a where
  runSource ::
    Applicative f =>
    s ->
    a (Compose Opt f) ->
    [Either SourceRunError (a (Compose SourceRunResult f))]

instance
  ( RunSource l a,
    RunSource r a
  ) =>
  RunSource (l, r) a
  where
  runSource :: (l, r)
-> a (Compose Opt f)
-> [Either SourceRunError (a (Compose SourceRunResult f))]
runSource (l :: l
l, r :: r
r) opt :: a (Compose Opt f)
opt =
    l
-> a (Compose Opt f)
-> [Either SourceRunError (a (Compose SourceRunResult f))]
forall s (a :: (* -> *) -> *) (f :: * -> *).
(RunSource s a, Applicative f) =>
s
-> a (Compose Opt f)
-> [Either SourceRunError (a (Compose SourceRunResult f))]
runSource l
l a (Compose Opt f)
opt [Either SourceRunError (a (Compose SourceRunResult f))]
-> [Either SourceRunError (a (Compose SourceRunResult f))]
-> [Either SourceRunError (a (Compose SourceRunResult f))]
forall a. [a] -> [a] -> [a]
++ r
-> a (Compose Opt f)
-> [Either SourceRunError (a (Compose SourceRunResult f))]
forall s (a :: (* -> *) -> *) (f :: * -> *).
(RunSource s a, Applicative f) =>
s
-> a (Compose Opt f)
-> [Either SourceRunError (a (Compose SourceRunResult f))]
runSource r
r a (Compose Opt f)
opt

instance RunSource () a where
  runSource :: ()
-> a (Compose Opt f)
-> [Either SourceRunError (a (Compose SourceRunResult f))]
runSource () _ =
    []

-- | This type describes configuration files, for use with e.g. the JSON
-- source. The reason to not use 'FilePath' directly is that the user might
-- prefer to do nothing if the option for the config file has not been not
-- provided, and there's no default. Because this type has an 'IsString'
-- instance, it's very easy to define an option. For example, to define a json
-- source with a default value:
--
-- @
--   srcOpt :: JSONSource Opt
--   srcOpt = JSONSource jsonOpt
--     where
--       jsonOpt
--         = optionWith strParser
--             ( long "json-config"
--             . defaultVal (ConfigFile "~/config.json")
--             )
-- @
--
-- And an optional JSON source:
--
-- @
--   srcOpt :: JSONSource Opt
--   srcOpt = JSONSource jsonOpt
--     where
--       jsonOpt
--         = optionWith strParser
--             ( long "json-config"
--             . defaultVal NoConfigFile
--             )
-- @
data ConfigFile
  = ConfigFile FilePath
  | NoConfigFile

instance IsString ConfigFile where
  fromString :: String -> ConfigFile
fromString = String -> ConfigFile
ConfigFile