------------------------------------------------------------------------------
-- |
-- Module      : LiterateX.SourceDefaults
-- Description : default options by source extension
-- Copyright   : Copyright (c) 2021 Travis Cardwell
-- License     : MIT
--
-- This module provides some default options for various sources.
------------------------------------------------------------------------------

module LiterateX.SourceDefaults
  ( -- * API
    defaultsFor
  , extensionDefaults
  ) where

-- https://hackage.haskell.org/package/base
import Data.List (find, isSuffixOf)

-- (literatex)
import LiterateX.Types (CodeLanguage, SourceFormat)
import qualified LiterateX.Types.SourceFormat as SourceFormat

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

-- | Get the default source format and code language for the given filename
--
-- @since 0.0.1.0
defaultsFor :: FilePath -> Maybe (SourceFormat, CodeLanguage)
defaultsFor :: FilePath -> Maybe (SourceFormat, CodeLanguage)
defaultsFor FilePath
path =
  ((FilePath, (SourceFormat, CodeLanguage))
 -> (SourceFormat, CodeLanguage))
-> Maybe (FilePath, (SourceFormat, CodeLanguage))
-> Maybe (SourceFormat, CodeLanguage)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FilePath, (SourceFormat, CodeLanguage))
-> (SourceFormat, CodeLanguage)
forall a b. (a, b) -> b
snd (Maybe (FilePath, (SourceFormat, CodeLanguage))
 -> Maybe (SourceFormat, CodeLanguage))
-> (((FilePath, (SourceFormat, CodeLanguage)) -> Bool)
    -> Maybe (FilePath, (SourceFormat, CodeLanguage)))
-> ((FilePath, (SourceFormat, CodeLanguage)) -> Bool)
-> Maybe (SourceFormat, CodeLanguage)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((FilePath, (SourceFormat, CodeLanguage)) -> Bool)
 -> [(FilePath, (SourceFormat, CodeLanguage))]
 -> Maybe (FilePath, (SourceFormat, CodeLanguage)))
-> [(FilePath, (SourceFormat, CodeLanguage))]
-> ((FilePath, (SourceFormat, CodeLanguage)) -> Bool)
-> Maybe (FilePath, (SourceFormat, CodeLanguage))
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((FilePath, (SourceFormat, CodeLanguage)) -> Bool)
-> [(FilePath, (SourceFormat, CodeLanguage))]
-> Maybe (FilePath, (SourceFormat, CodeLanguage))
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find [(FilePath, (SourceFormat, CodeLanguage))]
extensionDefaults (((FilePath, (SourceFormat, CodeLanguage)) -> Bool)
 -> Maybe (SourceFormat, CodeLanguage))
-> ((FilePath, (SourceFormat, CodeLanguage)) -> Bool)
-> Maybe (SourceFormat, CodeLanguage)
forall a b. (a -> b) -> a -> b
$ (FilePath -> FilePath -> Bool) -> FilePath -> FilePath -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isSuffixOf FilePath
path (FilePath -> Bool)
-> ((FilePath, (SourceFormat, CodeLanguage)) -> FilePath)
-> (FilePath, (SourceFormat, CodeLanguage))
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath, (SourceFormat, CodeLanguage)) -> FilePath
forall a b. (a, b) -> a
fst

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

-- | List of default options for various filename extensions
--
-- @since 0.0.1.0
extensionDefaults :: [(String, (SourceFormat, CodeLanguage))]
extensionDefaults :: [(FilePath, (SourceFormat, CodeLanguage))]
extensionDefaults =
    [ (FilePath
".c",    (SourceFormat
SourceFormat.DoubleSlash,     CodeLanguage
"c"))
    , (FilePath
".clj",  (SourceFormat
SourceFormat.LispSemicolons,  CodeLanguage
"clojure"))
    , (FilePath
".css",  (SourceFormat
SourceFormat.DoubleSlash,     CodeLanguage
"css"))
    , (FilePath
".elm",  (SourceFormat
SourceFormat.DoubleDash,      CodeLanguage
"elm"))
    , (FilePath
".erl",  (SourceFormat
SourceFormat.Percent,         CodeLanguage
"erlang"))
    , (FilePath
".ex",   (SourceFormat
SourceFormat.Hash,            CodeLanguage
"elixir"))
    , (FilePath
".exs",  (SourceFormat
SourceFormat.Hash,            CodeLanguage
"elixir"))
    , (FilePath
".go",   (SourceFormat
SourceFormat.DoubleSlash,     CodeLanguage
"go"))
    , (FilePath
".hs",   (SourceFormat
SourceFormat.DoubleDash,      CodeLanguage
"haskell"))
    , (FilePath
".idr",  (SourceFormat
SourceFormat.DoubleDash,      CodeLanguage
"idris"))
    , (FilePath
".java", (SourceFormat
SourceFormat.DoubleSlash,     CodeLanguage
"java"))
    , (FilePath
".js",   (SourceFormat
SourceFormat.DoubleSlash,     CodeLanguage
"javascript"))
    , (FilePath
".kt",   (SourceFormat
SourceFormat.DoubleSlash,     CodeLanguage
"kotlin"))
    , (FilePath
".lhs",  (SourceFormat
SourceFormat.LiterateHaskell, CodeLanguage
"haskell"))
    , (FilePath
".lisp", (SourceFormat
SourceFormat.LispSemicolons,  CodeLanguage
"commonlisp"))
    , (FilePath
".lua",  (SourceFormat
SourceFormat.DoubleDash,      CodeLanguage
"lua"))
    , (FilePath
".php",  (SourceFormat
SourceFormat.DoubleSlash,     CodeLanguage
"php"))
    , (FilePath
".pl",   (SourceFormat
SourceFormat.Hash,            CodeLanguage
"perl"))
    , (FilePath
".py",   (SourceFormat
SourceFormat.Hash,            CodeLanguage
"python"))
    , (FilePath
".r",    (SourceFormat
SourceFormat.Hash,            CodeLanguage
"r"))
    , (FilePath
".rb",   (SourceFormat
SourceFormat.Hash,            CodeLanguage
"ruby"))
    , (FilePath
".rkt",  (SourceFormat
SourceFormat.LispSemicolons,  CodeLanguage
"scheme"))
    , (FilePath
".rs",   (SourceFormat
SourceFormat.DoubleSlash,     CodeLanguage
"rust"))
    , (FilePath
".sc",   (SourceFormat
SourceFormat.DoubleSlash,     CodeLanguage
"scala"))
    , (FilePath
".scm",  (SourceFormat
SourceFormat.LispSemicolons,  CodeLanguage
"scheme"))
    , (FilePath
".sh",   (SourceFormat
SourceFormat.Hash,            CodeLanguage
"bash"))
    , (FilePath
".sql",  (SourceFormat
SourceFormat.DoubleDash,      CodeLanguage
"sql"))
    , (FilePath
".tex",  (SourceFormat
SourceFormat.Percent,         CodeLanguage
"latex"))
    , (FilePath
".ts",   (SourceFormat
SourceFormat.DoubleSlash,     CodeLanguage
"typescript"))
    ]