{-# LANGUAGE UnicodeSyntax, NoImplicitPrelude #-}
{-# LANGUAGE PatternGuards #-}

module Xkb.XCompose where

import BasePrelude
import Prelude.Unicode
import Data.Monoid.Unicode ((⊕))
import Util (ifNonEmpty, escapeWithQuotes, privateChars, versionStr)

import Control.Monad.State (evalState)
import Control.Monad.Writer (runWriter)
import Lens.Micro.Platform (view, over, _1)

import Layout.DeadKey (actionMapToStringMap)
import Layout.Key (baseCharToLetter)
import Layout.Types
import Xkb.General (setNullChars, setInternalDeadNullChars)
import Xkb.Symbols (printLetter)

printXCompose ∷ Layout → Maybe String
printXCompose =
    flip evalState privateChars ∘ setNullChars >>>
    setInternalDeadNullChars >>> \layout → do
        let layouts = layout : map variantToLayout (view _variants layout)
        let body =
             ifNonEmpty ([]:) (concatMap printLigatures layouts) ⧺
             concatMap printCustomDeadKeys layouts
        guard (not (null body))
        pure ∘ unlines $
            [ "# Generated by KLFC " ⊕ versionStr
            , "# https://github.com/39aldo39/klfc"
            ] ⧺ body

printLigatures ∷ Layout → [String]
printLigatures = concatMap (mapMaybe printLigature ∘ view _letters) ∘ view _keys

printLigature ∷ Letter → Maybe String
printLigature (Ligature (Just c) xs) = Just (printCombination [Char c] xs)
printLigature _ = Nothing

printCustomDeadKeys ∷ Layout → [String]
printCustomDeadKeys = concatMap (concatMap printCustomDeadKey ∘ view _letters) ∘ view _keys

printCustomDeadKey ∷ Letter → [String]
printCustomDeadKey (CustomDead _ (DeadKey name baseChar actionMap))
  | Just l ← baseCharToLetter baseChar
  = [] : "# Dead key: " ⊕ name : printCombinations (map (over _1 (l :)) (actionMapToStringMap actionMap))
printCustomDeadKey _ = []

printCombinations ∷ [([Letter], String)] → [String]
printCombinations = map (uncurry printCombination)

printCombination ∷ [Letter] → String → String
printCombination xs s = concatMap (\c → "<" ⊕ printKeysym c ⊕ "> ") xs ⊕ ": " ⊕ escapeWithQuotes s
  where printKeysym = fst ∘ runWriter ∘ printLetter
