{-# LANGUAGE NoImplicitPrelude
  #-}

module Utils.PathPiece
  ( finiteFromPathPiece
  , nullaryToPathPiece
  , splitCamel
  ) where

import ClassyPrelude.Yesod

import Language.Haskell.TH
import qualified Language.Haskell.TH.Syntax as TH (Lift(..))
import Data.Universe

import qualified Data.Text as Text
import qualified Data.Char as Char

import Data.Monoid (Endo(..))

finiteFromPathPiece :: (PathPiece a, Finite a) => Text -> Maybe a
finiteFromPathPiece text = case filter (\c -> toPathPiece c == text) universeF of
  [x] -> Just x
  _xs -> Nothing

nullaryToPathPiece :: Name -> [Text -> Text] -> ExpQ
nullaryToPathPiece nullaryType manglers = do
  TyConI (DataD _ _ _ _ constructors _) <- reify nullaryType
  helperName <- newName "helper"
  let
    toClause (NormalC cName []) = clause [conP cName []] (normalB . TH.lift . mangle $ nameBase cName) []
    toClause con = fail $ "Unsupported constructor: " ++ show con
    helperDec = funD helperName $ map toClause constructors
  letE [helperDec] $ varE helperName
  where
    mangle = appEndo (foldMap Endo manglers) . Text.pack
  
splitCamel :: Textual t => t -> [t]
splitCamel = map fromList . reverse . helper (error "hasChange undefined at start of string") [] "" . otoList
  where
    helper _hadChange items thisWord [] = reverse thisWord : items
    helper _hadChange items [] (c:cs) = helper True items [c] cs
    helper  hadChange items ws@(w:ws') (c:cs)
      | sameCategory w c
      , null ws'         = helper (Char.isLower w) items (c:ws) cs
      | sameCategory w c = helper hadChange items (c:ws) cs
      | Char.isLower w
      , Char.isUpper c   = helper True (reverse ws :items) [c] cs
      | null ws'         = helper True items (c:ws) cs
      | not hadChange    = helper True (reverse ws':items) [c,w] cs
      | otherwise        = helper True (reverse ws :items) [c] cs

    sameCategory = (==) `on` Char.generalCategory