------------------------------------------------------------------------------
-- |
-- Module      : LiterateX.Types.TargetFormat
-- Description : target format type
-- Copyright   : Copyright (c) 2021 Travis Cardwell
-- License     : MIT
------------------------------------------------------------------------------

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}

module LiterateX.Types.TargetFormat
  ( -- * Type
    TargetFormat(..)
    -- * API
  , describe
  , list
  , mkEndCode
  , mkBeginCode
  ) where

-- https://hackage.haskell.org/package/text
import qualified Data.Text as T
import Data.Text (Text)

-- https://hackage.haskell.org/package/ttc
import qualified Data.TTC as TTC

-- (literatex)
import LiterateX.Types.CodeLanguage (CodeLanguage)

------------------------------------------------------------------------------
-- $Type

-- | Target format
--
-- This sum type defines the supported target formats.
--
-- @since 0.0.1.0
data TargetFormat
  = PandocMarkdown
  | GitHubFlavoredMarkdown
  deriving (TargetFormat
TargetFormat -> TargetFormat -> Bounded TargetFormat
forall a. a -> a -> Bounded a
maxBound :: TargetFormat
$cmaxBound :: TargetFormat
minBound :: TargetFormat
$cminBound :: TargetFormat
Bounded, Int -> TargetFormat
TargetFormat -> Int
TargetFormat -> [TargetFormat]
TargetFormat -> TargetFormat
TargetFormat -> TargetFormat -> [TargetFormat]
TargetFormat -> TargetFormat -> TargetFormat -> [TargetFormat]
(TargetFormat -> TargetFormat)
-> (TargetFormat -> TargetFormat)
-> (Int -> TargetFormat)
-> (TargetFormat -> Int)
-> (TargetFormat -> [TargetFormat])
-> (TargetFormat -> TargetFormat -> [TargetFormat])
-> (TargetFormat -> TargetFormat -> [TargetFormat])
-> (TargetFormat -> TargetFormat -> TargetFormat -> [TargetFormat])
-> Enum TargetFormat
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: TargetFormat -> TargetFormat -> TargetFormat -> [TargetFormat]
$cenumFromThenTo :: TargetFormat -> TargetFormat -> TargetFormat -> [TargetFormat]
enumFromTo :: TargetFormat -> TargetFormat -> [TargetFormat]
$cenumFromTo :: TargetFormat -> TargetFormat -> [TargetFormat]
enumFromThen :: TargetFormat -> TargetFormat -> [TargetFormat]
$cenumFromThen :: TargetFormat -> TargetFormat -> [TargetFormat]
enumFrom :: TargetFormat -> [TargetFormat]
$cenumFrom :: TargetFormat -> [TargetFormat]
fromEnum :: TargetFormat -> Int
$cfromEnum :: TargetFormat -> Int
toEnum :: Int -> TargetFormat
$ctoEnum :: Int -> TargetFormat
pred :: TargetFormat -> TargetFormat
$cpred :: TargetFormat -> TargetFormat
succ :: TargetFormat -> TargetFormat
$csucc :: TargetFormat -> TargetFormat
Enum, TargetFormat -> TargetFormat -> Bool
(TargetFormat -> TargetFormat -> Bool)
-> (TargetFormat -> TargetFormat -> Bool) -> Eq TargetFormat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TargetFormat -> TargetFormat -> Bool
$c/= :: TargetFormat -> TargetFormat -> Bool
== :: TargetFormat -> TargetFormat -> Bool
$c== :: TargetFormat -> TargetFormat -> Bool
Eq, Eq TargetFormat
Eq TargetFormat
-> (TargetFormat -> TargetFormat -> Ordering)
-> (TargetFormat -> TargetFormat -> Bool)
-> (TargetFormat -> TargetFormat -> Bool)
-> (TargetFormat -> TargetFormat -> Bool)
-> (TargetFormat -> TargetFormat -> Bool)
-> (TargetFormat -> TargetFormat -> TargetFormat)
-> (TargetFormat -> TargetFormat -> TargetFormat)
-> Ord TargetFormat
TargetFormat -> TargetFormat -> Bool
TargetFormat -> TargetFormat -> Ordering
TargetFormat -> TargetFormat -> TargetFormat
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TargetFormat -> TargetFormat -> TargetFormat
$cmin :: TargetFormat -> TargetFormat -> TargetFormat
max :: TargetFormat -> TargetFormat -> TargetFormat
$cmax :: TargetFormat -> TargetFormat -> TargetFormat
>= :: TargetFormat -> TargetFormat -> Bool
$c>= :: TargetFormat -> TargetFormat -> Bool
> :: TargetFormat -> TargetFormat -> Bool
$c> :: TargetFormat -> TargetFormat -> Bool
<= :: TargetFormat -> TargetFormat -> Bool
$c<= :: TargetFormat -> TargetFormat -> Bool
< :: TargetFormat -> TargetFormat -> Bool
$c< :: TargetFormat -> TargetFormat -> Bool
compare :: TargetFormat -> TargetFormat -> Ordering
$ccompare :: TargetFormat -> TargetFormat -> Ordering
$cp1Ord :: Eq TargetFormat
Ord, Int -> TargetFormat -> ShowS
[TargetFormat] -> ShowS
TargetFormat -> String
(Int -> TargetFormat -> ShowS)
-> (TargetFormat -> String)
-> ([TargetFormat] -> ShowS)
-> Show TargetFormat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TargetFormat] -> ShowS
$cshowList :: [TargetFormat] -> ShowS
show :: TargetFormat -> String
$cshow :: TargetFormat -> String
showsPrec :: Int -> TargetFormat -> ShowS
$cshowsPrec :: Int -> TargetFormat -> ShowS
Show)

instance TTC.Parse TargetFormat where
  parse :: t -> Either e TargetFormat
parse = String -> Bool -> Bool -> t -> Either e TargetFormat
forall a t e.
(Bounded a, Enum a, Render a, Textual t, Textual e) =>
String -> Bool -> Bool -> t -> Either e a
TTC.parseEnum' String
"target format" Bool
True Bool
False

instance TTC.Render TargetFormat where
  render :: TargetFormat -> t
render = String -> t
forall t. Textual t => String -> t
TTC.fromS (String -> t) -> (TargetFormat -> String) -> TargetFormat -> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
    TargetFormat
PandocMarkdown         -> String
"pandoc"
    TargetFormat
GitHubFlavoredMarkdown -> String
"github"

------------------------------------------------------------------------------
-- $API

-- | Get a description of a target format
--
-- @since 0.0.1.0
describe :: TargetFormat -> String
describe :: TargetFormat -> String
describe = \case
    TargetFormat
PandocMarkdown         -> String
"Pandoc Markdown"
    TargetFormat
GitHubFlavoredMarkdown -> String
"GitHub Flavored Markdown"

------------------------------------------------------------------------------

-- | List of all supported target formats
--
-- @since 0.0.1.0
list :: [TargetFormat]
list :: [TargetFormat]
list = [TargetFormat
forall a. Bounded a => a
minBound ..]

------------------------------------------------------------------------------

-- | Make line in the target format to end a block of source code
--
-- @since 0.0.1.0
mkEndCode
  :: TargetFormat
  -> Text
mkEndCode :: TargetFormat -> Text
mkEndCode TargetFormat
_anyFormat = Text
"```"

------------------------------------------------------------------------------

-- | Make line in the target format to begin a block of code
--
-- Note that this function is written to indicate how it is used.  Given the
-- target format, optional code language, and line numbering flag, this
-- function returns a function that takes a line number and returns a line.
--
-- @since 0.0.1.0
mkBeginCode
  :: TargetFormat
  -> Maybe CodeLanguage
  -> Bool           -- ^ 'True' to number code lines
  -> (Int -> Text)  -- ^ make line for code starting at specified line number
mkBeginCode :: TargetFormat -> Maybe CodeLanguage -> Bool -> Int -> Text
mkBeginCode TargetFormat
PandocMarkdown (Just CodeLanguage
lang) Bool
True = \Int
lineNum -> [Text] -> Text
T.concat
    [ Text
"``` {.", CodeLanguage -> Text
forall a t. (Render a, Textual t) => a -> t
TTC.render CodeLanguage
lang, Text
" .numberSource startFrom=\""
    , Int -> Text
forall a t. (Show a, Textual t) => a -> t
TTC.renderWithShow Int
lineNum, Text
"\"}"
    ]
mkBeginCode TargetFormat
GitHubFlavoredMarkdown (Just CodeLanguage
lang) Bool
True = \Int
lineNum -> [Text] -> Text
T.concat
    [ Text
"``` ", CodeLanguage -> Text
forall a t. (Render a, Textual t) => a -> t
TTC.render CodeLanguage
lang, Text
" startline=", Int -> Text
forall a t. (Show a, Textual t) => a -> t
TTC.renderWithShow Int
lineNum
    ]
mkBeginCode TargetFormat
PandocMarkdown (Just CodeLanguage
lang) Bool
False = Text -> Int -> Text
forall a b. a -> b -> a
const (Text -> Int -> Text) -> Text -> Int -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat
    [ Text
"```", CodeLanguage -> Text
forall a t. (Render a, Textual t) => a -> t
TTC.render CodeLanguage
lang
    ]
mkBeginCode TargetFormat
GitHubFlavoredMarkdown (Just CodeLanguage
lang) Bool
False = Text -> Int -> Text
forall a b. a -> b -> a
const (Text -> Int -> Text) -> Text -> Int -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat
    [ Text
"``` ", CodeLanguage -> Text
forall a t. (Render a, Textual t) => a -> t
TTC.render CodeLanguage
lang
    ]
mkBeginCode TargetFormat
PandocMarkdown Maybe CodeLanguage
Nothing Bool
True = \Int
lineNum -> [Text] -> Text
T.concat
    [ Text
"``` {.numberSource startFrom=\"", Int -> Text
forall a t. (Show a, Textual t) => a -> t
TTC.renderWithShow Int
lineNum, Text
"\"}"
    ]
mkBeginCode TargetFormat
GitHubFlavoredMarkdown Maybe CodeLanguage
Nothing Bool
True = \Int
lineNum -> [Text] -> Text
T.concat
    [ Text
"``` startline=", Int -> Text
forall a t. (Show a, Textual t) => a -> t
TTC.renderWithShow Int
lineNum
    ]
mkBeginCode TargetFormat
_anyFormat Maybe CodeLanguage
Nothing Bool
False = Text -> Int -> Text
forall a b. a -> b -> a
const Text
"```"