[#367] Add Raw constructor to Source data type (#379)

* [#367] Add `Raw` constructor to `Source` data type Resolves #367 * Remove Link constructor * Add more files to golden tests * Make HLint happy
kowainik · Nov 6, 2019 · 74c5c29 · 74c5c29
1 parent 4336de7
commit 74c5c29
Show file tree

Hide file tree

Showing 6 changed files with 32 additions and 25 deletions.
diff --git a/README.md b/README.md
@@ -363,7 +363,7 @@ Here is the list of the options that can be configured to suit your needs. If op
 | `ghc-options`    | [Text]  | List of the default GHC options to add into `ghc-options` section in the `.cabal`.                                                                                   |
 | `stylish.*`      | Text    | **DEPRECATED** `stylish.file` to provide the absolute file path OR `stylish.url` to download the `.stylish-haskell.yaml` file to use in the project.                                |
 | `contributing.*` | Text    | **DEPRECATED** `contributing.file` to provide the absolute file path OR `contributing.url` download OR `contribuint.link` to link the `CONTRIBUTING.md` file to use in the project. |
-| `files`          | Map FilePath Source  | Custom mapping of files to their sources. Represented as a list of inline tables in TOML in a format like `files = [ { path = "foo", url = "https://..." }, ... ]` |
+| `files`          | Map FilePath Source  | Custom mapping of files to their sources. Represented as a list of inline tables in TOML in a format like `files = [ { path = "foo", url = "https://..." }, ... ]`. Supported file types: `url`, `file`, `raw`. |
 |`[prelude]`       |         |                                                                                                                                                                      |
 | `package`        | Text    | The package name of the custom prelude you'd like to use in the project (doesn't work without `module` field).                                                       |
 | `module`         | Text    | The module name of the custom prelude you'd like to use in the project (doesn't work without `package` field).                                                       |

diff --git a/summoner-cli/CHANGELOG.md b/summoner-cli/CHANGELOG.md
@@ -60,12 +60,17 @@ The changelog is available [on GitHub][2].
 * [#360](https://github.com/kowainik/summoner/issues/360):
   Use mixins with `base` and `relude`. Drop `base-noprelude` trick.
 * [#373](https://github.com/kowainik/summoner/issues/373):
-  Bump up to `tomldnd-1.2.1.0`.
+  Bump up to `tomland-1.2.1.0`.
 * Bump up to `relude-0.6.0.0`.
 * [#374](https://github.com/kowainik/summoner/issues/374):
   Remove `warnings` field in TOML file which was deprecated in the previous release.
 
   _Migration guide:_ Rename `warnings` field to `ghc-options` instead.
+* [#367](https://github.com/kowainik/summoner/issues/367):
+  Add `raw` type of custom extra files. Remove `link` type of file.
+
+  _Migration guide:_ Replace `link` with `raw` and specify any custom text you
+  want.
 
 ## 1.3.0.1 — Apr 10, 2019
 

diff --git a/summoner-cli/src/Summoner/Source.hs b/summoner-cli/src/Summoner/Source.hs
@@ -1,5 +1,3 @@
-{-# LANGUAGE QuasiQuotes #-}
-
 module Summoner.Source
        ( Source (..)
        , sourceT
@@ -9,7 +7,6 @@ module Summoner.Source
 
 import Control.Arrow ((>>>))
 import Control.Exception (catch)
-import NeatInterpolation (text)
 import System.Process (readProcess)
 import Toml (Key, TomlBiMap, TomlBiMapError (..), TomlCodec)
 
@@ -20,19 +17,25 @@ import qualified Toml
 
 -- | Type of the source resource.
 data Source
-    -- | URL link to the source file.
+    {- | URL link to the source file. Such files will be downloaded by URL. But
+    they are ingored in the @offline@ mode.
+    -}
     = Url !Text
-    -- | File path to the local source file.
+
+    {- | File path to the local source file.
+    -}
     | File !FilePath
-    -- | Link to external file.
-    | Link !Text
+
+    {- | Raw file text content.
+    -}
+    | Raw !Text
     deriving stock (Show, Eq)
 
 showSource :: Source -> Text
 showSource = \case
-    Url _  -> "Url"
+    Url  _ -> "Url"
     File _ -> "File"
-    Link _ -> "Link"
+    Raw  _ -> "Raw"
 
 -- TODO: return Maybe
 matchUrl :: Source -> Either TomlBiMapError Text
@@ -45,24 +48,24 @@ matchFile (File file) = Right file
 matchFile e           = Left $ WrongConstructor "File" $ showSource e
 
 -- TODO: return Maybe
-matchLink :: Source -> Either TomlBiMapError Text
-matchLink (Link link) = Right link
-matchLink e           = Left $ WrongConstructor "Link" $ showSource e
+matchRaw :: Source -> Either TomlBiMapError Text
+matchRaw (Raw raw) = Right raw
+matchRaw e         = Left $ WrongConstructor "Raw" $ showSource e
 
 -- DEPRECATED: To be removed in 2.0
 sourceT :: Key -> TomlCodec Source
 sourceT nm = Toml.match (_Url  >>> Toml._Text)   (nm <> "url")
          <|> Toml.match (_File >>> Toml._String) (nm <> "file")
-         <|> Toml.match (_Link >>> Toml._Text)   (nm <> "link")
+         <|> Toml.match (_Raw  >>> Toml._Text)   (nm <> "raw")
   where
     _Url :: TomlBiMap Source Text
     _Url = Toml.prism Url matchUrl
 
     _File :: TomlBiMap Source FilePath
     _File = Toml.prism File matchFile
 
-    _Link :: TomlBiMap Source Text
-    _Link = Toml.prism Link matchLink
+    _Raw :: TomlBiMap Source Text
+    _Raw = Toml.prism Raw matchRaw
 
 {- | This 'TomlCodec' is used in the @files@ field of config. It decodes
 corresponding constructor from the top-level key.
@@ -71,16 +74,16 @@ sourceCodec :: TomlCodec Source
 sourceCodec = asum
     [ Toml.dimatch (rightToMaybe . matchUrl) Url (Toml.text "url")
     , Toml.dimatch (rightToMaybe . matchFile) File (Toml.string "file")
-    , Toml.dimatch (rightToMaybe . matchLink) Link (Toml.text "link")
+    , Toml.dimatch (rightToMaybe . matchRaw) Raw (Toml.text "raw")
     ]
 
 fetchSource :: Bool -> Source -> IO (Maybe Text)
 fetchSource isOffline = \case
     File path -> catch (Just <$> readFileText path) (fileError path)
-    Url url   -> if isOffline
+    Url url -> if isOffline
         then Nothing <$ infoMessage ("Ignoring fetching from URL in offline mode from source: " <> url)
         else fetchUrl url `catch` urlError url
-    Link link -> putLink link
+    Raw raw -> pure $ Just raw
   where
     fileError :: FilePath -> SomeException -> IO (Maybe Text)
     fileError path _ = errorMessage ("Couldn't read file: " <> toText path)
@@ -92,6 +95,3 @@ fetchSource isOffline = \case
 
     fetchUrl :: Text -> IO (Maybe Text)
     fetchUrl url = Just . toText <$> readProcess "curl" [toString url] ""
-
-    putLink :: Text -> IO (Maybe Text)
-    putLink link = pure $ Just [text|See full content of the file [here]($link)|]
diff --git a/summoner-cli/test/Test/Golden.hs b/summoner-cli/test/Test/Golden.hs
@@ -92,7 +92,8 @@ fullProject = Settings
     , settingsContributing   = Just "This is contributing guide\n"
     , settingsNoUpload       = True
     , settingsFiles          =
-        [ File "extra.txt" [text|See full content of the file [here](@github)|]
+        [ File "extra.txt" "See full content of the file [here](@github)\n"
+        , Dir ".github" [File "CODEOWNERS" "*  @chshersh @vrom911\n"]
         ]
     }
   where

diff --git a/summoner-cli/test/Test/TomlSpec.hs b/summoner-cli/test/Test/TomlSpec.hs
@@ -59,7 +59,7 @@ genLicense = Gen.element universe
 genSource :: MonadGen m => m Source
 genSource = do
     txt <- genText
-    s   <- Gen.element [File . toString, Url, Link]
+    s   <- Gen.element [File . toString, Url, Raw]
     pure $ s txt
 
 genPartialConfig :: MonadGen m => m PartialConfig

diff --git a/summoner-cli/test/golden/fullProject/.github/CODEOWNERS b/summoner-cli/test/golden/fullProject/.github/CODEOWNERS
@@ -0,0 +1 @@
+*  @chshersh @vrom911