[#66] Introduce TemplateRef

headroom.cabal

@@ -4,7 +4,7 @@ cabal-version: 2.2
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: cc66bffc010a623d2bba63193db0fcc17a3454845d0348c3e33104d09b7ad62d
+-- hash: fad870155d9e943ea6729ce0b1fc7ab981a153d1052565d791a1ab6116685bd0
 
 name:           headroom
 version:        0.4.2.0
@@ -184,6 +184,7 @@ library
       Headroom.SourceCode
       Headroom.Template
       Headroom.Template.Mustache
+      Headroom.Template.TemplateRef
       Headroom.Types
       Headroom.UI
       Headroom.UI.Progress
@@ -204,11 +205,13 @@ library
     , generic-data
     , microlens
     , microlens-th
+    , modern-uri
     , mtl
     , mustache
     , optparse-applicative
     , pcre-heavy
     , pcre-light
+    , req
     , rio
     , string-interpolate
     , template-haskell
@@ -284,6 +287,7 @@ test-suite spec
       Headroom.Meta.VersionSpec
       Headroom.SourceCodeSpec
       Headroom.Template.MustacheSpec
+      Headroom.Template.TemplateRefSpec
       Headroom.TypesSpec
       Headroom.UI.ProgressSpec
       Headroom.VariablesSpec
@@ -299,6 +303,7 @@ test-suite spec
     , base >=4.7 && <5
     , headroom
     , hspec
+    , modern-uri
     , mtl
     , optparse-applicative
     , pcre-light

package.yaml

@@ -68,10 +68,12 @@ library:
     - generic-data
     - microlens
     - microlens-th
+    - modern-uri
     - mtl
     - mustache
     - pcre-light
     - pcre-heavy
+    - req
     - string-interpolate
     - template-haskell
     - time
@@ -85,6 +87,7 @@ tests:
       - aeson
       - headroom
       - hspec
+      - modern-uri
       - mtl
       - pcre-light
       - QuickCheck

src/Headroom/Data/EnumExtra.hs

@@ -16,7 +16,10 @@ Provides extra functionality for enum-like types, e.g. reading/writing
 from/to textual representation, etc.
 -}
 
-module Headroom.Data.EnumExtra where
+module Headroom.Data.EnumExtra
+  ( EnumExtra(..)
+  )
+where
 
 import           RIO
 import qualified RIO.List                           as L

src/Headroom/Template/TemplateRef.hs

@@ -0,0 +1,118 @@
+{-# LANGUAGE LambdaCase        #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes       #-}
+{-# LANGUAGE StrictData        #-}
+{-# LANGUAGE TypeApplications  #-}
+{-# LANGUAGE ViewPatterns      #-}
+
+{-|
+Module      : Headroom.Template.TemplateRef
+Description : Representation of reference to template file
+Copyright   : (c) 2019-2021 Vaclav Svejcar
+License     : BSD-3-Clause
+Maintainer  : [email protected]
+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
+    TemplateSource(..)
+  , TemplateRef(..)
+    -- * Constructor Functions
+  , mkTemplateRef
+    -- * Error Types
+  , TemplateRefError(..)
+  )
+where
+
+import           Data.String.Interpolate             ( iii )
+import           Headroom.Data.EnumExtra             ( textToEnum )
+import           Headroom.Data.Regex                 ( match
+                                                     , re
+                                                     )
+import           Headroom.FileType.Types             ( FileType )
+import           Headroom.Meta                       ( TemplateType )
+import           Headroom.Template                   ( Template(..) )
+import           Headroom.Types                      ( fromHeadroomError
+                                                     , toHeadroomError
+                                                     )
+import           RIO
+import qualified RIO.Text                           as T
+import           Text.URI                            ( URI(..)
+                                                     , mkURI
+                                                     )
+
+
+---------------------------------  DATA TYPES  ---------------------------------
+
+-- | Source of the template (e.g. local file, URI address).
+data TemplateSource
+  = LocalTemplateSource FilePath -- ^ template path on local file system
+  | UriTemplateSource URI        -- ^ remote template URI adress
+  deriving (Eq, Show)
+
+
+-- | Reference to the template. Later this reference is used to get and parse
+-- the content of the actual template.
+data TemplateRef = TemplateRef
+  { trFileType :: FileType       -- ^ type of files which this template is for
+  , trSource   :: TemplateSource -- ^ source of the template
+  }
+  deriving (Eq, Show)
+
+
+------------------------------  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
+-- 'UriTemplateSource', otherwise it creates 'LocalTemplateSource'.
+mkTemplateRef :: MonadThrow m
+              => Text          -- ^ input text
+              -> m TemplateRef -- ^ created 'TemplateRef' (or error)
+mkTemplateRef raw = do
+  fileType <- extractFileType
+  source   <- detectSource
+  pure TemplateRef { trFileType = fileType, trSource = source }
+ where
+  exts         = templateExtensions @TemplateType
+  detectSource = case match [re|(^\w+):\/\/|] raw of
+    Just (_ : p : _)
+      | p `elem` ["http", "https"] -> UriTemplateSource <$> mkURI raw
+      | otherwise                  -> throwM $ UnsupportedUriProtocol p raw
+    _ -> pure . LocalTemplateSource . T.unpack $ raw
+  extractFileType = case match [re|(\w+)\.(\w+)$|] raw of
+    Just (_ : (textToEnum -> (Just ft )) : e : _) | e `elem` exts -> pure ft
+    _ -> throwM $ UnrecognizedTemplateName raw
+
+
+---------------------------------  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 (Eq, Show)
+
+
+instance Exception TemplateRefError where
+  displayException = displayException'
+  toException      = toHeadroomError
+  fromException    = fromHeadroomError
+
+
+displayException' :: TemplateRefError -> String
+displayException' = \case
+  UnrecognizedTemplateName 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 protocol raw -> [iii|
+      Protocol '#{protocol}' of in URI '#{raw}' is not supported. Make sure that
+      you use either HTTP or HTTPS URIs.
+    |]

test/Headroom/Template/MustacheSpec.hs

@@ -2,6 +2,7 @@
 {-# LANGUAGE OverloadedStrings   #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications    #-}
+
 module Headroom.Template.MustacheSpec
   ( spec
   )

test/Headroom/Template/TemplateRefSpec.hs

@@ -0,0 +1,44 @@
+{-# LANGUAGE LambdaCase        #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes       #-}
+
+module Headroom.Template.TemplateRefSpec
+  ( spec
+  )
+where
+
+
+import           Headroom.FileType.Types             ( FileType(..) )
+import           Headroom.Template.TemplateRef
+import           RIO
+import           Test.Hspec
+import           Text.URI.QQ                         ( uri )
+
+
+spec :: Spec
+spec = do
+
+  describe "mkTemplateRef" $ do
+    it "creates valid reference to local Haskell template" $ do
+      let raw      = "/path/to/some/haskell.mustache"
+          expected = TemplateRef
+            { trFileType = Haskell
+            , trSource   = LocalTemplateSource "/path/to/some/haskell.mustache"
+            }
+      mkTemplateRef raw `shouldBe` Just expected
+
+    it "creates valid reference to HTTP Haskell template" $ do
+      let raw      = "http://foo/haskell.mustache"
+          expected = TemplateRef
+            { trFileType = Haskell
+            , trSource   = UriTemplateSource [uri|http://foo/haskell.mustache|]
+            }
+      mkTemplateRef raw `shouldBe` Just expected
+
+    it "throws error if URI is valid but protocol is not supported" $ do
+      let raw = "foo://foo/haskell.mustache"
+      mkTemplateRef raw `shouldThrow` \case
+        (UnsupportedUriProtocol _ _) -> True
+        _                            -> False
+