------------------------------------------------------------------------------
-- |
-- Module      : LiterateX.Types.SourceFormat
-- Description : source format type
-- Copyright   : Copyright (c) 2021-2023 Travis Cardwell
-- License     : MIT
------------------------------------------------------------------------------

{-# LANGUAGE LambdaCase #-}

module LiterateX.Types.SourceFormat
  ( -- * Type
    SourceFormat(..)
    -- * API
  , describe
  , list
  ) where

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

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

-- | Source format
--
-- This sum type defines the supported source formats.
--
-- @since 0.0.1.0
data SourceFormat
  = DoubleDash       -- ^ \-- comments
  | DoubleSlash      -- ^ // comments
  | Hash             -- ^ # comments
  | LispSemicolons   -- ^ Lisp semicolon comments
  | LiterateHaskell  -- ^ literate Haskell
  | Percent          -- ^ % comments
  deriving (SourceFormat
forall a. a -> a -> Bounded a
maxBound :: SourceFormat
$cmaxBound :: SourceFormat
minBound :: SourceFormat
$cminBound :: SourceFormat
Bounded, Int -> SourceFormat
SourceFormat -> Int
SourceFormat -> [SourceFormat]
SourceFormat -> SourceFormat
SourceFormat -> SourceFormat -> [SourceFormat]
SourceFormat -> SourceFormat -> SourceFormat -> [SourceFormat]
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 :: SourceFormat -> SourceFormat -> SourceFormat -> [SourceFormat]
$cenumFromThenTo :: SourceFormat -> SourceFormat -> SourceFormat -> [SourceFormat]
enumFromTo :: SourceFormat -> SourceFormat -> [SourceFormat]
$cenumFromTo :: SourceFormat -> SourceFormat -> [SourceFormat]
enumFromThen :: SourceFormat -> SourceFormat -> [SourceFormat]
$cenumFromThen :: SourceFormat -> SourceFormat -> [SourceFormat]
enumFrom :: SourceFormat -> [SourceFormat]
$cenumFrom :: SourceFormat -> [SourceFormat]
fromEnum :: SourceFormat -> Int
$cfromEnum :: SourceFormat -> Int
toEnum :: Int -> SourceFormat
$ctoEnum :: Int -> SourceFormat
pred :: SourceFormat -> SourceFormat
$cpred :: SourceFormat -> SourceFormat
succ :: SourceFormat -> SourceFormat
$csucc :: SourceFormat -> SourceFormat
Enum, SourceFormat -> SourceFormat -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SourceFormat -> SourceFormat -> Bool
$c/= :: SourceFormat -> SourceFormat -> Bool
== :: SourceFormat -> SourceFormat -> Bool
$c== :: SourceFormat -> SourceFormat -> Bool
Eq, Eq SourceFormat
SourceFormat -> SourceFormat -> Bool
SourceFormat -> SourceFormat -> Ordering
SourceFormat -> SourceFormat -> SourceFormat
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 :: SourceFormat -> SourceFormat -> SourceFormat
$cmin :: SourceFormat -> SourceFormat -> SourceFormat
max :: SourceFormat -> SourceFormat -> SourceFormat
$cmax :: SourceFormat -> SourceFormat -> SourceFormat
>= :: SourceFormat -> SourceFormat -> Bool
$c>= :: SourceFormat -> SourceFormat -> Bool
> :: SourceFormat -> SourceFormat -> Bool
$c> :: SourceFormat -> SourceFormat -> Bool
<= :: SourceFormat -> SourceFormat -> Bool
$c<= :: SourceFormat -> SourceFormat -> Bool
< :: SourceFormat -> SourceFormat -> Bool
$c< :: SourceFormat -> SourceFormat -> Bool
compare :: SourceFormat -> SourceFormat -> Ordering
$ccompare :: SourceFormat -> SourceFormat -> Ordering
Ord, Int -> SourceFormat -> ShowS
[SourceFormat] -> ShowS
SourceFormat -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [SourceFormat] -> ShowS
$cshowList :: [SourceFormat] -> ShowS
show :: SourceFormat -> [Char]
$cshow :: SourceFormat -> [Char]
showsPrec :: Int -> SourceFormat -> ShowS
$cshowsPrec :: Int -> SourceFormat -> ShowS
Show)

instance TTC.Parse SourceFormat where
  parse :: forall t e. (Textual t, Textual e) => t -> Either e SourceFormat
parse = forall a t e.
(Bounded a, Enum a, Render a, Textual t, Textual e) =>
[Char] -> Bool -> Bool -> t -> Either e a
TTC.parseEnum' [Char]
"source format" Bool
True Bool
False

instance TTC.Render SourceFormat where
  render :: forall t. Textual t => SourceFormat -> t
render = forall t. Textual t => [Char] -> t
TTC.fromS forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
    SourceFormat
DoubleDash      -> [Char]
"ddash"
    SourceFormat
DoubleSlash     -> [Char]
"dslash"
    SourceFormat
Hash            -> [Char]
"hash"
    SourceFormat
LispSemicolons  -> [Char]
"lisp"
    SourceFormat
LiterateHaskell -> [Char]
"lhs"
    SourceFormat
Percent         -> [Char]
"percent"

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

-- | Get a description of a source format
--
-- @since 0.0.1.0
describe :: SourceFormat -> String
describe :: SourceFormat -> [Char]
describe = \case
    SourceFormat
DoubleDash      -> [Char]
"-- comments"
    SourceFormat
DoubleSlash     -> [Char]
"// comments"
    SourceFormat
Hash            -> [Char]
"# comments"
    SourceFormat
LispSemicolons  -> [Char]
"Lisp semicolon comments"
    SourceFormat
LiterateHaskell -> [Char]
"literate Haskell"
    SourceFormat
Percent         -> [Char]
"% comments"

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

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