diff --git a/src/Headroom/Command/Readers.hs b/src/Headroom/Command/Readers.hs index da0ebaf..97360a8 100644 --- a/src/Headroom/Command/Readers.hs +++ b/src/Headroom/Command/Readers.hs @@ -19,6 +19,7 @@ module Headroom.Command.Readers ( licenseReader , licenseTypeReader , regexReader + , templateRefReader , parseLicense ) where @@ -30,6 +31,10 @@ import Headroom.Data.Regex ( Regex(..) , compile ) import Headroom.FileType.Types ( FileType(..) ) +import Headroom.Meta ( TemplateType ) +import Headroom.Template.TemplateRef ( TemplateRef(..) + , mkTemplateRef + ) import Options.Applicative import RIO import qualified RIO.Text as T @@ -69,6 +74,14 @@ regexReader = in eitherReader parse +-- | Reader for 'TemplateRef'. +templateRefReader :: ReadM TemplateRef +templateRefReader = + let parse input = mapLeft displayException + (mkTemplateRef @TemplateType . T.pack $ input) + in eitherReader parse + + -- | Parses 'LicenseType' and 'FileType' from the input string, -- formatted as @licenseType:fileType@. -- diff --git a/src/Headroom/Command/Run.hs b/src/Headroom/Command/Run.hs index 229b6d8..be07ca4 100644 --- a/src/Headroom/Command/Run.hs +++ b/src/Headroom/Command/Run.hs @@ -350,7 +350,9 @@ chooseAction info header = do justify = T.justifyLeft 30 ' ' --- | Loads templates using given template references. +-- | Loads templates using given template references. If multiple sources define +-- template for the same 'FileType', then the preferred one (based on ordering +-- of 'TemplateRef' is selected). loadTemplateRefs :: forall a env . ( Template a , Has (Network (RIO env)) env diff --git a/src/Headroom/Template/TemplateRef.hs b/src/Headroom/Template/TemplateRef.hs index 1fb836a..c1940d1 100644 --- a/src/Headroom/Template/TemplateRef.hs +++ b/src/Headroom/Template/TemplateRef.hs @@ -36,12 +36,16 @@ module Headroom.Template.TemplateRef ) where +import Data.Aeson ( FromJSON(..) + , Value(String) + ) 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 @@ -63,6 +67,12 @@ data TemplateRef deriving (Eq, Ord, Show) +instance FromJSON TemplateRef where + parseJSON = \case + String s -> maybe (error $ T.unpack s) pure (mkTemplateRef @TemplateType s) + other -> error $ "Invalid value for template reference: " <> show other + + ------------------------------ PUBLIC FUNCTIONS ------------------------------ -- | Creates a 'TemplateRef' from given text. If the raw text appears to be diff --git a/test/Headroom/Template/TemplateRefSpec.hs b/test/Headroom/Template/TemplateRefSpec.hs index 3034b30..a0bf25f 100644 --- a/test/Headroom/Template/TemplateRefSpec.hs +++ b/test/Headroom/Template/TemplateRefSpec.hs @@ -10,6 +10,7 @@ module Headroom.Template.TemplateRefSpec where +import qualified Data.Aeson as Aeson import Headroom.Template.Mustache ( Mustache ) import Headroom.Template.TemplateRef import RIO @@ -57,6 +58,13 @@ spec = do renderRef sample `shouldBe` expected + describe "FromJSON instance for TemplateRef" $ do + it "deserializes TemplateRef from JSON value" $ do + let sample = "\"http://foo/haskell.mustache\"" + expected = UriTemplateRef [uri|http://foo/haskell.mustache|] + Aeson.decode sample `shouldBe` Just expected + + describe "Ord instance for TemplateRef" $ do it "should properly order records" $ do let sample =