{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

module Defaults
  ( getDefaults,
    Defaults (..),
    dName,
    dHomePage,
  )
where

import Data.Maybe (fromJust)
import Data.Text (Text, pack, unpack)
import Data.Time (LocalTime (localDay), getCurrentTime, getCurrentTimeZone, utcToLocalTime)
import Data.Time.Calendar (Year)
import Data.Time.Calendar.OrdinalDate (toOrdinalDate)
import qualified Git (config)
import Network.URI (URI (uriPath), parseURI)
import System.Directory.Extra (getCurrentDirectory)
import System.FilePath (dropExtension, takeBaseName)

data Defaults = Defaults
  { Defaults -> URI
dOrigin :: URI,
    Defaults -> Text
dAuthor :: Text,
    Defaults -> Text
dMaintainer :: Text,
    Defaults -> FilePath
dPath :: FilePath,
    Defaults -> Year
dYear :: Year
  }
  deriving (Int -> Defaults -> ShowS
[Defaults] -> ShowS
Defaults -> FilePath
(Int -> Defaults -> ShowS)
-> (Defaults -> FilePath) -> ([Defaults] -> ShowS) -> Show Defaults
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Defaults -> ShowS
showsPrec :: Int -> Defaults -> ShowS
$cshow :: Defaults -> FilePath
show :: Defaults -> FilePath
$cshowList :: [Defaults] -> ShowS
showList :: [Defaults] -> ShowS
Show, Defaults -> Defaults -> Bool
(Defaults -> Defaults -> Bool)
-> (Defaults -> Defaults -> Bool) -> Eq Defaults
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Defaults -> Defaults -> Bool
== :: Defaults -> Defaults -> Bool
$c/= :: Defaults -> Defaults -> Bool
/= :: Defaults -> Defaults -> Bool
Eq)

dName :: Defaults -> Text
dName :: Defaults -> Text
dName Defaults {Year
FilePath
Text
URI
dOrigin :: Defaults -> URI
dAuthor :: Defaults -> Text
dMaintainer :: Defaults -> Text
dPath :: Defaults -> FilePath
dYear :: Defaults -> Year
dOrigin :: URI
dAuthor :: Text
dMaintainer :: Text
dPath :: FilePath
dYear :: Year
..} = FilePath -> Text
pack (FilePath -> Text) -> (URI -> FilePath) -> URI -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
takeBaseName ShowS -> (URI -> FilePath) -> URI -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URI -> FilePath
uriPath (URI -> Text) -> URI -> Text
forall a b. (a -> b) -> a -> b
$ URI
dOrigin

dHomePage :: Defaults -> URI
dHomePage :: Defaults -> URI
dHomePage Defaults {Year
FilePath
Text
URI
dOrigin :: Defaults -> URI
dAuthor :: Defaults -> Text
dMaintainer :: Defaults -> Text
dPath :: Defaults -> FilePath
dYear :: Defaults -> Year
dOrigin :: URI
dAuthor :: Text
dMaintainer :: Text
dPath :: FilePath
dYear :: Year
..} =
  URI
dOrigin
    { uriPath = dropExtension $ uriPath dOrigin
    }

getDefaults :: IO Defaults
getDefaults :: IO Defaults
getDefaults = do
  URI
dOrigin <- Maybe URI -> URI
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe URI -> URI) -> (Text -> Maybe URI) -> Text -> URI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Maybe URI
parseURI (FilePath -> Maybe URI) -> (Text -> FilePath) -> Text -> Maybe URI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
unpack (Text -> URI) -> IO Text -> IO URI
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> IO Text
Git.config Text
"remote.origin.url"
  Text
dAuthor <- Text -> IO Text
Git.config Text
"user.name"
  Text
dMaintainer <- Text -> IO Text
Git.config Text
"user.email"
  FilePath
dPath <- IO FilePath
getCurrentDirectory
  TimeZone
timezone <- IO TimeZone
getCurrentTimeZone
  (Year
dYear, Int
_day) <- Day -> (Year, Int)
toOrdinalDate (Day -> (Year, Int)) -> (UTCTime -> Day) -> UTCTime -> (Year, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocalTime -> Day
localDay (LocalTime -> Day) -> (UTCTime -> LocalTime) -> UTCTime -> Day
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeZone -> UTCTime -> LocalTime
utcToLocalTime TimeZone
timezone (UTCTime -> (Year, Int)) -> IO UTCTime -> IO (Year, Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UTCTime
getCurrentTime
  Defaults -> IO Defaults
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Defaults {Year
FilePath
Text
URI
dOrigin :: URI
dAuthor :: Text
dMaintainer :: Text
dPath :: FilePath
dYear :: Year
dOrigin :: URI
dAuthor :: Text
dMaintainer :: Text
dPath :: FilePath
dYear :: Year
..}