diff --git a/src/Headroom/Template/TemplateRef.hs b/src/Headroom/Template/TemplateRef.hs index 90707d6..26b1413 100644 --- a/src/Headroom/Template/TemplateRef.hs +++ b/src/Headroom/Template/TemplateRef.hs @@ -1,12 +1,14 @@ -{-# LANGUAGE AllowAmbiguousTypes #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE QuasiQuotes #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE StrictData #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StrictData #-} +{-# LANGUAGE TypeApplications #-} {-| Module : Headroom.Template.TemplateRef @@ -23,8 +25,7 @@ remote, which can be later opened/downloaded and parsed into template. module Headroom.Template.TemplateRef ( -- * Data Types - TemplateSource(..) - , TemplateRef(..) + TemplateRef(..) -- * Constructor Functions , mkTemplateRef -- * Error Types @@ -33,12 +34,9 @@ module Headroom.Template.TemplateRef where import Data.String.Interpolate ( iii ) -import Headroom.Data.EnumExtra ( textToEnum ) import Headroom.Data.Regex ( match , re ) -import Headroom.FileType.Types ( FileType ) -import Headroom.Template ( Template(..) ) import Headroom.Types ( fromHeadroomError , toHeadroomError ) @@ -51,55 +49,31 @@ import Text.URI ( URI(..) --------------------------------- 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) +-- | Reference to the template (e.g. local file, URI address). +data TemplateRef + = LocalTemplateRef FilePath -- ^ template path on local file system + | UriTemplateRef URI -- ^ remote template URI adress + deriving (Eq, Ord, 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'. +-- 'UriTemplateRef', otherwise it creates 'LocalTemplateRef'. -- --- >>> :set -XTypeApplications --- >>> import Headroom.Template.Mustache (Mustache) --- >>> mkTemplateRef @Mustache "/path/to/haskell.mustache" :: Maybe TemplateRef --- Just (TemplateRef {trFileType = Haskell, trSource = LocalTemplateSource "/path/to/haskell.mustache"}) +-- >>> mkTemplateRef "/path/to/haskell.mustache" :: Maybe TemplateRef +-- Just (LocalTemplateRef "/path/to/haskell.mustache") -- --- >>> :set -XTypeApplications --- >>> import Headroom.Template.Mustache (Mustache) --- >>> mkTemplateRef @Mustache "https://foo.bar/haskell.mustache" :: Maybe TemplateRef --- Just (TemplateRef {trFileType = Haskell, trSource = UriTemplateSource (URI {uriScheme = Just "https", uriAuthority = Right (Authority {authUserInfo = Nothing, authHost = "foo.bar", authPort = Nothing}), uriPath = Just (False,"haskell.mustache" :| []), uriQuery = [], uriFragment = Nothing})}) -mkTemplateRef :: forall a m - . (Template a, MonadThrow m) +-- >>> 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 raw = do - fileType <- extractFileType - source <- detectSource - pure TemplateRef { trFileType = fileType, trSource = source } - where - exts = templateExtensions @a - 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 +mkTemplateRef raw = case match [re|(^\w+):\/\/|] raw of + Just (_ : p : _) | p `elem` ["http", "https"] -> UriTemplateRef <$> mkURI raw + | otherwise -> throwM $ UnsupportedUriProtocol p raw + _ -> pure . LocalTemplateRef . T.unpack $ raw --------------------------------- ERROR TYPES -------------------------------- diff --git a/test/Headroom/Template/TemplateRefSpec.hs b/test/Headroom/Template/TemplateRefSpec.hs index c86a956..c6f0f3e 100644 --- a/test/Headroom/Template/TemplateRefSpec.hs +++ b/test/Headroom/Template/TemplateRefSpec.hs @@ -10,10 +10,9 @@ module Headroom.Template.TemplateRefSpec where -import Headroom.FileType.Types ( FileType(..) ) -import Headroom.Template.Mustache ( Mustache ) import Headroom.Template.TemplateRef import RIO +import qualified RIO.List as L import Test.Hspec import Text.URI.QQ ( uri ) @@ -24,23 +23,29 @@ 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 @Mustache raw `shouldBe` Just expected + expected = LocalTemplateRef "/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 @Mustache raw `shouldBe` Just expected + expected = UriTemplateRef [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 @Mustache raw `shouldThrow` \case + mkTemplateRef raw `shouldThrow` \case (UnsupportedUriProtocol _ _) -> True _ -> False + + describe "Ord instance for TemplateRef" $ do + it "should properly order records" $ do + let sample = + [ UriTemplateRef [uri|http://foo/haskell.mustache|] + , LocalTemplateRef "/path/to/some/haskell.mustache" + ] + expected = + [ LocalTemplateRef "/path/to/some/haskell.mustache" + , UriTemplateRef [uri|http://foo/haskell.mustache|] + ] + L.sort sample `shouldBe` expected