{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskellQuotes #-}
module Text.Collate.TH
  ( genCollation
  , genCJKOverrides
  )
where
import Language.Haskell.TH
import Language.Haskell.TH.Syntax (qAddDependentFile)
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Char8 as BL
import Data.Binary as Binary ( encode )
import Text.Collate.Collation (parseCollation, parseCJKOverrides)
import Data.Text.Encoding (decodeUtf8)
-- import Debug.Trace

-- NOTE: The reason for the indirection through binary
-- is that including a string literal in the sources instead
-- of a large structured object (e.g. a Map) dramatically
-- reduces compile times.  This seems a flaw in GHC and when
-- it is addressed, we could switch to a more straightforward
-- method.

genCollation :: FilePath -> Q Exp
genCollation :: FilePath -> Q Exp
genCollation FilePath
fp = do
  forall (m :: * -> *). Quasi m => FilePath -> m ()
qAddDependentFile FilePath
fp
  ByteString
binaryRep <- forall a. Binary a => a -> ByteString
Binary.encode forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Collation
parseCollation forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
decodeUtf8
                  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. IO a -> Q a
runIO (FilePath -> IO ByteString
B.readFile FilePath
fp)
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Lit -> Exp
LitE forall a b. (a -> b) -> a -> b
$ FilePath -> Lit
StringL forall a b. (a -> b) -> a -> b
$ ByteString -> FilePath
BL.unpack ByteString
binaryRep

genCJKOverrides :: FilePath -> Q Exp
genCJKOverrides :: FilePath -> Q Exp
genCJKOverrides FilePath
fp = do
  forall (m :: * -> *). Quasi m => FilePath -> m ()
qAddDependentFile FilePath
fp
  ByteString
binaryRep <- forall a. Binary a => a -> ByteString
Binary.encode forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Int]
parseCJKOverrides forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
decodeUtf8
                  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. IO a -> Q a
runIO (FilePath -> IO ByteString
B.readFile FilePath
fp)
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Lit -> Exp
LitE forall a b. (a -> b) -> a -> b
$ FilePath -> Lit
StringL forall a b. (a -> b) -> a -> b
$ ByteString -> FilePath
BL.unpack ByteString
binaryRep