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