{-# LANGUAGE NoImplicitPrelude #-}

module Main(
  main
) where

import Control.Applicative((<*>), (<**>))
import Control.Category((.), id)
import Control.Lens((%~), lens, (&))
import Data.Bool(bool)
import Data.Char(toUpper)
import Data.Aviation.Casa.AbbreviationsAndAcronyms.Acronym(HasAcronym(acronym), Acronym, name)
import Data.Aviation.Casa.AbbreviationsAndAcronyms.Render(renderHeaderAcronyms, renderAcronyms)
import Data.Aviation.Casa.AbbreviationsAndAcronyms.Render.Colours(Colours, standardColours)
import Data.Aviation.Casa.AbbreviationsAndAcronyms.Render.Config(ConfigReader, Config(Config), runConfig)
import Data.Aviation.Casa.AbbreviationsAndAcronyms.Render.Score(HasShowScore(showScore))
import Data.Aviation.Casa.AbbreviationsAndAcronyms.Render.Spacing(nameSpacing, meaningSpacing, sourceSpacing, scoreSpacing, exactWidthSpacing)
import Data.Aviation.Casa.AbbreviationsAndAcronyms.Search(searchFuzzyNameMeaningSource, searchIndexNameMeaningSource, searchFuzzyNameMeaning, searchIndexNameMeaning, searchFuzzyNameSource, searchIndexNameSource, searchFuzzyName, searchIndexName)
import Data.Bool(Bool(False, True))
import Data.Eq(Eq)
import Data.Foldable(foldr)
import Data.Function(($))
import Data.Functor((<$>), fmap)
import Data.Int(Int)
import Data.List(filter, take)
import Data.Maybe(Maybe(Just, Nothing), maybe, maybeToList)
import Data.Monoid(Monoid(mempty))
import Data.Ord(Ord((>=), (>)), max, min)
import Data.Semigroup((<>))
import Data.String(String)
import Data.Traversable(Traversable(traverse))
import Options.Applicative(Parser, execParser, info, helper, fullDesc, header, option, maybeReader, short, long, value, help, switch, strOption)
import Prelude(Show(show))
import System.IO(IO, putStrLn)
import Text.Fuzzy(Fuzzy(Fuzzy))
import Text.Read(reads)

main ::
  IO ()
main =
  let execopts =
        execParser
          (info (parserOptions <**> helper) (
            fullDesc <>
            header "casa-abbreviations-and-acronyms for searching CASA abbreviations and acronyms 0.0.5 <https://www.casa.gov.au/about-us/standard-page/aviation-abbreviations-and-acronyms>"
          )
        )
  in  do  opts <- execopts
          case opts of
            Options clrs rndr maxr (MatchField fz ex) typ (FieldSpacing mn xn mm xm ms xs mr xr) term ->
              let acro =
                    let match =
                          fmap (\o -> (o & name . traverse %~ toUpper)) .
                            case typ of
                              ExactMatch ->
                                fmap (\a -> ShowAcronym a "-") . maybeToList . ex
                              InexactMatch x ->
                                fmap (\(Fuzzy o _ s) -> ShowAcronym o (show s)) . maybe id (\n -> filter (\(Fuzzy _ _ s) -> s >= n)) x . fz
                    in  match term
                  space =
                    foldr
                      (\(a, b, c) w ->  let k val func = a %~ maybe id func val
                                        in  if b > c
                                              then
                                                id
                                              else
                                                k b max . k c min . w)
                      id
                      [
                        (nameSpacing, mn, xn)
                      , (meaningSpacing, mm, xm)
                      , (sourceSpacing, ms, xs)
                      , (scoreSpacing, mr, xr)
                      ]
                  acro' =
                    maybe id take maxr acro
                  out =
                    runConfig
                      (rndr acro')
                      (space $ Config clrs (exactWidthSpacing acro'))
              in  putStrLn out

data ShowAcronym =
  ShowAcronym
    Acronym
    String -- score
  deriving (Eq, Ord, Show)

instance HasAcronym ShowAcronym where
  acronym =
    lens
      (\(ShowAcronym a _) -> a)
      (\(ShowAcronym _ s) a -> ShowAcronym a s)
      
instance HasShowScore ShowAcronym where
  showScore =
    lens
      (\(ShowAcronym _ s) -> s)
      (\(ShowAcronym a _) s -> ShowAcronym a s)

data MatchField =
  MatchField
    (String -> [Fuzzy Acronym String])
    (String -> Maybe Acronym)

matchField' ::
  (String -> String -> String -> Bool -> [Fuzzy Acronym String])
  -> (String -> Maybe Acronym)
  -> MatchField
matchField' f g =
  MatchField (\s -> f s "" "" False) g

parserMatchField ::
  Parser MatchField
parserMatchField =
  (
    \p q -> 
        case p of
      False ->
        case q of
          False ->
            matchField'
              searchFuzzyNameMeaningSource
              searchIndexNameMeaningSource
          True ->
            matchField'
              searchFuzzyNameMeaning
              searchIndexNameMeaning
      True ->
        case q of
          False ->
            matchField'
              searchFuzzyNameSource
              searchIndexNameSource
          True ->
            matchField'
              searchFuzzyName
              searchIndexName
  ) <$>
    switch
      (
        long "no-match-meaning" <>
        long "nm" <>
        help "do not match the acronym meaning"
      )
    <*>
        switch
      (
        long "no-match-source" <>
        long "ns" <>
        help "do not match the acronym source"
      )

data MatchType =
  ExactMatch
  | InexactMatch (Maybe Int)
  deriving (Eq, Ord, Show)

parserMatchType ::
  Parser MatchType
parserMatchType =
  let opts exact minscore =
        if exact
          then
            ExactMatch
          else
            InexactMatch minscore
  in  opts <$>
        switch
          (
            short 'e' <>
            long "exact" <>
            help "match the search term exactly"
          ) <*>
        option
          (
            maybeReader
              (\s -> case reads s of
                        (n, _):_ ->
                          Just (Just n)
                        [] ->
                          Nothing)
          )
          (
            short 's' <>
            long "min-score" <>
            value Nothing <>
            help "minimum fuzzy match score"
          )

data FieldSpacing =
  FieldSpacing
    (Maybe Int) -- min name
    (Maybe Int) -- max name
    (Maybe Int) -- min meaning
    (Maybe Int) -- max meaning
    (Maybe Int) -- min source
    (Maybe Int) -- max source
    (Maybe Int) -- min score
    (Maybe Int) -- max score
  deriving (Eq, Ord, Show)    

parserFieldSpacing ::
  Parser FieldSpacing
parserFieldSpacing =
  let minmaxWidth longname1 longname2 helptext =
        option
          (
            maybeReader
              (\s -> case reads s of
                        (n, _):_ ->
                          Just (Just n)
                        [] ->
                          Nothing)

          )
          (
            long longname1 <>
            long longname2 <>
            value Nothing <>
            help helptext
          )
  in  FieldSpacing <$>
        minmaxWidth "min-name-width" "mn" "minimum acronym name column width"
        <*>
        minmaxWidth "max-name-width" "xn" "maximum acronym name column width"
        <*>
        minmaxWidth "min-meaning-width" "mm" "minimum acronym meaning column width"
        <*>
        minmaxWidth "max-meaning-width" "xm" "maximum acronym meaning column width"
        <*>
        minmaxWidth "min-source-width" "ms" "minimum acronym source column width"
        <*>
        minmaxWidth "max-source-width" "xs" "maximum acronym source column width"
        <*>
        minmaxWidth "min-score-width" "mr" "minimum score column width"
        <*>
        minmaxWidth "max-score-width" "xr" "maximum score column width"
        
data Options t a =
  Options
    Colours -- no colours
    (t a -> ConfigReader String) -- no header
    (Maybe Int) -- maximum results
    MatchField
    MatchType
    FieldSpacing
    String -- the search term

parserOptions ::
  (HasShowScore a, HasAcronym a, Traversable t) =>
  Parser (Options t a)
parserOptions =
  Options <$>
    (
      bool standardColours mempty <$>
      switch
        (
          short 'c' <>
          long "no-colour" <>
          help "turn off ANSI escape code colours"
        )
    )
    <*>
    (
      (bool renderHeaderAcronyms renderAcronyms) <$>
      switch
        (
          short 'h' <>
          long "no-header" <>
          help "turn off the header in the output"
        )
    )
    <*>
    option
      (
        maybeReader
          (\s -> case reads s of
                    (n, _):_ ->
                      Just (Just n)
                    [] ->
                      Nothing)
      )
      (
        short 'x' <>
        long "max-results" <>
        value Nothing <>
        help "maximum number of results"
      )
    <*>
    parserMatchField
    <*>
    parserMatchType
    <*>
    parserFieldSpacing
    <*>
    strOption
      (
        short 't' <>
        long "term" <>
        help "the search term"
      )