{-# LANGUAGE AllowAmbiguousTypes   #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE LambdaCase            #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude     #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE QuasiQuotes           #-}
{-# LANGUAGE RecordWildCards       #-}
{-# LANGUAGE StrictData            #-}
{-# LANGUAGE TypeApplications      #-}
{-# LANGUAGE ViewPatterns          #-}

{-|
Module      : Headroom.Template.TemplateRef
Description : Representation of reference to template file
Copyright   : (c) 2019-2022 Vaclav Svejcar
License     : BSD-3-Clause
Maintainer  : vaclav.svejcar@gmail.com
Stability   : experimental
Portability : POSIX

'TemplateRef' data type represents reference to template file, either local or
remote, which can be later opened/downloaded and parsed into template.
-}

module Headroom.Template.TemplateRef
  ( -- * Data Types
    TemplateRef(..)
    -- * Constructor Functions
  , mkTemplateRef
    -- * Public Functions
  , renderRef
    -- * Error Types
  , TemplateRefError(..)
  )
where

import           Data.Aeson                          ( FromJSON(..)
                                                     , Value(String)
                                                     )
import           Data.String.Interpolate             ( i
                                                     , iii
                                                     )
import           Headroom.Data.EnumExtra             ( textToEnum )
import           Headroom.Data.Regex                 ( match
                                                     , re
                                                     )
import           Headroom.FileType.Types             ( FileType(..) )
import           Headroom.Types                      ( LicenseType
                                                     , fromHeadroomError
                                                     , toHeadroomError
                                                     )
import           RIO
import qualified RIO.Text                           as T
import qualified Text.URI                           as URI
import           Text.URI                            ( URI(..)
                                                     , mkURI
                                                     )


---------------------------------  DATA TYPES  ---------------------------------

-- | Reference to the template (e.g. local file, URI address).
data TemplateRef
  = InlineRef Text
  | LocalTemplateRef FilePath -- ^ template path on local file system
  | UriTemplateRef URI        -- ^ remote template URI adress
  | BuiltInRef LicenseType FileType
  deriving (TemplateRef -> TemplateRef -> Bool
(TemplateRef -> TemplateRef -> Bool)
-> (TemplateRef -> TemplateRef -> Bool) -> Eq TemplateRef
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TemplateRef -> TemplateRef -> Bool
$c/= :: TemplateRef -> TemplateRef -> Bool
== :: TemplateRef -> TemplateRef -> Bool
$c== :: TemplateRef -> TemplateRef -> Bool
Eq, Eq TemplateRef
Eq TemplateRef
-> (TemplateRef -> TemplateRef -> Ordering)
-> (TemplateRef -> TemplateRef -> Bool)
-> (TemplateRef -> TemplateRef -> Bool)
-> (TemplateRef -> TemplateRef -> Bool)
-> (TemplateRef -> TemplateRef -> Bool)
-> (TemplateRef -> TemplateRef -> TemplateRef)
-> (TemplateRef -> TemplateRef -> TemplateRef)
-> Ord TemplateRef
TemplateRef -> TemplateRef -> Bool
TemplateRef -> TemplateRef -> Ordering
TemplateRef -> TemplateRef -> TemplateRef
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TemplateRef -> TemplateRef -> TemplateRef
$cmin :: TemplateRef -> TemplateRef -> TemplateRef
max :: TemplateRef -> TemplateRef -> TemplateRef
$cmax :: TemplateRef -> TemplateRef -> TemplateRef
>= :: TemplateRef -> TemplateRef -> Bool
$c>= :: TemplateRef -> TemplateRef -> Bool
> :: TemplateRef -> TemplateRef -> Bool
$c> :: TemplateRef -> TemplateRef -> Bool
<= :: TemplateRef -> TemplateRef -> Bool
$c<= :: TemplateRef -> TemplateRef -> Bool
< :: TemplateRef -> TemplateRef -> Bool
$c< :: TemplateRef -> TemplateRef -> Bool
compare :: TemplateRef -> TemplateRef -> Ordering
$ccompare :: TemplateRef -> TemplateRef -> Ordering
$cp1Ord :: Eq TemplateRef
Ord, Int -> TemplateRef -> ShowS
[TemplateRef] -> ShowS
TemplateRef -> String
(Int -> TemplateRef -> ShowS)
-> (TemplateRef -> String)
-> ([TemplateRef] -> ShowS)
-> Show TemplateRef
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TemplateRef] -> ShowS
$cshowList :: [TemplateRef] -> ShowS
show :: TemplateRef -> String
$cshow :: TemplateRef -> String
showsPrec :: Int -> TemplateRef -> ShowS
$cshowsPrec :: Int -> TemplateRef -> ShowS
Show)


instance FromJSON TemplateRef where
  parseJSON :: Value -> Parser TemplateRef
parseJSON = \case
    String Text
s -> Parser TemplateRef
-> (TemplateRef -> Parser TemplateRef)
-> Maybe TemplateRef
-> Parser TemplateRef
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Parser TemplateRef
forall a. HasCallStack => String -> a
error (String -> Parser TemplateRef) -> String -> Parser TemplateRef
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
s) TemplateRef -> Parser TemplateRef
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Maybe TemplateRef
forall (m :: * -> *). MonadThrow m => Text -> m TemplateRef
mkTemplateRef Text
s)
    Value
other    -> String -> Parser TemplateRef
forall a. HasCallStack => String -> a
error (String -> Parser TemplateRef) -> String -> Parser TemplateRef
forall a b. (a -> b) -> a -> b
$ String
"Invalid value for template reference: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Value -> String
forall a. Show a => a -> String
show Value
other


------------------------------  PUBLIC FUNCTIONS  ------------------------------

-- | Creates a 'TemplateRef' from given text. If the raw text appears to be
-- valid URL with either @http@ or @https@ as protocol, it considers it as
-- 'UriTemplateRef', otherwise it creates 'LocalTemplateRef'.
--
-- >>> mkTemplateRef "/path/to/haskell.mustache" :: Maybe TemplateRef
-- Just (LocalTemplateRef "/path/to/haskell.mustache")
--
-- >>> mkTemplateRef "https://foo.bar/haskell.mustache" :: Maybe TemplateRef
-- Just (UriTemplateRef (URI {uriScheme = Just "https", uriAuthority = Right (Authority {authUserInfo = Nothing, authHost = "foo.bar", authPort = Nothing}), uriPath = Just (False,"haskell.mustache" :| []), uriQuery = [], uriFragment = Nothing}))
mkTemplateRef :: MonadThrow m
              => Text          -- ^ input text
              -> m TemplateRef -- ^ created 'TemplateRef' (or error)
mkTemplateRef :: Text -> m TemplateRef
mkTemplateRef Text
raw = case Regex -> Text -> Maybe [Text]
match [re|(^\w+):\/\/|] Text
raw of
  Just (Text
_ : Text
p : [Text]
_) | Text
p Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"http", Text
"https"] -> m TemplateRef
uriTemplateRef
                   | Bool
otherwise -> TemplateRefError -> m TemplateRef
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (TemplateRefError -> m TemplateRef)
-> TemplateRefError -> m TemplateRef
forall a b. (a -> b) -> a -> b
$ Text -> Text -> TemplateRefError
UnsupportedUriProtocol Text
p Text
raw
  Maybe [Text]
_ -> TemplateRef -> m TemplateRef
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TemplateRef -> m TemplateRef)
-> (Text -> TemplateRef) -> Text -> m TemplateRef
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> TemplateRef
LocalTemplateRef (String -> TemplateRef) -> (Text -> String) -> Text -> TemplateRef
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> m TemplateRef) -> Text -> m TemplateRef
forall a b. (a -> b) -> a -> b
$ Text
raw
 where
  uriTemplateRef :: m TemplateRef
uriTemplateRef  = m FileType
extractFileType m FileType -> m TemplateRef -> m TemplateRef
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> URI -> TemplateRef
UriTemplateRef (URI -> TemplateRef) -> m URI -> m TemplateRef
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> m URI
forall (m :: * -> *). MonadThrow m => Text -> m URI
mkURI Text
raw
  extractFileType :: m FileType
extractFileType = case Regex -> Text -> Maybe [Text]
match [re|(\w+)\.(\w+)$|] Text
raw of
    Just (Text
_ : (EnumExtra FileType => Text -> Maybe FileType
forall a. EnumExtra a => Text -> Maybe a
textToEnum @FileType -> (Just FileType
ft )) : Text
_ : [Text]
_) -> FileType -> m FileType
forall (f :: * -> *) a. Applicative f => a -> f a
pure FileType
ft
    Maybe [Text]
_ -> TemplateRefError -> m FileType
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (TemplateRefError -> m FileType) -> TemplateRefError -> m FileType
forall a b. (a -> b) -> a -> b
$ Text -> TemplateRefError
UnrecognizedTemplateName Text
raw


------------------------------  PUBLIC FUNCTIONS  ------------------------------

-- | Renders given 'TemplateRef' into human-friendly text.
renderRef :: TemplateRef -- ^ 'TemplateRef' to render
          -> Text        -- ^ rendered text
renderRef :: TemplateRef -> Text
renderRef (InlineRef        Text
content) = [i|<inline template '#{content}'>|]
renderRef (LocalTemplateRef String
path   ) = String -> Text
T.pack String
path
renderRef (UriTemplateRef   URI
uri    ) = URI -> Text
URI.render URI
uri
renderRef (BuiltInRef LicenseType
lt FileType
ft        ) = [i|<built-in template #{lt}/#{ft}>|]


---------------------------------  ERROR TYPES  --------------------------------

-- | Error related to template references.
data TemplateRefError
  = UnrecognizedTemplateName Text    -- ^ not a valid format for template name
  | UnsupportedUriProtocol Text Text -- ^ URI protocol not supported
  deriving (TemplateRefError -> TemplateRefError -> Bool
(TemplateRefError -> TemplateRefError -> Bool)
-> (TemplateRefError -> TemplateRefError -> Bool)
-> Eq TemplateRefError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TemplateRefError -> TemplateRefError -> Bool
$c/= :: TemplateRefError -> TemplateRefError -> Bool
== :: TemplateRefError -> TemplateRefError -> Bool
$c== :: TemplateRefError -> TemplateRefError -> Bool
Eq, Int -> TemplateRefError -> ShowS
[TemplateRefError] -> ShowS
TemplateRefError -> String
(Int -> TemplateRefError -> ShowS)
-> (TemplateRefError -> String)
-> ([TemplateRefError] -> ShowS)
-> Show TemplateRefError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TemplateRefError] -> ShowS
$cshowList :: [TemplateRefError] -> ShowS
show :: TemplateRefError -> String
$cshow :: TemplateRefError -> String
showsPrec :: Int -> TemplateRefError -> ShowS
$cshowsPrec :: Int -> TemplateRefError -> ShowS
Show)


instance Exception TemplateRefError where
  displayException :: TemplateRefError -> String
displayException = TemplateRefError -> String
displayException'
  toException :: TemplateRefError -> SomeException
toException      = TemplateRefError -> SomeException
forall e. Exception e => e -> SomeException
toHeadroomError
  fromException :: SomeException -> Maybe TemplateRefError
fromException    = SomeException -> Maybe TemplateRefError
forall e. Exception e => SomeException -> Maybe e
fromHeadroomError


displayException' :: TemplateRefError -> String
displayException' :: TemplateRefError -> String
displayException' = \case
  UnrecognizedTemplateName Text
raw -> [iii|
      Cannot extract file type and template type from path #{raw}. Please make
      sure that the path ends with '<FILE_TYPE>.<TEMPLATE_TYPE>', for example
      '/path/to/haskell.mustache'.
    |]
  UnsupportedUriProtocol Text
protocol Text
raw -> [iii|
      Protocol '#{protocol}' of in URI '#{raw}' is not supported. Make sure that
      you use either HTTP or HTTPS URIs.
    |]