module Summoner.Source
( Source (..)
, sourceT
, sourceCodec
, fetchSource
) where
import Control.Arrow ((>>>))
import Control.Exception (catch)
import System.Process (readProcess)
import Toml (Key, TomlBiMap, TomlBiMapError (..), TomlCodec)
import Summoner.Ansi (errorMessage, infoMessage)
import qualified Toml
data Source
= Url !Text
| Local !FilePath
| Raw !Text
deriving stock (Show, Eq)
showSource :: Source -> Text
showSource = \case
Url _ -> "Url"
Local _ -> "Local"
Raw _ -> "Raw"
matchUrl :: Source -> Either TomlBiMapError Text
matchUrl (Url url) = Right url
matchUrl e = Left $ WrongConstructor "Url" $ showSource e
matchLocal :: Source -> Either TomlBiMapError FilePath
matchLocal (Local file) = Right file
matchLocal e = Left $ WrongConstructor "Local" $ showSource e
matchRaw :: Source -> Either TomlBiMapError Text
matchRaw (Raw raw) = Right raw
matchRaw e = Left $ WrongConstructor "Raw" $ showSource e
sourceT :: Key -> TomlCodec Source
sourceT nm = Toml.match (_Url >>> Toml._Text) (nm <> "url")
<|> Toml.match (_Local >>> Toml._String) (nm <> "Local")
<|> Toml.match (_Raw >>> Toml._Text) (nm <> "raw")
where
_Url :: TomlBiMap Source Text
_Url = Toml.prism Url matchUrl
_Local :: TomlBiMap Source FilePath
_Local = Toml.prism Local matchLocal
_Raw :: TomlBiMap Source Text
_Raw = Toml.prism Raw matchRaw
sourceCodec :: TomlCodec Source
sourceCodec = asum
[ Toml.dimatch (rightToMaybe . matchUrl) Url (Toml.text "url")
, Toml.dimatch (rightToMaybe . matchLocal) Local (Toml.string "local")
, Toml.dimatch (rightToMaybe . matchRaw) Raw (Toml.text "raw")
]
fetchSource :: Bool -> Source -> IO (Maybe Text)
fetchSource isOffline = \case
Local path -> catch (Just <$> readFileText path) (localError path)
Url url -> if isOffline
then Nothing <$ infoMessage ("Ignoring fetching from URL in offline mode from source: " <> url)
else fetchUrl url `catch` urlError url
Raw raw -> pure $ Just raw
where
localError :: FilePath -> SomeException -> IO (Maybe Text)
localError path _ = errorMessage ("Couldn't read file: " <> toText path)
>> pure Nothing
urlError :: Text -> SomeException -> IO (Maybe Text)
urlError url _ = errorMessage ("Couldn't get to link: " <> url)
>> pure Nothing
fetchUrl :: Text -> IO (Maybe Text)
fetchUrl url = Just . toText <$> readProcess "curl" [toString url] ""