{-# LANGUAGE TemplateHaskell #-}
-- | Defines types and functions to gather all the information needed for printing.
module Language.Drasil.Printing.PrintingInformation where

import Control.Lens (makeLenses, Lens', (^.))

import SysInfo.Drasil (sysinfodb, SystemInformation)
import Database.Drasil (ChunkDB)

import Language.Drasil (Stage(..))

-- | Notation can be scientific or for engineering.
data Notation = Scientific
              | Engineering

-- | Able to be printed.
class HasPrintingOptions c where
    -- | Holds the printing notation.
    getSetting :: Lens' c Notation

-- | Holds the printing configuration.
newtype PrintingConfiguration = PC { PrintingConfiguration -> Notation
_notation :: Notation }
makeLenses ''PrintingConfiguration

-- | Finds the notation used for the 'PrintingConfiguration'.
instance HasPrintingOptions  PrintingConfiguration where getSetting :: Lens' PrintingConfiguration Notation
getSetting = Iso' PrintingConfiguration Notation
notation

-- | Printing information contains a database, a stage, and a printing configuration.
data PrintingInformation = PI
                         { PrintingInformation -> ChunkDB
_ckdb :: ChunkDB
                         , PrintingInformation -> Stage
_stg :: Stage
                         , PrintingInformation -> PrintingConfiguration
_configuration :: PrintingConfiguration
                         }
makeLenses ''PrintingInformation

-- | Finds the notation used for the 'PrintingConfiguration' within the 'PrintingInformation'.
instance HasPrintingOptions  PrintingInformation where getSetting :: Lens' PrintingInformation Notation
getSetting  = Lens' PrintingInformation PrintingConfiguration
configuration forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. HasPrintingOptions c => Lens' c Notation
getSetting

-- | Builds a document's printing information based on the system information.
piSys :: SystemInformation -> Stage -> PrintingConfiguration -> PrintingInformation
piSys :: SystemInformation
-> Stage -> PrintingConfiguration -> PrintingInformation
piSys SystemInformation
si = ChunkDB -> Stage -> PrintingConfiguration -> PrintingInformation
PI (SystemInformation
si forall s a. s -> Getting a s a -> a
^. Lens' SystemInformation ChunkDB
sysinfodb)

-- | Default configuration is for engineering.
defaultConfiguration :: PrintingConfiguration
defaultConfiguration :: PrintingConfiguration
defaultConfiguration = Notation -> PrintingConfiguration
PC Notation
Engineering