{-# LANGUAGE TemplateHaskell #-}
-- | Named arguments used in generating code.
module Language.Drasil.Chunk.NamedArgument (
  -- * Chunk Type
  NamedArgument(..),
  -- * Constructor
  narg) where

import Language.Drasil (QuantityDict, HasSpace(..), HasSymbol(..), HasUID(..),
  Idea(..), MayHaveUnit(..), NamedIdea(..), Quantity, qw, IsArgumentName)

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

-- | Any quantity can be a named argument (wrapper for 'QuantityDict'),
-- but with more of a focus on generating code arguments.
newtype NamedArgument = NA {NamedArgument -> QuantityDict
_qtd :: QuantityDict}
makeLenses ''NamedArgument

-- | Finds the 'UID' of the 'QuantityDict' used to make the 'NamedArgument'.
instance HasUID         NamedArgument where uid :: Lens' NamedArgument UID
uid = Iso' NamedArgument QuantityDict
qtd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. HasUID c => Lens' c UID
uid
-- | Finds the term ('NP') of the 'QuantityDict' used to make the 'NamedArgument'.
instance NamedIdea      NamedArgument where term :: Lens' NamedArgument NP
term = Iso' NamedArgument QuantityDict
qtd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. NamedIdea c => Lens' c NP
term
-- | Finds the idea contained in the 'QuantityDict' used to make the 'NamedArgument'.
instance Idea           NamedArgument where getA :: NamedArgument -> Maybe String
getA = forall c. Idea c => c -> Maybe String
getA forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Iso' NamedArgument QuantityDict
qtd
-- | Finds the 'Space' of the 'QuantityDict' used to make the 'NamedArgument'.
instance HasSpace       NamedArgument where typ :: Getter NamedArgument Space
typ = Iso' NamedArgument QuantityDict
qtd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. HasSpace c => Getter c Space
typ
-- | Finds the 'Symbol' of the 'QuantityDict' used to make the 'NamedArgument'.
instance HasSymbol      NamedArgument where symbol :: NamedArgument -> Stage -> Symbol
symbol = forall c. HasSymbol c => c -> Stage -> Symbol
symbol forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Iso' NamedArgument QuantityDict
qtd
-- | 'NamedArgument's have a 'Quantity'.
instance Quantity       NamedArgument where
-- | 'NamedArgument's have an argument name.
instance IsArgumentName NamedArgument where
-- | Equal if 'UID's are equal.
instance Eq             NamedArgument where NamedArgument
a == :: NamedArgument -> NamedArgument -> Bool
== NamedArgument
b = (NamedArgument
a forall s a. s -> Getting a s a -> a
^. forall c. HasUID c => Lens' c UID
uid) forall a. Eq a => a -> a -> Bool
== (NamedArgument
b forall s a. s -> Getting a s a -> a
^. forall c. HasUID c => Lens' c UID
uid)
-- | Finds the units of the 'QuantityDict' used to make the 'NamedArgument'.
instance MayHaveUnit    NamedArgument where getUnit :: NamedArgument -> Maybe UnitDefn
getUnit = forall u. MayHaveUnit u => u -> Maybe UnitDefn
getUnit forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Iso' NamedArgument QuantityDict
qtd

-- | Smart constructor for 'NamedArgument' .
narg :: (Quantity q, MayHaveUnit q) => q -> NamedArgument
narg :: forall q. (Quantity q, MayHaveUnit q) => q -> NamedArgument
narg = QuantityDict -> NamedArgument
NA forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall q. (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw