module Handler.Info.TH
  ( glossaryTerms
  , mkFaqItems
  ) where

import Import
import Handler.Utils.I18n

import Language.Haskell.TH

import qualified Data.Char as Char

import qualified Data.Map.Strict as Map
import qualified Data.Text as Text


glossaryTerms :: FilePath -> Q Exp
glossaryTerms basename = do
  translationsAvailable <- i18nWidgetFilesAvailable' basename
  let terms = Map.mapWithKey (\k _ -> "Msg" <> unPathPiece k) translationsAvailable
  [e|Map.fromList $(listE . map (\(int, msg) -> tupE [litE . stringL $ repack int, conE $ mkName msg]) $ Map.toList terms)|]
  where
    unPathPiece :: Text -> String
    unPathPiece = repack . mconcat . map (over _head Char.toUpper) . Text.splitOn "-"

mkFaqItems :: FilePath -> DecsQ
mkFaqItems basename = do
  itemsAvailable <- i18nWidgetFilesAvailable' basename
  let items = Map.mapWithKey (\k _ -> "FAQ" <> unPathPiece k) itemsAvailable
  sequence
    [ dataD (cxt []) dataName [] Nothing
        [ normalC (mkName conName) []
        | (_, conName) <- Map.toAscList items
        ]
        [ derivClause (Just StockStrategy)
            [ conT ''Eq
            , conT ''Ord
            , conT ''Read
            , conT ''Show
            , conT ''Enum
            , conT ''Bounded
            , conT ''Generic
            , conT ''Typeable
            ]
        , derivClause (Just AnyclassStrategy)
            [ conT ''Universe
            , conT ''Finite
            ]
        ]
    , instanceD (cxt []) (conT ''PathPiece `appT` conT dataName)
      [ funD 'toPathPiece
        [ clause [conP (mkName con) []] (normalB . litE . stringL $ repack int) []
        | (int, con) <- Map.toList items
        ]
      , funD 'fromPathPiece
        [ clause [varP $ mkName "t"]
          ( guardedB
            [ (,) <$> normalG [e|$(varE $ mkName "t") == int|] <*> [e|Just $(conE $ mkName con)|]
            | (int, con) <- Map.toList items
            ]) []
        , clause [wildP] (normalB [e|Nothing|]) []
        ]
      ]
    , sigD (mkName "faqItemMap") [t|Map Text $(conT dataName)|]
    , funD (mkName "faqItemMap")
        [ clause [] (normalB [e| Map.fromList $(listE . map (\(int, con) -> tupE [litE . stringL $ repack int, conE $ mkName con]) $ Map.toList items) |]) []
        ]
    ]
  where
    unPathPiece :: Text -> String
    unPathPiece = repack . mconcat . map (over _head Char.toUpper) . Text.splitOn "-"

    dataName = mkName "FAQItem"