[#66] Simplify TemplateRef

vaclavsvejcar · Apr 8, 2021 · 583afa8 · 583afa8
1 parent 67608d9
commit 583afa8
Show file tree

Hide file tree

Showing 2 changed files with 45 additions and 66 deletions.
diff --git 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
@@ -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