{- |
Copyright: (c) 2017-2019 Kowainik
SPDX-License-Identifier: MPL-2.0
Maintainer: Kowainik <xrom.xkov@gmail.com>

This module contains the 'Source' data that describes how to fetch custom files.
-}

module Summoner.Source
       ( Source (..)
       , sourceCodec
       , fetchSources
       , fetchSource
       ) where

import Control.Exception (catch)
import System.Process (readProcess)
import Toml (TomlBiMapError (..), TomlCodec)

import Summoner.Ansi (errorMessage, infoMessage)
import Summoner.Mode (ConnectMode (..), isOffline)
import Summoner.Tree (TreeFs, pathToTree)

import qualified Data.Map.Strict as Map
import qualified Toml


-- | Type of the source resource.
data Source
    {- | URL link to the source file. Such files will be downloaded by URL. But
    they are ingored in the @offline@ mode.
    -}
    = Url !Text

    {- | File path to the local source file.
    -}
    | Local !FilePath

    {- | Raw file text content.
    -}
    | Raw !Text
    deriving stock (Int -> Source -> ShowS
[Source] -> ShowS
Source -> String
(Int -> Source -> ShowS)
-> (Source -> String) -> ([Source] -> ShowS) -> Show Source
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Source] -> ShowS
$cshowList :: [Source] -> ShowS
show :: Source -> String
$cshow :: Source -> String
showsPrec :: Int -> Source -> ShowS
$cshowsPrec :: Int -> Source -> ShowS
Show, Source -> Source -> Bool
(Source -> Source -> Bool)
-> (Source -> Source -> Bool) -> Eq Source
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Source -> Source -> Bool
$c/= :: Source -> Source -> Bool
== :: Source -> Source -> Bool
$c== :: Source -> Source -> Bool
Eq)

showSource :: Source -> Text
showSource :: Source -> Text
showSource = \case
    Url _ -> "Url"
    Local _ -> "Local"
    Raw _ -> "Raw"

-- TODO: return Maybe
matchUrl :: Source -> Either TomlBiMapError Text
matchUrl :: Source -> Either TomlBiMapError Text
matchUrl (Url url :: Text
url) = Text -> Either TomlBiMapError Text
forall a b. b -> Either a b
Right Text
url
matchUrl e :: Source
e         = TomlBiMapError -> Either TomlBiMapError Text
forall a b. a -> Either a b
Left (TomlBiMapError -> Either TomlBiMapError Text)
-> TomlBiMapError -> Either TomlBiMapError Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> TomlBiMapError
WrongConstructor "Url" (Text -> TomlBiMapError) -> Text -> TomlBiMapError
forall a b. (a -> b) -> a -> b
$ Source -> Text
showSource Source
e

-- TODO: return Maybe
matchLocal :: Source -> Either TomlBiMapError FilePath
matchLocal :: Source -> Either TomlBiMapError String
matchLocal (Local file :: String
file) = String -> Either TomlBiMapError String
forall a b. b -> Either a b
Right String
file
matchLocal e :: Source
e            = TomlBiMapError -> Either TomlBiMapError String
forall a b. a -> Either a b
Left (TomlBiMapError -> Either TomlBiMapError String)
-> TomlBiMapError -> Either TomlBiMapError String
forall a b. (a -> b) -> a -> b
$ Text -> Text -> TomlBiMapError
WrongConstructor "Local" (Text -> TomlBiMapError) -> Text -> TomlBiMapError
forall a b. (a -> b) -> a -> b
$ Source -> Text
showSource Source
e

-- TODO: return Maybe
matchRaw :: Source -> Either TomlBiMapError Text
matchRaw :: Source -> Either TomlBiMapError Text
matchRaw (Raw raw :: Text
raw) = Text -> Either TomlBiMapError Text
forall a b. b -> Either a b
Right Text
raw
matchRaw e :: Source
e         = TomlBiMapError -> Either TomlBiMapError Text
forall a b. a -> Either a b
Left (TomlBiMapError -> Either TomlBiMapError Text)
-> TomlBiMapError -> Either TomlBiMapError Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> TomlBiMapError
WrongConstructor "Raw" (Text -> TomlBiMapError) -> Text -> TomlBiMapError
forall a b. (a -> b) -> a -> b
$ Source -> Text
showSource Source
e

{- | This 'TomlCodec' is used in the @files@ field of config. It decodes
corresponding constructor from the top-level key.
-}
sourceCodec :: TomlCodec Source
sourceCodec :: TomlCodec Source
sourceCodec = [TomlCodec Source] -> TomlCodec Source
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ (Source -> Maybe Text)
-> (Text -> Source) -> Codec Env St Text Text -> TomlCodec Source
forall (r :: * -> *) (w :: * -> *) c d a b.
(Functor r, Alternative w) =>
(c -> Maybe d) -> (a -> b) -> Codec r w d a -> Codec r w c b
Toml.dimatch (Either TomlBiMapError Text -> Maybe Text
forall l r. Either l r -> Maybe r
rightToMaybe (Either TomlBiMapError Text -> Maybe Text)
-> (Source -> Either TomlBiMapError Text) -> Source -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Source -> Either TomlBiMapError Text
matchUrl) Text -> Source
Url (Key -> Codec Env St Text Text
Toml.text "url")
    , (Source -> Maybe String)
-> (String -> Source)
-> Codec Env St String String
-> TomlCodec Source
forall (r :: * -> *) (w :: * -> *) c d a b.
(Functor r, Alternative w) =>
(c -> Maybe d) -> (a -> b) -> Codec r w d a -> Codec r w c b
Toml.dimatch (Either TomlBiMapError String -> Maybe String
forall l r. Either l r -> Maybe r
rightToMaybe (Either TomlBiMapError String -> Maybe String)
-> (Source -> Either TomlBiMapError String)
-> Source
-> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Source -> Either TomlBiMapError String
matchLocal) String -> Source
Local (Key -> Codec Env St String String
Toml.string "local")
    , (Source -> Maybe Text)
-> (Text -> Source) -> Codec Env St Text Text -> TomlCodec Source
forall (r :: * -> *) (w :: * -> *) c d a b.
(Functor r, Alternative w) =>
(c -> Maybe d) -> (a -> b) -> Codec r w d a -> Codec r w c b
Toml.dimatch (Either TomlBiMapError Text -> Maybe Text
forall l r. Either l r -> Maybe r
rightToMaybe (Either TomlBiMapError Text -> Maybe Text)
-> (Source -> Either TomlBiMapError Text) -> Source -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Source -> Either TomlBiMapError Text
matchRaw) Text -> Source
Raw (Key -> Codec Env St Text Text
Toml.text "raw")
    ]

{- | This function fetches contents of extra file sources.
-}
fetchSources :: ConnectMode -> Map FilePath Source -> IO [TreeFs]
fetchSources :: ConnectMode -> Map String Source -> IO [TreeFs]
fetchSources connectMode :: ConnectMode
connectMode = ((String, Source) -> IO (Maybe TreeFs))
-> [(String, Source)] -> IO [TreeFs]
forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> [a] -> m [b]
mapMaybeM (String, Source) -> IO (Maybe TreeFs)
sourceToTree ([(String, Source)] -> IO [TreeFs])
-> (Map String Source -> [(String, Source)])
-> Map String Source
-> IO [TreeFs]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map String Source -> [(String, Source)]
forall k a. Map k a -> [(k, a)]
Map.toList
  where
    sourceToTree :: (FilePath, Source) -> IO (Maybe TreeFs)
    sourceToTree :: (String, Source) -> IO (Maybe TreeFs)
sourceToTree (path :: String
path, source :: Source
source) = do
        Text -> IO ()
infoMessage (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ "Fetching content of the extra file: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a. ToText a => a -> Text
toText String
path
        ConnectMode -> Source -> IO (Maybe Text)
fetchSource ConnectMode
connectMode Source
source IO (Maybe Text)
-> (Maybe Text -> IO (Maybe TreeFs)) -> IO (Maybe TreeFs)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Nothing -> Maybe TreeFs
forall a. Maybe a
Nothing Maybe TreeFs -> IO () -> IO (Maybe TreeFs)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> IO ()
errorMessage ("Error fetching: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a. ToText a => a -> Text
toText String
path)
            Just content :: Text
content -> Maybe TreeFs -> IO (Maybe TreeFs)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe TreeFs -> IO (Maybe TreeFs))
-> Maybe TreeFs -> IO (Maybe TreeFs)
forall a b. (a -> b) -> a -> b
$ TreeFs -> Maybe TreeFs
forall a. a -> Maybe a
Just (TreeFs -> Maybe TreeFs) -> TreeFs -> Maybe TreeFs
forall a b. (a -> b) -> a -> b
$ String -> Text -> TreeFs
pathToTree String
path Text
content

{- | Fetches content of the given extra file source.
Doesn't fetch 'Url' if the 'ConnectMode' is 'Offline'.
-}
fetchSource :: ConnectMode -> Source -> IO (Maybe Text)
fetchSource :: ConnectMode -> Source -> IO (Maybe Text)
fetchSource connectMode :: ConnectMode
connectMode = \case
    Local path :: String
path -> IO (Maybe Text)
-> (SomeException -> IO (Maybe Text)) -> IO (Maybe Text)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> IO Text -> IO (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO Text
forall (m :: * -> *). MonadIO m => String -> m Text
readFileText String
path) (String -> SomeException -> IO (Maybe Text)
localError String
path)
    Url url :: Text
url -> if ConnectMode -> Bool
isOffline ConnectMode
connectMode
        then Maybe Text
forall a. Maybe a
Nothing Maybe Text -> IO () -> IO (Maybe Text)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> IO ()
infoMessage ("Ignoring fetching from URL in offline mode from source: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
url)
        else Text -> IO (Maybe Text)
fetchUrl Text
url IO (Maybe Text)
-> (SomeException -> IO (Maybe Text)) -> IO (Maybe Text)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` Text -> SomeException -> IO (Maybe Text)
urlError Text
url
    Raw raw :: Text
raw -> Maybe Text -> IO (Maybe Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Text -> IO (Maybe Text)) -> Maybe Text -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just Text
raw
  where
    localError :: FilePath -> SomeException -> IO (Maybe Text)
    localError :: String -> SomeException -> IO (Maybe Text)
localError path :: String
path err :: SomeException
err = do
        Text -> IO ()
errorMessage ("Couldn't read file: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a. ToText a => a -> Text
toText String
path)
        Text -> IO ()
errorMessage (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. ToText a => a -> Text
toText (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ SomeException -> String
forall e. Exception e => e -> String
displayException SomeException
err
        Maybe Text -> IO (Maybe Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Text
forall a. Maybe a
Nothing

    urlError :: Text -> SomeException -> IO (Maybe Text)
    urlError :: Text -> SomeException -> IO (Maybe Text)
urlError url :: Text
url err :: SomeException
err = do
        Text -> IO ()
errorMessage ("Couldn't get to link: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
url)
        Text -> IO ()
errorMessage (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. ToText a => a -> Text
toText (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ SomeException -> String
forall e. Exception e => e -> String
displayException SomeException
err
        Maybe Text -> IO (Maybe Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Text
forall a. Maybe a
Nothing

    fetchUrl :: Text -> IO (Maybe Text)
    fetchUrl :: Text -> IO (Maybe Text)
fetchUrl url :: Text
url = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> (String -> Text) -> String -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a. ToText a => a -> Text
toText (String -> Maybe Text) -> IO String -> IO (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> [String] -> String -> IO String
readProcess "curl" [Text -> String
forall a. ToString a => a -> String
toString Text
url, "--silent", "--fail"] ""