content: {-# LANGUAGE UnicodeSyntax, NoImplicitPrelude #-}
  {-# LANGUAGE FlexibleContexts #-}
  
  module Xkb.Keycodes where
  
  import BasePrelude
  import Prelude.Unicode
  import Data.Monoid.Unicode ((⊕))
  import Util (toString, show', concatMapM, versionStr)
  
  import Control.Monad.Trans.Maybe (runMaybeT)
  import Control.Monad.Writer (tell)
  import Lens.Micro.Platform (view)
  
  import Layout.Types
  import Lookup.Linux (posToScancode, posAndKeycode)
  import Permutation (assocs)
  
  printKeycodes ∷ Logger m ⇒ Layout → m (Maybe String)
  printKeycodes layout = runMaybeT $ do
      body ← concatMapM printKeycode (view _mods layout)
      guard (not (null body))
      pure ∘ unlines $
          [ "// Generated by KLFC " ⊕ versionStr
          , "// https://github.com/39aldo39/klfc"
          ] ⧺ body
  
  printKeycode ∷ Logger m ⇒ Mod → m [String]
  printKeycode (Mod nameM per) = do
      let (logs, s) = partitionEithers (map (uncurry printKeycodePos) (assocs per))
      tell logs
      pure $
          [ ""
          , "partial xkb_keycodes " ⊕ show nameM ⊕ " {"
          ] ⧺ map (replicate 4 ' ' ⊕) s ⧺
          [ "};"
          ]
  
  printKeycodePos ∷ Pos → Pos → Either String String
  printKeycodePos fromPos toPos =
      liftA2 (showKeycodePos fromPos toPos) fromPos' toPos'
    where
      fromPos' = maybe e Right (lookup fromPos posAndKeycode)
        where e = Left (show' fromPos ⊕ " is not supported in XKB")
      toPos' = maybe e (Right ∘ show) (posToScancode toPos)
        where e = Left (show' toPos ⊕ " is not supported in XKB")
  
  showKeycodePos ∷ Pos → Pos → String → String → String
  showKeycodePos fromPos toPos fromPosString toPosString =
      fromPosString ⊕ " = " ⊕ toPosString ⊕ ";\t// " ⊕ toString fromPos ⊕ " → " ⊕ toString toPos
  