{-# LANGUAGE DeriveLift #-}
{-# LANGUAGE StandaloneDeriving #-}
module Text.Format.TH ( formatQQ, format1QQ ) where
import Data.String
import Language.Haskell.TH
import Language.Haskell.TH.Quote
import Language.Haskell.TH.Syntax
import Text.Format.ArgFmt
import Text.Format.ArgKey
import Text.Format.Format
deriving instance Lift ArgKey
deriving instance Lift ArgFmt
deriving instance Lift FmtAlign
deriving instance Lift FmtSign
deriving instance Lift FmtNumSep
deriving instance Lift FmtItem
deriving instance Lift Format
deriving instance Lift Format1
formatQQ :: QuasiQuoter
formatQQ = QuasiQuoter { quoteExp = formatExp
, quotePat = undefined
, quoteType = undefined
, quoteDec = undefined
}
formatExp :: String -> Q Exp
formatExp fs = lift $ (fromString (fixEnd $ fixBegin fs) :: Format)
format1QQ :: QuasiQuoter
format1QQ = QuasiQuoter { quoteExp = format1Exp
, quotePat = undefined
, quoteType = undefined
, quoteDec = undefined
}
format1Exp :: String -> Q Exp
format1Exp fs = lift $ (fromString (fixEnd $ fixBegin fs) :: Format1)
fixBegin :: String -> String
fixBegin ('>':'>':'>':"") = ""
fixBegin ('>':'>':'>':'\n':fs) = fs
fixBegin fs = fs
fixEnd :: String -> String
fixEnd ('<':'<':'<':"") = ""
fixEnd fs | ('<':'<':'<':'\n':fs') <- reverse fs = reverse fs'
fixEnd fs = fs