<commit_before>
module Main where

import Control.Exception
import Control.Monad.State
import Data.Maybe ( fromJust )
import qualified Data.Map as Map
import System.Environment (getArgs, getProgName)
import System.Exit (exitFailure)

import UI.HSCurses.Widgets
import qualified UI.HSCurses.Curses as Curses
import qualified UI.HSCurses.CursesHelper as CursesH

import Database.Schema.Migrations.Migration
    ( MigrationMap
    )
import Database.Schema.Migrations.Filesystem
import Database.Schema.Migrations.Store

title :: String
title = "Migration Manager"

help :: String
help = "q:quit"

data MMState = MMState
    { mmMigrations :: MigrationMap
    , mmStatus :: String
    , mmStyles :: [CursesH.CursesStyle]
    , mmStorePath :: FilePath
    }

type MM = StateT MMState IO

type ToplineWidget = TextWidget
type BotlineWidget = TextWidget
type MsglineWidget = TableWidget
type MigrationListWidget = TableWidget

data MainWidget = MainWidget
    { toplineWidget :: ToplineWidget
    , botlineWidget :: BotlineWidget
    , msglineWidget :: MsglineWidget
    , migrationListWidget :: MigrationListWidget
    }

instance Widget MainWidget where
    draw pos sz hint w = draw pos sz hint (mkRealMainWidget (Just sz) w)
    minSize w = minSize (mkRealMainWidget Nothing w)

data MainEditWidget = MainEditWidget
    { toplineEditWidget :: ToplineWidget
    , botlineEditWidget :: BotlineWidget
    , msglineEditWidget :: MsglineWidget
    }

instance Widget MainEditWidget where
    draw pos sz hint w = draw pos sz hint (mkRealMainEditWidget (Just sz) w)
    minSize w = minSize (mkRealMainEditWidget Nothing w)

runMM :: FilePath -> MigrationMap -> [CursesH.CursesStyle] -> MM a -> IO a
runMM sp migrations cstyles mm =
    evalStateT mm (MMState { mmMigrations = migrations
                           , mmStyles = cstyles
                           , mmStatus = sp ++ " loaded."
                           , mmStorePath = sp
                           })

getSize :: MM (Int, Int)
getSize = liftIO $ Curses.scrSize

styles :: [CursesH.Style]
styles = [ CursesH.defaultStyle
         , CursesH.AttributeStyle [CursesH.Bold] CursesH.GreenF CursesH.DarkBlueB
         ]

nthStyle :: Int -> MM CursesH.CursesStyle
nthStyle n =
    do cs <- gets mmStyles
       return $ cs !! n

defStyle :: MM CursesH.CursesStyle
defStyle = nthStyle 0

lineStyle :: MM CursesH.CursesStyle
lineStyle = nthStyle 1

lineDrawingStyle :: MM DrawingStyle
lineDrawingStyle = do
  s <- lineStyle
  return $ mkDrawingStyle s

lineOptions :: MM TextWidgetOptions
lineOptions = do
  sz <- getSize
  ds <- lineDrawingStyle
  return $ TWOptions { twopt_size = TWSizeFixed (1, getWidth sz)
                     , twopt_style = ds
                     , twopt_halign = AlignLeft
                     }

mkToplineWidget :: MM ToplineWidget
mkToplineWidget = do
  opts <- lineOptions
  return $ newTextWidget (opts { twopt_halign = AlignCenter }) title

mkBotlineWidget :: MM BotlineWidget
mkBotlineWidget = do
  opts <- lineOptions
  return $ newTextWidget opts help

-- We need to insert a dummy widget at the lower-right corner of the window,
-- i.e. at the lower-right corner of the message line. Otherwise, an
-- error occurs because drawing a character to this position moves the
-- cursor to the next line, which doesn't exist.<commit_msg>formatting<commit_after>
module Main where

import Control.Exception
import Control.Monad.State
import Data.Maybe ( fromJust )
import qualified Data.Map as Map
import System.Environment (getArgs, getProgName)
import System.Exit (exitFailure)

import UI.HSCurses.Widgets
import qualified UI.HSCurses.Curses as Curses
import qualified UI.HSCurses.CursesHelper as CursesH

import Database.Schema.Migrations.Migration
    ( MigrationMap
    )
import Database.Schema.Migrations.Filesystem
import Database.Schema.Migrations.Store

title :: String
title = "Migration Manager"

help :: String
help = "q:quit"

data MMState = MMState
    { mmMigrations :: MigrationMap
    , mmStatus :: String
    , mmStyles :: [CursesH.CursesStyle]
    , mmStorePath :: FilePath
    }

type MM = StateT MMState IO

type ToplineWidget = TextWidget
type BotlineWidget = TextWidget
type MsglineWidget = TableWidget
type MigrationListWidget = TableWidget

data MainWidget = MainWidget
    { toplineWidget :: ToplineWidget
    , botlineWidget :: BotlineWidget
    , msglineWidget :: MsglineWidget
    , migrationListWidget :: MigrationListWidget
    }

instance Widget MainWidget where
    draw pos sz hint w = draw pos sz hint (mkRealMainWidget (Just sz) w)
    minSize w = minSize (mkRealMainWidget Nothing w)

data MainEditWidget = MainEditWidget
    { toplineEditWidget :: ToplineWidget
    , botlineEditWidget :: BotlineWidget
    , msglineEditWidget :: MsglineWidget
    }

instance Widget MainEditWidget where
    draw pos sz hint w = draw pos sz hint (mkRealMainEditWidget (Just sz) w)
    minSize w = minSize (mkRealMainEditWidget Nothing w)

runMM :: FilePath -> MigrationMap -> [CursesH.CursesStyle] -> MM a -> IO a
runMM sp migrations cstyles mm =
    evalStateT mm (MMState { mmMigrations = migrations
                           , mmStyles = cstyles
                           , mmStatus = sp ++ " loaded."
                           , mmStorePath = sp
                           })

getSize :: MM (Int, Int)
getSize = liftIO $ Curses.scrSize

styles :: [CursesH.Style]
styles = [ CursesH.defaultStyle
         , CursesH.AttributeStyle [CursesH.Bold] CursesH.GreenF CursesH.DarkBlueB
         ]

nthStyle :: Int -> MM CursesH.CursesStyle
nthStyle n =
    do cs <- gets mmStyles
       return $ cs !! n

defStyle :: MM CursesH.CursesStyle
defStyle = nthStyle 0

lineStyle :: MM CursesH.CursesStyle
lineStyle = nthStyle 1

lineDrawingStyle :: MM DrawingStyle
lineDrawingStyle = do
  s <- lineStyle
  return $ mkDrawingStyle s

lineOptions :: MM TextWidgetOptions
lineOptions = do
  sz <- getSize
  ds <- lineDrawingStyle
  return $ TWOptions { twopt_size = TWSizeFixed (1, getWidth sz)
                     , twopt_style = ds
                     , twopt_halign = AlignLeft
                     }

mkToplineWidget :: MM ToplineWidget
mkToplineWidget = do
  opts <- lineOptions
  return $ newTextWidget (opts { twopt_halign = AlignCenter }) title

mkBotlineWidget :: MM BotlineWidget
mkBotlineWidget = do
  opts <- lineOptions
  return $ newTextWidget opts help

-- We need to insert a dummy widget at the lower-right corner of the
-- window, i.e. at the lower-right corner of the message
-- line. Otherwise, an error occurs because drawing a character to
-- this position moves the cursor to the next line, which doesn't
-- exist.
{'fraction_non_alphanumeric': 0.07276570048309179, 'fraction_numerical': 0.0009057971014492754, 'mean_word_length': 3.1149068322981366, 'pattern_counts': {'":': 0, '<': 15, '<?xml version=': 0, '>': 13, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '6051049', 'n_tokens_mistral': 2027, 'n_tokens_neox': 1978, 'n_words': 615}