content: {-# LANGUAGE RecordWildCards #-}
  {-# LANGUAGE TemplateHaskell #-}
  
  {-|
  Module      :  Data.Aeson.Schema.TH.Getter
  Maintainer  :  Brandon Chinn <brandonchinn178@gmail.com>
  Stability   :  experimental
  Portability :  portable
  
  Template Haskell functions for getter functions.
  -}
  module Data.Aeson.Schema.TH.Getter where
  
  import Control.Monad (unless)
  import Data.Aeson.Schema.Internal (Object)
  import Data.Maybe (isNothing)
  import Language.Haskell.TH
  
  import Data.Aeson.Schema.TH.Get (generateGetterExp)
  import Data.Aeson.Schema.TH.Parse (GetterExp (..), parseGetterExp)
  import Data.Aeson.Schema.TH.Unwrap (
    FunctorHandler (..),
    unwrapSchema,
    unwrapSchemaUsing,
   )
  import Data.Aeson.Schema.TH.Utils (loadSchema, lookupSchema, schemaVToTypeQ)
  import Data.Aeson.Schema.Utils.NameLike (NameLike (..))
  
  -- | A helper that generates a 'Data.Aeson.Schema.TH.get' expression and a type alias for the result
  --  of the expression.
  --
  --  > mkGetter "Node" "getNodes" ''MySchema ".nodes[]"
  --  >
  --  > {\- is equivalent to -\}
  --  >
  --  > -- | Node ~ { b: Maybe Bool }
  --  > type Node = [unwrap| MySchema.nodes[] |]
  --  >
  --  > getNodes :: Object MySchema -> [Node]
  --  > getNodes = [get| .nodes[] |]
  --
  --  'mkGetter' takes four arguments:
  --
  --    [@unwrapName@] The name of the type synonym to store the unwrapped schema as
  --
  --    [@funcName@] The name of the getter function
  --
  --    [@startSchema@] The schema to extract/unwrap from
  --
  --    [@ops@] The operation to pass to the 'Data.Aeson.Schema.TH.get' and
  --            'Data.Aeson.Schema.TH.unwrap' quasiquoters
  --
  --  There is one subtlety that occurs from the use of the same @ops@ string for both the
  --  'Data.Aeson.Schema.TH.unwrap' and 'Data.Aeson.Schema.TH.get' quasiquoters:
  --  'Data.Aeson.Schema.TH.unwrap' strips out intermediate functors, while 'Data.Aeson.Schema.TH.get'
  --  applies within the functor. So in the above example, @".nodes[]"@ strips out the list when
  --  saving the schema to @Node@, while in the below example, @".nodes"@ doesn't strip out the list
  --  when saving the schema to @Nodes@.
  --
  --  > mkGetter "Nodes" "getNodes" ''MySchema ".nodes"
  --  >
  --  > {\- is equivalent to -\}
  --  >
  --  > -- | Nodes ~ List { b: Maybe Bool }
  --  > type Nodes = [unwrap| MySchema.nodes |]
  --  >
  --  > getNodes :: Object MySchema -> Nodes
  --  > getNodes = [get| .nodes |]
  --
  --  As another example,
  --
  --  > mkGetter "MyName" "getMyName" ''MySchema ".f?[].name"
  --  >
  --  > {\- is equivalent to -\}
  --  >
  --  > -- | MyName ~ Text
  --  > type MyName = [unwrap| MySchema.f?[].name |]
  --  >
  --  > getMyBool :: Object MySchema -> Maybe [MyName]
  --  > getMyBool = [get| .f?[].name |]
  mkGetter :: String -> String -> Name -> String -> DecsQ
  mkGetter unwrapName funcName startSchemaName ops = do
    getterExp@GetterExp{..} <- parseGetterExp ops
    unless (isNothing start) $
      fail $
        "Getter expression should start with '.': " ++ ops
  
    startSchema <- lookupSchema (NameTH startSchemaName) >>= loadSchema
  
    let unwrapResult = unwrapSchema getterOps startSchema
        funcResult = unwrapSchemaUsing ApplyFunctors getterOps startSchema
        getterFunc = generateGetterExp getterExp
        unwrapName' = mkName unwrapName
        funcName' = mkName funcName
  
    sequence
      [ tySynD unwrapName' [] unwrapResult
      , sigD funcName' [t|Object $(schemaVToTypeQ startSchema) -> $funcResult|]
      , funD funcName' [clause [] (normalB getterFunc) []]
      ]
  