----------------------------------------------------------------------
--
-- Module      : l flags  values from command line
----------------------------------------------------------------------
-- {-# LANGUAGE DeriveAnyClass #-}
-- {-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
-- {-# LANGUAGE TypeSynonymInstances  #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}

{- | the defintion for a layout and a flags type
  which carry info from the command line and the siteHeader file
 the defaults for flags are set up for testing  are overridden
 the defaults for layout must correspond to what is set in the test siteHeader file.
 layout defaults are used in testing

 content dirs are those, which have *.md files
-}
module Foundational.CmdLineFlags
    (module Foundational.CmdLineFlags
    , def ) where

import Data.Default.Class ( Default(..) )
import UniformBase ( Text, Zeros(zero) ) -- to define a default class for pub flags 

progName, progTitle :: Text
progName :: Text
progName = Text
"daino"  
progTitle :: Text
progTitle = Text
"constructing a static site generator" :: Text



-- | the flags represent the switches from CmdLineArgs
-- see there for meaning
data PubFlags = PubFlags
    { PubFlags -> Bool
privateFlag
      , PubFlags -> Bool
draftFlag
    --   , oldFlag
      , PubFlags -> Bool
testFlag
      , PubFlags -> Bool
testNewFlag 
      , PubFlags -> Bool
quickFlag
      , PubFlags -> Bool
watchFlag
      , PubFlags -> Bool
serverFlag :: Bool
      , PubFlags -> FilePath
locationDir :: FilePath -- can be absolute or relative
    }
    deriving (Int -> PubFlags -> ShowS
[PubFlags] -> ShowS
PubFlags -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [PubFlags] -> ShowS
$cshowList :: [PubFlags] -> ShowS
show :: PubFlags -> FilePath
$cshow :: PubFlags -> FilePath
showsPrec :: Int -> PubFlags -> ShowS
$cshowsPrec :: Int -> PubFlags -> ShowS
Show, PubFlags -> PubFlags -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PubFlags -> PubFlags -> Bool
$c/= :: PubFlags -> PubFlags -> Bool
== :: PubFlags -> PubFlags -> Bool
$c== :: PubFlags -> PubFlags -> Bool
Eq) -- no read for path

instance Zeros PubFlags where
    zero :: PubFlags
zero = Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> FilePath
-> PubFlags
PubFlags forall z. Zeros z => z
zero forall z. Zeros z => z
zero forall z. Zeros z => z
zero forall z. Zeros z => z
zero forall z. Zeros z => z
zero forall z. Zeros z => z
zero forall z. Zeros z => z
zero forall z. Zeros z => z
zero
instance Default PubFlags where 
        def :: PubFlags
def = PubFlags
testFlags 

testFlags :: PubFlags
testFlags :: PubFlags
testFlags =
    forall z. Zeros z => z
zero
        { privateFlag :: Bool
privateFlag = Bool
False -- not including draft
        , draftFlag :: Bool
draftFlag = Bool
False
        }