{-# LANGUAGE StandaloneDeriving, FlexibleInstances #-}
module Hpp.Config where
import Data.Functor.Identity
import Data.Time.Clock (getCurrentTime, UTCTime)
import Data.Time.Format
newtype TimeString = TimeString { TimeString -> String
getTimeString :: String }
deriving (TimeString -> TimeString -> Bool
(TimeString -> TimeString -> Bool)
-> (TimeString -> TimeString -> Bool) -> Eq TimeString
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TimeString -> TimeString -> Bool
$c/= :: TimeString -> TimeString -> Bool
== :: TimeString -> TimeString -> Bool
$c== :: TimeString -> TimeString -> Bool
Eq, Eq TimeString
Eq TimeString
-> (TimeString -> TimeString -> Ordering)
-> (TimeString -> TimeString -> Bool)
-> (TimeString -> TimeString -> Bool)
-> (TimeString -> TimeString -> Bool)
-> (TimeString -> TimeString -> Bool)
-> (TimeString -> TimeString -> TimeString)
-> (TimeString -> TimeString -> TimeString)
-> Ord TimeString
TimeString -> TimeString -> Bool
TimeString -> TimeString -> Ordering
TimeString -> TimeString -> TimeString
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 :: TimeString -> TimeString -> TimeString
$cmin :: TimeString -> TimeString -> TimeString
max :: TimeString -> TimeString -> TimeString
$cmax :: TimeString -> TimeString -> TimeString
>= :: TimeString -> TimeString -> Bool
$c>= :: TimeString -> TimeString -> Bool
> :: TimeString -> TimeString -> Bool
$c> :: TimeString -> TimeString -> Bool
<= :: TimeString -> TimeString -> Bool
$c<= :: TimeString -> TimeString -> Bool
< :: TimeString -> TimeString -> Bool
$c< :: TimeString -> TimeString -> Bool
compare :: TimeString -> TimeString -> Ordering
$ccompare :: TimeString -> TimeString -> Ordering
$cp1Ord :: Eq TimeString
Ord, Int -> TimeString -> ShowS
[TimeString] -> ShowS
TimeString -> String
(Int -> TimeString -> ShowS)
-> (TimeString -> String)
-> ([TimeString] -> ShowS)
-> Show TimeString
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TimeString] -> ShowS
$cshowList :: [TimeString] -> ShowS
show :: TimeString -> String
$cshow :: TimeString -> String
showsPrec :: Int -> TimeString -> ShowS
$cshowsPrec :: Int -> TimeString -> ShowS
Show)
newtype DateString = DateString { DateString -> String
getDateString :: String }
deriving (DateString -> DateString -> Bool
(DateString -> DateString -> Bool)
-> (DateString -> DateString -> Bool) -> Eq DateString
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DateString -> DateString -> Bool
$c/= :: DateString -> DateString -> Bool
== :: DateString -> DateString -> Bool
$c== :: DateString -> DateString -> Bool
Eq, Eq DateString
Eq DateString
-> (DateString -> DateString -> Ordering)
-> (DateString -> DateString -> Bool)
-> (DateString -> DateString -> Bool)
-> (DateString -> DateString -> Bool)
-> (DateString -> DateString -> Bool)
-> (DateString -> DateString -> DateString)
-> (DateString -> DateString -> DateString)
-> Ord DateString
DateString -> DateString -> Bool
DateString -> DateString -> Ordering
DateString -> DateString -> DateString
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 :: DateString -> DateString -> DateString
$cmin :: DateString -> DateString -> DateString
max :: DateString -> DateString -> DateString
$cmax :: DateString -> DateString -> DateString
>= :: DateString -> DateString -> Bool
$c>= :: DateString -> DateString -> Bool
> :: DateString -> DateString -> Bool
$c> :: DateString -> DateString -> Bool
<= :: DateString -> DateString -> Bool
$c<= :: DateString -> DateString -> Bool
< :: DateString -> DateString -> Bool
$c< :: DateString -> DateString -> Bool
compare :: DateString -> DateString -> Ordering
$ccompare :: DateString -> DateString -> Ordering
$cp1Ord :: Eq DateString
Ord, Int -> DateString -> ShowS
[DateString] -> ShowS
DateString -> String
(Int -> DateString -> ShowS)
-> (DateString -> String)
-> ([DateString] -> ShowS)
-> Show DateString
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DateString] -> ShowS
$cshowList :: [DateString] -> ShowS
show :: DateString -> String
$cshow :: DateString -> String
showsPrec :: Int -> DateString -> ShowS
$cshowsPrec :: Int -> DateString -> ShowS
Show)
data ConfigF f = Config { ConfigF f -> f String
curFileNameF :: f FilePath
, ConfigF f -> f [String]
includePathsF :: f [FilePath]
, ConfigF f -> f Bool
spliceLongLinesF :: f Bool
, :: f Bool
, ConfigF f -> f Bool
inhibitLinemarkersF :: f Bool
, ConfigF f -> f Bool
replaceTrigraphsF :: f Bool
, ConfigF f -> f DateString
prepDateF :: f DateString
, ConfigF f -> f TimeString
prepTimeF :: f TimeString
}
type Config = ConfigF Identity
deriving instance Show (ConfigF Identity)
realizeConfig :: ConfigF Maybe -> Maybe Config
realizeConfig :: ConfigF Maybe -> Maybe (ConfigF Identity)
realizeConfig (Config (Just String
fileName)
(Just [String]
paths)
(Just Bool
spliceLines)
(Just Bool
comments)
(Just Bool
inhibitLines)
(Just Bool
trigraphs)
(Just DateString
pdate)
(Just TimeString
ptime)) =
ConfigF Identity -> Maybe (ConfigF Identity)
forall a. a -> Maybe a
Just (Identity String
-> Identity [String]
-> Identity Bool
-> Identity Bool
-> Identity Bool
-> Identity Bool
-> Identity DateString
-> Identity TimeString
-> ConfigF Identity
forall (f :: * -> *).
f String
-> f [String]
-> f Bool
-> f Bool
-> f Bool
-> f Bool
-> f DateString
-> f TimeString
-> ConfigF f
Config (String -> Identity String
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
fileName) ([String] -> Identity [String]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [String]
paths) (Bool -> Identity Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
spliceLines) (Bool -> Identity Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
comments)
(Bool -> Identity Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
inhibitLines) (Bool -> Identity Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
trigraphs) (DateString -> Identity DateString
forall (f :: * -> *) a. Applicative f => a -> f a
pure DateString
pdate) (TimeString -> Identity TimeString
forall (f :: * -> *) a. Applicative f => a -> f a
pure TimeString
ptime))
realizeConfig ConfigF Maybe
_ = Maybe (ConfigF Identity)
forall a. Maybe a
Nothing
curFileName :: Config -> FilePath
curFileName :: ConfigF Identity -> String
curFileName = Identity String -> String
forall a. Identity a -> a
runIdentity (Identity String -> String)
-> (ConfigF Identity -> Identity String)
-> ConfigF Identity
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConfigF Identity -> Identity String
forall (f :: * -> *). ConfigF f -> f String
curFileNameF
includePaths :: Config -> [FilePath]
includePaths :: ConfigF Identity -> [String]
includePaths = Identity [String] -> [String]
forall a. Identity a -> a
runIdentity (Identity [String] -> [String])
-> (ConfigF Identity -> Identity [String])
-> ConfigF Identity
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConfigF Identity -> Identity [String]
forall (f :: * -> *). ConfigF f -> f [String]
includePathsF
spliceLongLines :: Config -> Bool
spliceLongLines :: ConfigF Identity -> Bool
spliceLongLines = Identity Bool -> Bool
forall a. Identity a -> a
runIdentity (Identity Bool -> Bool)
-> (ConfigF Identity -> Identity Bool) -> ConfigF Identity -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConfigF Identity -> Identity Bool
forall (f :: * -> *). ConfigF f -> f Bool
spliceLongLinesF
eraseCComments :: Config -> Bool
= Identity Bool -> Bool
forall a. Identity a -> a
runIdentity (Identity Bool -> Bool)
-> (ConfigF Identity -> Identity Bool) -> ConfigF Identity -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConfigF Identity -> Identity Bool
forall (f :: * -> *). ConfigF f -> f Bool
eraseCCommentsF
inhibitLinemarkers :: Config -> Bool
inhibitLinemarkers :: ConfigF Identity -> Bool
inhibitLinemarkers = Identity Bool -> Bool
forall a. Identity a -> a
runIdentity (Identity Bool -> Bool)
-> (ConfigF Identity -> Identity Bool) -> ConfigF Identity -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConfigF Identity -> Identity Bool
forall (f :: * -> *). ConfigF f -> f Bool
inhibitLinemarkersF
replaceTrigraphs :: Config -> Bool
replaceTrigraphs :: ConfigF Identity -> Bool
replaceTrigraphs = Identity Bool -> Bool
forall a. Identity a -> a
runIdentity (Identity Bool -> Bool)
-> (ConfigF Identity -> Identity Bool) -> ConfigF Identity -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConfigF Identity -> Identity Bool
forall (f :: * -> *). ConfigF f -> f Bool
replaceTrigraphsF
prepDate :: Config -> DateString
prepDate :: ConfigF Identity -> DateString
prepDate = Identity DateString -> DateString
forall a. Identity a -> a
runIdentity (Identity DateString -> DateString)
-> (ConfigF Identity -> Identity DateString)
-> ConfigF Identity
-> DateString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConfigF Identity -> Identity DateString
forall (f :: * -> *). ConfigF f -> f DateString
prepDateF
prepTime :: Config -> TimeString
prepTime :: ConfigF Identity -> TimeString
prepTime = Identity TimeString -> TimeString
forall a. Identity a -> a
runIdentity (Identity TimeString -> TimeString)
-> (ConfigF Identity -> Identity TimeString)
-> ConfigF Identity
-> TimeString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConfigF Identity -> Identity TimeString
forall (f :: * -> *). ConfigF f -> f TimeString
prepTimeF
defaultConfigF :: ConfigF Maybe
defaultConfigF :: ConfigF Maybe
defaultConfigF = Maybe String
-> Maybe [String]
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe DateString
-> Maybe TimeString
-> ConfigF Maybe
forall (f :: * -> *).
f String
-> f [String]
-> f Bool
-> f Bool
-> f Bool
-> f Bool
-> f DateString
-> f TimeString
-> ConfigF f
Config Maybe String
forall a. Maybe a
Nothing ([String] -> Maybe [String]
forall a. a -> Maybe a
Just [])
(Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True) (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True) (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False) (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False)
(DateString -> Maybe DateString
forall a. a -> Maybe a
Just (String -> DateString
DateString String
"??? ?? ????"))
(TimeString -> Maybe TimeString
forall a. a -> Maybe a
Just (String -> TimeString
TimeString String
"??:??:??"))
formatPrepDate :: UTCTime -> DateString
formatPrepDate :: UTCTime -> DateString
formatPrepDate = String -> DateString
DateString (String -> DateString)
-> (UTCTime -> String) -> UTCTime -> DateString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeLocale -> String -> UTCTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%b %e %Y"
formatPrepTime :: UTCTime -> TimeString
formatPrepTime :: UTCTime -> TimeString
formatPrepTime = String -> TimeString
TimeString (String -> TimeString)
-> (UTCTime -> String) -> UTCTime -> TimeString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeLocale -> String -> UTCTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%T"
defaultConfigFNow :: IO (ConfigF Maybe)
defaultConfigFNow :: IO (ConfigF Maybe)
defaultConfigFNow = do UTCTime
now <- IO UTCTime
getCurrentTime
let d :: DateString
d = UTCTime -> DateString
formatPrepDate UTCTime
now
t :: TimeString
t = UTCTime -> TimeString
formatPrepTime UTCTime
now
ConfigF Maybe -> IO (ConfigF Maybe)
forall (m :: * -> *) a. Monad m => a -> m a
return (ConfigF Maybe -> IO (ConfigF Maybe))
-> ConfigF Maybe -> IO (ConfigF Maybe)
forall a b. (a -> b) -> a -> b
$ ConfigF Maybe
defaultConfigF { prepDateF :: Maybe DateString
prepDateF = DateString -> Maybe DateString
forall a. a -> Maybe a
Just DateString
d
, prepTimeF :: Maybe TimeString
prepTimeF = TimeString -> Maybe TimeString
forall a. a -> Maybe a
Just TimeString
t }
spliceLongLinesL :: Functor f => (Bool -> f Bool) -> Config -> f Config
spliceLongLinesL :: (Bool -> f Bool) -> ConfigF Identity -> f (ConfigF Identity)
spliceLongLinesL Bool -> f Bool
f ConfigF Identity
cfg = (\Bool
x -> ConfigF Identity
cfg { spliceLongLinesF :: Identity Bool
spliceLongLinesF = Bool -> Identity Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
x })
(Bool -> ConfigF Identity) -> f Bool -> f (ConfigF Identity)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> f Bool
f (ConfigF Identity -> Bool
spliceLongLines ConfigF Identity
cfg)
eraseCCommentsL :: Functor f => (Bool -> f Bool) -> Config -> f Config
Bool -> f Bool
f ConfigF Identity
cfg = (\Bool
x -> ConfigF Identity
cfg { eraseCCommentsF :: Identity Bool
eraseCCommentsF = Bool -> Identity Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
x })
(Bool -> ConfigF Identity) -> f Bool -> f (ConfigF Identity)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> f Bool
f (ConfigF Identity -> Bool
eraseCComments ConfigF Identity
cfg)
inhibitLinemarkersL :: Functor f => (Bool -> f Bool) -> Config -> f Config
inhibitLinemarkersL :: (Bool -> f Bool) -> ConfigF Identity -> f (ConfigF Identity)
inhibitLinemarkersL Bool -> f Bool
f ConfigF Identity
cfg = (\Bool
x -> ConfigF Identity
cfg { inhibitLinemarkersF :: Identity Bool
inhibitLinemarkersF = Bool -> Identity Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
x })
(Bool -> ConfigF Identity) -> f Bool -> f (ConfigF Identity)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> f Bool
f (ConfigF Identity -> Bool
inhibitLinemarkers ConfigF Identity
cfg)
replaceTrigraphsL :: Functor f => (Bool -> f Bool) -> Config -> f Config
replaceTrigraphsL :: (Bool -> f Bool) -> ConfigF Identity -> f (ConfigF Identity)
replaceTrigraphsL Bool -> f Bool
f ConfigF Identity
cfg = (\Bool
x -> ConfigF Identity
cfg { replaceTrigraphsF :: Identity Bool
replaceTrigraphsF = Bool -> Identity Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
x })
(Bool -> ConfigF Identity) -> f Bool -> f (ConfigF Identity)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> f Bool
f (ConfigF Identity -> Bool
replaceTrigraphs ConfigF Identity
cfg)