{-# OPTIONS_GHC -Wmissing-fields #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes       #-}
-- empty the map (ref HMap) 
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-}
-- {-# LANGUAGE DisambiguateRecordFields #-}
{-# LANGUAGE ScopedTypeVariables #-}
-- {-# LANGUAGE StrictData #-}

-- https://github.com/ndmitchell/record-dot-preprocessor#readme
-- dot operator for record
-- {-# OPTIONS_GHC -fplugin=RecordDotPreprocessor #-}
-- {-# LANGUAGE TypeApplications, FlexibleContexts, DataKinds, MultiParamTypeClasses, TypeSynonymInstances, FlexibleInstances #-}

{-| 
    The Module contains all the functions for __haskellwebapp2__

    * Use Aeson to serialize record to Json
    * Record: Person
    * Insert data to MySqlit-simple file-based database
    * Upload file to server.
    * Use Redis(memcached) to store snippet and query snippet.
    * *src/aronlib.js* is symbollink to *$b/jslib/aronjs.js*
    * All Javascript functions are in *src/aronlib.js*
    * Use 'responseJavascript' to send *src/aronlib.js* to client side.
-} 
module WaiLib where

import Data.Default
import Data.Typeable (typeOf)
import Data.Typeable 
import Network.Wai
import Network.HTTP.Types
import Network.HTTP.Types.Header
import Network.Wai.Handler.Warp (run)
import Control.Monad
import Data.Char
import Data.Maybe
import Data.List
import Data.List.Split
import Data.Time
import Data.IORef 
import Data.Time.Clock.POSIX
import System.Directory
import System.Environment
import System.Exit
import System.FilePath.Posix
import System.IO
import System.Posix.Files
import System.Posix.Unistd
import System.Process
import Text.Read

import Text.Regex
import Text.Regex.Base
import Text.Regex.Base.RegexLike
import Text.Regex.Posix
import Text.RE.TDFA.String
import Control.Lens ((^.))

-- Wednesday, 13 October 2021 14:39 PDT
-- Try to handle APL symbol code,
-- Other Regex crash:)
import qualified Text.Regex.Applicative as TRA


import Network.Wai.Parse
import Blaze.ByteString.Builder.Char.Utf8 (fromString)
import Data.ByteString.Builder (byteString, Builder)

import qualified Text.Email.Validate            as EM 
import qualified Data.Word8                     as DW
import qualified Data.Text                      as TS               -- strict Text         
import qualified Data.Text.Lazy                 as DL
import qualified Data.Text.Lazy.IO              as LIO
import qualified Data.Text.IO                   as TIO 

import qualified Control.Concurrent             as Concurrent
import qualified Data.List                      as L
import qualified Data.HashMap.Strict            as M 
import qualified Control.Exception              as Exception
import qualified Safe

import qualified Data.ByteString.UTF8          as BU
import qualified Data.ByteString.Lazy.Internal as IN (ByteString)
import qualified Data.ByteString.Char8      as S8 (unpack,pack, putStrLn)   -- strict ?
import qualified Data.ByteString.Lazy       as LA (writeFile, fromChunks, fromStrict)
import qualified Data.ByteString.Lazy.Char8 as LC 
import qualified Data.ByteString            as BS
import qualified Data.ByteString.Internal   as BI (c2w, w2c)


import qualified Turtle as TUR -- (empty, shellStrictWithErr, ExitCode)
-- import Data.Text.Lazy -- lazy Text

import Network.HTTP.Types (status200)
import Network.Wai
-- import Network.Wai.Handler.Warp (run)
import qualified Network.Wai.Handler.Warp as WARP
import Network.Wai.Util
import Network.URI
import Network.HTTP.Types.Status
import Network.Wai.Handler.WebSockets (websocketsOr)
import qualified Network.WebSockets             as WS
import qualified Control.Exception              as EXP
       
import Language.Haskell.Ghcid

-- import qualified Network.Wai.Handler.WebSockets as WS

-- {-# LANGUAGE QuasiQuotes       #-}
import Text.RawString.QQ (r)         -- Need QuasiQuotes too 

-- http://hackage.haskell.org/package/neat-interpolation-0.3.2.4/docs/NeatInterpolation.html
import qualified NeatInterpolation as NI -- variable interpolation

-- remove it since there is issue to build in stack
-- copy the source code and create a module called PortableLines
-- import qualified Text.PortableLines as POR   -- (lines replace window newline '\r\n' with '\n')

import           Data.Int (Int64)
import           Database.SQLite.Simple
import           Database.SQLite.Simple.FromRow
import           Database.SQLite.Simple.ToRow
import           Database.SQLite.Simple.FromField
import           Database.SQLite.Simple.ToField
import           Database.SQLite.Simple.Internal
import           Database.SQLite.Simple.Ok
import  qualified Database.SQLite.Simple.Types as DQ

import           GHC.Generics
import qualified Data.Aeson as DA
import Data.Aeson.Text (encodeToLazyText)
-- import Data.Aeson (ToJSON, decode, encode)

import qualified Data.ByteString.Lazy      as BL
import qualified Data.ByteString.UTF8      as BSU
import qualified Data.ByteString           as BS
import qualified Data.Text                 as TS    -- strict Text

import qualified Data.Text.Lazy            as TL    -- lazy Text
import qualified Data.Text.Encoding        as TSE
import qualified Data.Text.Lazy.Encoding   as TLE

import qualified Data.Bifunctor            as DB


-- BEG_993 concurrency
import System.Timeout
-- import Criterion.Measurement
import System.IO.Unsafe
import System.Process
import Control.Exception
import System.IO
import System.IO.Error
import GHC.IO.Exception
import System.Exit
import Control.Concurrent.MVar
import Control.Concurrent
-- END_993 concurrency
-- import Control.Concurrent (forkIO, threadDelay)



-- import PortableLines
-- import AronModule                hiding(run, cmd)
import AronModule hiding(run, cmd)
-- import HtmlForm                
import AronHtml                             as H1
import AronHtml2                            as H2 
import qualified AronModule                 as A
import qualified GenePDFHtmlLib             as PDF
import AronAlias
-- import qualified WaiConstant                as WC 



{-| 
    KEY: Say something
    
    M-x openurl
    help: file:///Users/aaa/myfile/bitbucket/stackproject/jupyterlab/jupyterlab.html
    gx /Library/WebServer/Documents/xfido/image/foldlistimage.jpg 
-} 

-- query_redis = "/Users/aaa/myfile/symbin/RedisQuery "
query_redis :: [Char]
query_redis = [Char]
"RedisQuery "
eleIdCodeBlock :: [Char]
eleIdCodeBlock=[Char]
"t"
pdfdir :: [Char]
pdfdir = [Char]
"pdf"

{-|
    KEY: Last snippet command is stored in Redis database, last redis cmd

-}
keyLastCmd::String
keyLastCmd :: [Char]
keyLastCmd = [Char]
"keyLastCmd"

indexEditorHTML :: [Char]
indexEditorHTML = [Char]
"src/datadir/latex/indexEditorACE/indexEditorACE.html"
indexEditorJSON :: [Char]
indexEditorJSON = [Char]
"src/datadir/latex/indexEditorACE/indexEditorACE.json"

s2Text :: [Char] -> Text
s2Text = [Char] -> Text
strToStrictText

data Block = Block{Block -> [Text]
bblock::[DL.Text]} deriving ((forall x. Block -> Rep Block x)
-> (forall x. Rep Block x -> Block) -> Generic Block
forall x. Rep Block x -> Block
forall x. Block -> Rep Block x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Block x -> Block
$cfrom :: forall x. Block -> Rep Block x
Generic, Int -> Block -> ShowS
[Block] -> ShowS
Block -> [Char]
(Int -> Block -> ShowS)
-> (Block -> [Char]) -> ([Block] -> ShowS) -> Show Block
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Block] -> ShowS
$cshowList :: [Block] -> ShowS
show :: Block -> [Char]
$cshow :: Block -> [Char]
showsPrec :: Int -> Block -> ShowS
$cshowsPrec :: Int -> Block -> ShowS
Show)
data MBlock = MBlock{MBlock -> [Integer]
mblock::[Integer]} deriving ((forall x. MBlock -> Rep MBlock x)
-> (forall x. Rep MBlock x -> MBlock) -> Generic MBlock
forall x. Rep MBlock x -> MBlock
forall x. MBlock -> Rep MBlock x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MBlock x -> MBlock
$cfrom :: forall x. MBlock -> Rep MBlock x
Generic, Int -> MBlock -> ShowS
[MBlock] -> ShowS
MBlock -> [Char]
(Int -> MBlock -> ShowS)
-> (MBlock -> [Char]) -> ([MBlock] -> ShowS) -> Show MBlock
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [MBlock] -> ShowS
$cshowList :: [MBlock] -> ShowS
show :: MBlock -> [Char]
$cshow :: MBlock -> [Char]
showsPrec :: Int -> MBlock -> ShowS
$cshowsPrec :: Int -> MBlock -> ShowS
Show)
data GeneMatrix = GeneMatrix{
                             GeneMatrix -> Text
cmd :: TS.Text,
                             GeneMatrix -> Integer
ncol :: Integer,
                             GeneMatrix -> Integer
nrow :: Integer 
                            } deriving ((forall x. GeneMatrix -> Rep GeneMatrix x)
-> (forall x. Rep GeneMatrix x -> GeneMatrix) -> Generic GeneMatrix
forall x. Rep GeneMatrix x -> GeneMatrix
forall x. GeneMatrix -> Rep GeneMatrix x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GeneMatrix x -> GeneMatrix
$cfrom :: forall x. GeneMatrix -> Rep GeneMatrix x
Generic, Int -> GeneMatrix -> ShowS
[GeneMatrix] -> ShowS
GeneMatrix -> [Char]
(Int -> GeneMatrix -> ShowS)
-> (GeneMatrix -> [Char])
-> ([GeneMatrix] -> ShowS)
-> Show GeneMatrix
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [GeneMatrix] -> ShowS
$cshowList :: [GeneMatrix] -> ShowS
show :: GeneMatrix -> [Char]
$cshow :: GeneMatrix -> [Char]
showsPrec :: Int -> GeneMatrix -> ShowS
$cshowsPrec :: Int -> GeneMatrix -> ShowS
Show)

instance DA.FromJSON GeneMatrix 
instance DA.ToJSON GeneMatrix where
    toEncoding :: GeneMatrix -> Encoding
toEncoding = Options -> GeneMatrix -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
DA.genericToEncoding Options
DA.defaultOptions

-- create instance of FromJSon an ToJSon
data Bgcolor = Bgcolor{ Bgcolor -> Text
colorname :: TS.Text } deriving ((forall x. Bgcolor -> Rep Bgcolor x)
-> (forall x. Rep Bgcolor x -> Bgcolor) -> Generic Bgcolor
forall x. Rep Bgcolor x -> Bgcolor
forall x. Bgcolor -> Rep Bgcolor x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Bgcolor x -> Bgcolor
$cfrom :: forall x. Bgcolor -> Rep Bgcolor x
Generic, Int -> Bgcolor -> ShowS
[Bgcolor] -> ShowS
Bgcolor -> [Char]
(Int -> Bgcolor -> ShowS)
-> (Bgcolor -> [Char]) -> ([Bgcolor] -> ShowS) -> Show Bgcolor
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Bgcolor] -> ShowS
$cshowList :: [Bgcolor] -> ShowS
show :: Bgcolor -> [Char]
$cshow :: Bgcolor -> [Char]
showsPrec :: Int -> Bgcolor -> ShowS
$cshowsPrec :: Int -> Bgcolor -> ShowS
Show)
instance DA.FromJSON Bgcolor
instance DA.ToJSON Bgcolor where
    toEncoding :: Bgcolor -> Encoding
toEncoding = Options -> Bgcolor -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
DA.genericToEncoding Options
DA.defaultOptions

data Textcolor = Textcolor{ Textcolor -> Text
textcolor :: TS.Text } deriving ((forall x. Textcolor -> Rep Textcolor x)
-> (forall x. Rep Textcolor x -> Textcolor) -> Generic Textcolor
forall x. Rep Textcolor x -> Textcolor
forall x. Textcolor -> Rep Textcolor x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Textcolor x -> Textcolor
$cfrom :: forall x. Textcolor -> Rep Textcolor x
Generic, Int -> Textcolor -> ShowS
[Textcolor] -> ShowS
Textcolor -> [Char]
(Int -> Textcolor -> ShowS)
-> (Textcolor -> [Char])
-> ([Textcolor] -> ShowS)
-> Show Textcolor
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Textcolor] -> ShowS
$cshowList :: [Textcolor] -> ShowS
show :: Textcolor -> [Char]
$cshow :: Textcolor -> [Char]
showsPrec :: Int -> Textcolor -> ShowS
$cshowsPrec :: Int -> Textcolor -> ShowS
Show)
instance DA.FromJSON Textcolor
instance DA.ToJSON Textcolor where
    toEncoding :: Textcolor -> Encoding
toEncoding = Options -> Textcolor -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
DA.genericToEncoding Options
DA.defaultOptions

data User = User   {User -> Int64
uid::Int64, User -> Text
name::TS.Text, User -> Text
email::TS.Text, User -> Text
password::TS.Text, User -> Text
task::TS.Text, User -> Integer
money::Integer} deriving (Int -> User -> ShowS
[User] -> ShowS
User -> [Char]
(Int -> User -> ShowS)
-> (User -> [Char]) -> ([User] -> ShowS) -> Show User
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [User] -> ShowS
$cshowList :: [User] -> ShowS
show :: User -> [Char]
$cshow :: User -> [Char]
showsPrec :: Int -> User -> ShowS
$cshowsPrec :: Int -> User -> ShowS
Show, User -> User -> Bool
(User -> User -> Bool) -> (User -> User -> Bool) -> Eq User
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: User -> User -> Bool
$c/= :: User -> User -> Bool
== :: User -> User -> Bool
$c== :: User -> User -> Bool
Eq, ReadPrec [User]
ReadPrec User
Int -> ReadS User
ReadS [User]
(Int -> ReadS User)
-> ReadS [User] -> ReadPrec User -> ReadPrec [User] -> Read User
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [User]
$creadListPrec :: ReadPrec [User]
readPrec :: ReadPrec User
$creadPrec :: ReadPrec User
readList :: ReadS [User]
$creadList :: ReadS [User]
readsPrec :: Int -> ReadS User
$creadsPrec :: Int -> ReadS User
Read)
data Image = Image {Image -> Int64
iid::Int64, Image -> Text
imagename::TS.Text, Image -> Int64
uid::Int64} deriving (Int -> Image -> ShowS
[Image] -> ShowS
Image -> [Char]
(Int -> Image -> ShowS)
-> (Image -> [Char]) -> ([Image] -> ShowS) -> Show Image
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Image] -> ShowS
$cshowList :: [Image] -> ShowS
show :: Image -> [Char]
$cshow :: Image -> [Char]
showsPrec :: Int -> Image -> ShowS
$cshowsPrec :: Int -> Image -> ShowS
Show, Image -> Image -> Bool
(Image -> Image -> Bool) -> (Image -> Image -> Bool) -> Eq Image
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Image -> Image -> Bool
$c/= :: Image -> Image -> Bool
== :: Image -> Image -> Bool
$c== :: Image -> Image -> Bool
Eq, ReadPrec [Image]
ReadPrec Image
Int -> ReadS Image
ReadS [Image]
(Int -> ReadS Image)
-> ReadS [Image]
-> ReadPrec Image
-> ReadPrec [Image]
-> Read Image
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Image]
$creadListPrec :: ReadPrec [Image]
readPrec :: ReadPrec Image
$creadPrec :: ReadPrec Image
readList :: ReadS [Image]
$creadList :: ReadS [Image]
readsPrec :: Int -> ReadS Image
$creadsPrec :: Int -> ReadS Image
Read)

instance FromRow User where
  fromRow :: RowParser User
fromRow = Int64 -> Text -> Text -> Text -> Text -> Integer -> User
User (Int64 -> Text -> Text -> Text -> Text -> Integer -> User)
-> RowParser Int64
-> RowParser (Text -> Text -> Text -> Text -> Integer -> User)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RowParser Int64
forall a. FromField a => RowParser a
field RowParser (Text -> Text -> Text -> Text -> Integer -> User)
-> RowParser Text
-> RowParser (Text -> Text -> Text -> Integer -> User)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser Text
forall a. FromField a => RowParser a
field RowParser (Text -> Text -> Text -> Integer -> User)
-> RowParser Text -> RowParser (Text -> Text -> Integer -> User)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser Text
forall a. FromField a => RowParser a
field RowParser (Text -> Text -> Integer -> User)
-> RowParser Text -> RowParser (Text -> Integer -> User)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser Text
forall a. FromField a => RowParser a
field RowParser (Text -> Integer -> User)
-> RowParser Text -> RowParser (Integer -> User)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser Text
forall a. FromField a => RowParser a
field RowParser (Integer -> User) -> RowParser Integer -> RowParser User
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser Integer
forall a. FromField a => RowParser a
field

instance FromRow Image where
  fromRow :: RowParser Image
fromRow = Int64 -> Text -> Int64 -> Image
Image (Int64 -> Text -> Int64 -> Image)
-> RowParser Int64 -> RowParser (Text -> Int64 -> Image)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RowParser Int64
forall a. FromField a => RowParser a
field RowParser (Text -> Int64 -> Image)
-> RowParser Text -> RowParser (Int64 -> Image)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser Text
forall a. FromField a => RowParser a
field RowParser (Int64 -> Image) -> RowParser Int64 -> RowParser Image
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser Int64
forall a. FromField a => RowParser a
field

instance ToRow User where
  toRow :: User -> [SQLData]
toRow (User Int64
_uid Text
name Text
email Text
password Text
task Integer
money) = (Text, Text, Text, Text, Integer) -> [SQLData]
forall a. ToRow a => a -> [SQLData]
toRow (Text
name, Text
email, Text
password, Text
task, Integer
money)

instance ToRow Image where
  toRow :: Image -> [SQLData]
toRow (Image Int64
_iid Text
imagename Int64
uid) = (Text, Int64) -> [SQLData]
forall a. ToRow a => a -> [SQLData]
toRow (Text
imagename, Int64
uid)

data TodoItem =
  TodoItem
    {
      TodoItem -> Int64
todoId :: Int64,
      TodoItem -> Text
keyItem :: TS.Text,
      TodoItem -> Text
todoItem :: TS.Text
    } deriving ((forall x. TodoItem -> Rep TodoItem x)
-> (forall x. Rep TodoItem x -> TodoItem) -> Generic TodoItem
forall x. Rep TodoItem x -> TodoItem
forall x. TodoItem -> Rep TodoItem x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TodoItem x -> TodoItem
$cfrom :: forall x. TodoItem -> Rep TodoItem x
Generic, TodoItem -> TodoItem -> Bool
(TodoItem -> TodoItem -> Bool)
-> (TodoItem -> TodoItem -> Bool) -> Eq TodoItem
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TodoItem -> TodoItem -> Bool
$c/= :: TodoItem -> TodoItem -> Bool
== :: TodoItem -> TodoItem -> Bool
$c== :: TodoItem -> TodoItem -> Bool
Eq, ReadPrec [TodoItem]
ReadPrec TodoItem
Int -> ReadS TodoItem
ReadS [TodoItem]
(Int -> ReadS TodoItem)
-> ReadS [TodoItem]
-> ReadPrec TodoItem
-> ReadPrec [TodoItem]
-> Read TodoItem
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TodoItem]
$creadListPrec :: ReadPrec [TodoItem]
readPrec :: ReadPrec TodoItem
$creadPrec :: ReadPrec TodoItem
readList :: ReadS [TodoItem]
$creadList :: ReadS [TodoItem]
readsPrec :: Int -> ReadS TodoItem
$creadsPrec :: Int -> ReadS TodoItem
Read, Int -> TodoItem -> ShowS
[TodoItem] -> ShowS
TodoItem -> [Char]
(Int -> TodoItem -> ShowS)
-> (TodoItem -> [Char]) -> ([TodoItem] -> ShowS) -> Show TodoItem
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [TodoItem] -> ShowS
$cshowList :: [TodoItem] -> ShowS
show :: TodoItem -> [Char]
$cshow :: TodoItem -> [Char]
showsPrec :: Int -> TodoItem -> ShowS
$cshowsPrec :: Int -> TodoItem -> ShowS
Show)

    
instance DA.FromJSON TodoItem
instance DA.ToJSON TodoItem where
    toEncoding :: TodoItem -> Encoding
toEncoding = Options -> TodoItem -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
DA.genericToEncoding Options
DA.defaultOptions
    
  {--
instance ToRow TodoItem where
  toRow (TodoItem _todoId key_item todo_item) = toRow (todoId, keyItem, todoItem)
  --}
    
    {--
data TodoJSON = TodoJSON{
  keyItem :: String,
  todoX::String
  } deriving (GEN.Generic, Show)
instance DA.FromJSON TodoJSON
instance DA.ToJSON TodoJSON where
    toEncoding = DA.genericToEncoding DA.defaultOptions
    --}
    
data TodoReply = TodoReply{
                            TodoReply -> Text
cmdReply :: TS.Text
                          } deriving ((forall x. TodoReply -> Rep TodoReply x)
-> (forall x. Rep TodoReply x -> TodoReply) -> Generic TodoReply
forall x. Rep TodoReply x -> TodoReply
forall x. TodoReply -> Rep TodoReply x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TodoReply x -> TodoReply
$cfrom :: forall x. TodoReply -> Rep TodoReply x
Generic, Int -> TodoReply -> ShowS
[TodoReply] -> ShowS
TodoReply -> [Char]
(Int -> TodoReply -> ShowS)
-> (TodoReply -> [Char])
-> ([TodoReply] -> ShowS)
-> Show TodoReply
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [TodoReply] -> ShowS
$cshowList :: [TodoReply] -> ShowS
show :: TodoReply -> [Char]
$cshow :: TodoReply -> [Char]
showsPrec :: Int -> TodoReply -> ShowS
$cshowsPrec :: Int -> TodoReply -> ShowS
Show)

instance DA.FromJSON TodoReply
instance DA.ToJSON TodoReply where
    toEncoding :: TodoReply -> Encoding
toEncoding = Options -> TodoReply -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
DA.genericToEncoding Options
DA.defaultOptions

{--
instance FromRow TodoItem where
   fromRow = TodoItem <$> field <*> field
--}
  
data CompileCode = CompileCode{
                                CompileCode -> Text
compiler :: TS.Text,
                                CompileCode -> Text
option :: TS.Text,
                                CompileCode -> Text
code :: TS.Text 
                              } deriving ((forall x. CompileCode -> Rep CompileCode x)
-> (forall x. Rep CompileCode x -> CompileCode)
-> Generic CompileCode
forall x. Rep CompileCode x -> CompileCode
forall x. CompileCode -> Rep CompileCode x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CompileCode x -> CompileCode
$cfrom :: forall x. CompileCode -> Rep CompileCode x
Generic, Int -> CompileCode -> ShowS
[CompileCode] -> ShowS
CompileCode -> [Char]
(Int -> CompileCode -> ShowS)
-> (CompileCode -> [Char])
-> ([CompileCode] -> ShowS)
-> Show CompileCode
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [CompileCode] -> ShowS
$cshowList :: [CompileCode] -> ShowS
show :: CompileCode -> [Char]
$cshow :: CompileCode -> [Char]
showsPrec :: Int -> CompileCode -> ShowS
$cshowsPrec :: Int -> CompileCode -> ShowS
Show)

instance DA.FromJSON CompileCode 
instance DA.ToJSON CompileCode where
    toEncoding :: CompileCode -> Encoding
toEncoding = Options -> CompileCode -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
DA.genericToEncoding Options
DA.defaultOptions


-- Send to client => JSON [[Integer]]
data MatInt = MatInt{MatInt -> Text
name::TS.Text, MatInt -> [[Integer]]
matrix::[[Integer]]} deriving ((forall x. MatInt -> Rep MatInt x)
-> (forall x. Rep MatInt x -> MatInt) -> Generic MatInt
forall x. Rep MatInt x -> MatInt
forall x. MatInt -> Rep MatInt x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MatInt x -> MatInt
$cfrom :: forall x. MatInt -> Rep MatInt x
Generic, Int -> MatInt -> ShowS
[MatInt] -> ShowS
MatInt -> [Char]
(Int -> MatInt -> ShowS)
-> (MatInt -> [Char]) -> ([MatInt] -> ShowS) -> Show MatInt
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [MatInt] -> ShowS
$cshowList :: [MatInt] -> ShowS
show :: MatInt -> [Char]
$cshow :: MatInt -> [Char]
showsPrec :: Int -> MatInt -> ShowS
$cshowsPrec :: Int -> MatInt -> ShowS
Show)
instance DA.FromJSON MatInt 
instance DA.ToJSON MatInt where
    toEncoding :: MatInt -> Encoding
toEncoding = Options -> MatInt -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
DA.genericToEncoding Options
DA.defaultOptions

data SnippetJSON = SnippetJSON{SnippetJSON -> [Integer]
pidls::[Integer], SnippetJSON -> Text
name::TS.Text, SnippetJSON -> [[[Char]]]
snippet::[[String]]} deriving ((forall x. SnippetJSON -> Rep SnippetJSON x)
-> (forall x. Rep SnippetJSON x -> SnippetJSON)
-> Generic SnippetJSON
forall x. Rep SnippetJSON x -> SnippetJSON
forall x. SnippetJSON -> Rep SnippetJSON x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SnippetJSON x -> SnippetJSON
$cfrom :: forall x. SnippetJSON -> Rep SnippetJSON x
Generic, Int -> SnippetJSON -> ShowS
[SnippetJSON] -> ShowS
SnippetJSON -> [Char]
(Int -> SnippetJSON -> ShowS)
-> (SnippetJSON -> [Char])
-> ([SnippetJSON] -> ShowS)
-> Show SnippetJSON
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [SnippetJSON] -> ShowS
$cshowList :: [SnippetJSON] -> ShowS
show :: SnippetJSON -> [Char]
$cshow :: SnippetJSON -> [Char]
showsPrec :: Int -> SnippetJSON -> ShowS
$cshowsPrec :: Int -> SnippetJSON -> ShowS
Show)
instance DA.FromJSON SnippetJSON
instance DA.ToJSON SnippetJSON where
    toEncoding :: SnippetJSON -> Encoding
toEncoding = Options -> SnippetJSON -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
DA.genericToEncoding Options
DA.defaultOptions

    
-- Generate HTML table in Server side
-- Send to client in JSON format [[TS.Text]]
-- Client can display it on Browser
--
-- Send to client => JSON [[TS.Text]]
data HTMLTable = HTMLTable{HTMLTable -> Text
name::TS.Text, HTMLTable -> [Text]
matrix::[TS.Text]} deriving ((forall x. HTMLTable -> Rep HTMLTable x)
-> (forall x. Rep HTMLTable x -> HTMLTable) -> Generic HTMLTable
forall x. Rep HTMLTable x -> HTMLTable
forall x. HTMLTable -> Rep HTMLTable x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HTMLTable x -> HTMLTable
$cfrom :: forall x. HTMLTable -> Rep HTMLTable x
Generic, Int -> HTMLTable -> ShowS
[HTMLTable] -> ShowS
HTMLTable -> [Char]
(Int -> HTMLTable -> ShowS)
-> (HTMLTable -> [Char])
-> ([HTMLTable] -> ShowS)
-> Show HTMLTable
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [HTMLTable] -> ShowS
$cshowList :: [HTMLTable] -> ShowS
show :: HTMLTable -> [Char]
$cshow :: HTMLTable -> [Char]
showsPrec :: Int -> HTMLTable -> ShowS
$cshowsPrec :: Int -> HTMLTable -> ShowS
Show)
instance DA.FromJSON HTMLTable
instance DA.ToJSON HTMLTable where
    toEncoding :: HTMLTable -> Encoding
toEncoding = Options -> HTMLTable -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
DA.genericToEncoding Options
DA.defaultOptions

data PreColor = PreColor {PreColor -> Text
color::TS.Text, PreColor -> Text
background::TS.Text} deriving ((forall x. PreColor -> Rep PreColor x)
-> (forall x. Rep PreColor x -> PreColor) -> Generic PreColor
forall x. Rep PreColor x -> PreColor
forall x. PreColor -> Rep PreColor x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PreColor x -> PreColor
$cfrom :: forall x. PreColor -> Rep PreColor x
Generic, Int -> PreColor -> ShowS
[PreColor] -> ShowS
PreColor -> [Char]
(Int -> PreColor -> ShowS)
-> (PreColor -> [Char]) -> ([PreColor] -> ShowS) -> Show PreColor
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [PreColor] -> ShowS
$cshowList :: [PreColor] -> ShowS
show :: PreColor -> [Char]
$cshow :: PreColor -> [Char]
showsPrec :: Int -> PreColor -> ShowS
$cshowsPrec :: Int -> PreColor -> ShowS
Show)
instance DA.FromJSON PreColor
instance DA.ToJSON PreColor where
    toEncoding :: PreColor -> Encoding
toEncoding = Options -> PreColor -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
DA.genericToEncoding Options
DA.defaultOptions

 
updateRetcmd::String -> CodeBlockReply -> CodeBlockReply
updateRetcmd :: [Char] -> CodeBlockReply -> CodeBlockReply
updateRetcmd [Char]
s CodeBlockReply
u = CodeBlockReply
u { $sel:retcmd:CodeBlockReply :: [Char]
retcmd = [Char]
s}

updateOk::String -> CodeBlockReply -> CodeBlockReply
updateOk :: [Char] -> CodeBlockReply -> CodeBlockReply
updateOk [Char]
s CodeBlockReply
u = CodeBlockReply
u { $sel:ok:CodeBlockReply :: [Char]
ok = [Char]
s }
               
instance DA.FromJSON Block 
instance DA.ToJSON Block where
    -- No need to provide a toJSON implementation.

    -- For efficiency, we write a simple toEncoding implementation, as
    -- the default version uses toJSON.
    toEncoding :: Block -> Encoding
toEncoding = Options -> Block -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
DA.genericToEncoding Options
DA.defaultOptions

instance DA.FromJSON MBlock 
instance DA.ToJSON MBlock where
    -- No need to provide a toJSON implementation.

    -- For efficiency, we write a simple toEncoding implementation, as
    -- the default version uses toJSON.
    toEncoding :: MBlock -> Encoding
toEncoding = Options -> MBlock -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
DA.genericToEncoding Options
DA.defaultOptions

-- | Person to Json object
data Person =
  Person 
    { Person -> Int64
personId   :: Int64
    , Person -> Text
personName :: TS.Text
    , Person -> Text
personAge  :: TS.Text
    } deriving (Person -> Person -> Bool
(Person -> Person -> Bool)
-> (Person -> Person -> Bool) -> Eq Person
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Person -> Person -> Bool
$c/= :: Person -> Person -> Bool
== :: Person -> Person -> Bool
$c== :: Person -> Person -> Bool
Eq,ReadPrec [Person]
ReadPrec Person
Int -> ReadS Person
ReadS [Person]
(Int -> ReadS Person)
-> ReadS [Person]
-> ReadPrec Person
-> ReadPrec [Person]
-> Read Person
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Person]
$creadListPrec :: ReadPrec [Person]
readPrec :: ReadPrec Person
$creadPrec :: ReadPrec Person
readList :: ReadS [Person]
$creadList :: ReadS [Person]
readsPrec :: Int -> ReadS Person
$creadsPrec :: Int -> ReadS Person
Read,Int -> Person -> ShowS
[Person] -> ShowS
Person -> [Char]
(Int -> Person -> ShowS)
-> (Person -> [Char]) -> ([Person] -> ShowS) -> Show Person
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Person] -> ShowS
$cshowList :: [Person] -> ShowS
show :: Person -> [Char]
$cshow :: Person -> [Char]
showsPrec :: Int -> Person -> ShowS
$cshowsPrec :: Int -> Person -> ShowS
Show)

-- | define record for all the code blocks
--  can not define [TS.Text] => sqlite3 does not support [TS.Text]
-- data CodeBlock = 
--    CodeBlock 
--    { codeblockId        :: Int64
--    , header    :: TS.Text
--    , codeblock :: TS.Text
--    } deriving (Eq, Read, Show)




-- instance FromRow CodeBlock where
--  fromRow = CodeBlock <$> field <*> field <*> field

-- What is 'Only'
-- https://hackage.haskell.org/package/postgresql-simple-0.4.9.0/docs/Database-PostgreSQL-Simple.html#t:ToRow
-- instance ToRow CodeBlock where
--   toRow (CodeBlock _pId pHeader pCode) = toRow (pHeader, pCode)


{-| 
    === Create UserInput table in Sqlite
    * login database
    * sqite3 /Users/aaa/myfile/bitbucket/testfile/userinput.db
    * cmdId = pid
    * xcmd = input command, e.g. "c ls"
-} 
data UserInput =
  UserInput 
    { UserInput -> Int64
cmdId :: Int64
    , UserInput -> Text
xcmd :: TS.Text
    } deriving (UserInput -> UserInput -> Bool
(UserInput -> UserInput -> Bool)
-> (UserInput -> UserInput -> Bool) -> Eq UserInput
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UserInput -> UserInput -> Bool
$c/= :: UserInput -> UserInput -> Bool
== :: UserInput -> UserInput -> Bool
$c== :: UserInput -> UserInput -> Bool
Eq,ReadPrec [UserInput]
ReadPrec UserInput
Int -> ReadS UserInput
ReadS [UserInput]
(Int -> ReadS UserInput)
-> ReadS [UserInput]
-> ReadPrec UserInput
-> ReadPrec [UserInput]
-> Read UserInput
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UserInput]
$creadListPrec :: ReadPrec [UserInput]
readPrec :: ReadPrec UserInput
$creadPrec :: ReadPrec UserInput
readList :: ReadS [UserInput]
$creadList :: ReadS [UserInput]
readsPrec :: Int -> ReadS UserInput
$creadsPrec :: Int -> ReadS UserInput
Read,Int -> UserInput -> ShowS
[UserInput] -> ShowS
UserInput -> [Char]
(Int -> UserInput -> ShowS)
-> (UserInput -> [Char])
-> ([UserInput] -> ShowS)
-> Show UserInput
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [UserInput] -> ShowS
$cshowList :: [UserInput] -> ShowS
show :: UserInput -> [Char]
$cshow :: UserInput -> [Char]
showsPrec :: Int -> UserInput -> ShowS
$cshowsPrec :: Int -> UserInput -> ShowS
Show)

instance FromRow Person where
  fromRow :: RowParser Person
fromRow = Int64 -> Text -> Text -> Person
Person (Int64 -> Text -> Text -> Person)
-> RowParser Int64 -> RowParser (Text -> Text -> Person)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RowParser Int64
forall a. FromField a => RowParser a
field RowParser (Text -> Text -> Person)
-> RowParser Text -> RowParser (Text -> Person)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser Text
forall a. FromField a => RowParser a
field RowParser (Text -> Person) -> RowParser Text -> RowParser Person
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser Text
forall a. FromField a => RowParser a
field

instance FromRow UserInput where
  fromRow :: RowParser UserInput
fromRow = Int64 -> Text -> UserInput
UserInput (Int64 -> Text -> UserInput)
-> RowParser Int64 -> RowParser (Text -> UserInput)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RowParser Int64
forall a. FromField a => RowParser a
field RowParser (Text -> UserInput)
-> RowParser Text -> RowParser UserInput
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser Text
forall a. FromField a => RowParser a
field

-- when inserting a new Person, ignore personId. SQLite will provide it for us.
instance ToRow Person where
  toRow :: Person -> [SQLData]
toRow (Person Int64
_pId Text
pName Text
pAge) = (Text, Text) -> [SQLData]
forall a. ToRow a => a -> [SQLData]
toRow (Text
pAge, Text
pName)

-- http://hackage.haskell.org/package/sqlite-simple-0.4.16.0/docs/Database-SQLite-Simple.html#v:toRow
instance ToRow UserInput where
  toRow :: UserInput -> [SQLData]
toRow (UserInput Int64
_cmdId Text
md) = Only Text -> [SQLData]
forall a. ToRow a => a -> [SQLData]
toRow (Text -> Only Text
forall a. a -> Only a
Only Text
md)

updir :: [Char]
updir = [Char]
"/Users/aaa/myfile/bitbucket/haskellwebapp2/uploaddir/"

hiddenLATEXCODE :: [Char]
hiddenLATEXCODE = [Char]
"latexcode_replace314"
hiddenCOMPILESAVE :: [Char]
hiddenCOMPILESAVE = [Char]
"hidden_compile_save"



dbname :: [Char]
dbname = [Char]
"webappdb"
configFile :: [Char]
configFile = [Char]
"./config.txt"

lookupJust :: k -> HashMap k a -> a
lookupJust k
s HashMap k a
m = Maybe a -> a
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe a -> a) -> Maybe a -> a
forall a b. (a -> b) -> a -> b
$ k -> HashMap k a -> Maybe a
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup k
s HashMap k a
m

confMap::FilePath -> IO (M.HashMap String String)
confMap :: [Char] -> IO (HashMap [Char] [Char])
confMap [Char]
fp = do
  [Char]
os <- IO [Char]
getOS
  HashMap [Char] (HashMap [Char] [Char])
configMap <- [Char] -> IO (HashMap [Char] (HashMap [Char] [Char]))
readConfig [Char]
fp
  HashMap [Char] [Char] -> IO (HashMap [Char] [Char])
forall (m :: * -> *) a. Monad m => a -> m a
return (HashMap [Char] [Char] -> IO (HashMap [Char] [Char]))
-> HashMap [Char] [Char] -> IO (HashMap [Char] [Char])
forall a b. (a -> b) -> a -> b
$ [Char]
-> HashMap [Char] (HashMap [Char] [Char]) -> HashMap [Char] [Char]
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> a
lookupJust [Char]
os HashMap [Char] (HashMap [Char] [Char])
configMap
 where
   lookupJust :: k -> HashMap k a -> a
lookupJust k
s HashMap k a
m = Maybe a -> a
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe a -> a) -> Maybe a -> a
forall a b. (a -> b) -> a -> b
$ k -> HashMap k a -> Maybe a
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup k
s HashMap k a
m

getHostName::IO String
getHostName :: IO [Char]
getHostName = do
  HashMap [Char] [Char]
osMap <- [Char] -> IO (HashMap [Char] [Char])
confMap [Char]
configFile
  let host :: [Char]
host = [Char] -> HashMap [Char] [Char] -> [Char]
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> a
lookupJust [Char]
"host" HashMap [Char] [Char]
osMap
  let portStr :: [Char]
portStr = [Char] -> HashMap [Char] [Char] -> [Char]
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> a
lookupJust [Char]
"port" HashMap [Char] [Char]
osMap
  [Char] -> IO [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> IO [Char]) -> [Char] -> IO [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
host [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
":" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
portStr

{-|
    === KEY: get the full rootdir

    @
      "/Users/aaa/myfile/bitbucket/haskellwebapp2"
      "/Users/aaa/myfile/mybin/haskellwebapp2Bin"
    @
-}
getRootDirFull::IO String
getRootDirFull :: IO [Char]
getRootDirFull = do
  HashMap [Char] [Char]
osMap <- [Char] -> IO (HashMap [Char] [Char])
confMap [Char]
configFile
  [Char]
home <- [Char] -> IO [Char]
getEnv [Char]
"HOME"
  let rootdir :: [Char]
rootdir = [Char] -> HashMap [Char] [Char] -> [Char]
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> a
lookupJust [Char]
"rootdir" HashMap [Char] [Char]
osMap
  [Char] -> IO [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> IO [Char]) -> [Char] -> IO [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
home [Char] -> ShowS
</> [Char]
rootdir
      
styleChar::String->String->Char->Char->String->String
styleChar :: [Char] -> [Char] -> Char -> Char -> ShowS
styleChar [Char]
l [Char]
r Char
a Char
b [Char]
s = ([Char] -> ShowS) -> [Char] -> [[Char]] -> [Char]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr(\[Char]
x' [Char]
y' -> [Char]
x' [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
y') [] ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ (Char -> [Char]) -> [Char] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map(\Char
x -> if Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
a Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
b then [Char]
l [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ (Char
xChar -> ShowS
forall a. a -> [a] -> [a]
:[]) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
r else (Char
xChar -> ShowS
forall a. a -> [a] -> [a]
:[])) [Char]
s

-- | -------------------------------------------------------------------------------- 
-- | Thu Nov 15 13:18:04 2018 
-- | Simple web server for request and response
-- | Handle search code snippet
-- | -------------------------------------------------------------------------------- 
-- run.sh => ./wai 
-- ghc -i/$b/haskelllib --make wai.hs -o wai
                      
-- [file path] [desc] [image src]
href::String->String->String->String
href :: [Char] -> [Char] -> ShowS
href [Char]
p [Char]
n [Char]
m = [r|<a href='|] [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
p [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [r|'>|] [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> (ShowS
baseName [Char]
p) [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> 
             [r|<img src='|] [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
m [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [r|' width="10%"  height="10%" /></a>|] 

changeSymbol::String -> String
changeSymbol :: ShowS
changeSymbol [Char]
str = [Char]
s1 
    where
        s :: [[Char]]
s = [Char] -> [Char] -> [[Char]]
splitStr [Char]
"<-" [Char]
str  -- ["dog", "cat"]
        ss :: [[Char]]
ss = if Integer -> [[Char]] -> [[Char]]
forall a. Integer -> [a] -> [a]
takeEnd Integer
1 [[Char]]
s  [[Char]] -> [[Char]] -> Bool
forall a. Eq a => a -> a -> Bool
== [[Char]
""] then [[Char]] -> [[Char]]
forall a. [a] -> [a]
init [[Char]]
s else [[Char]] -> [[Char]]
forall a. [a] -> [a]
init [[Char]]
s  -- ["dog", "cat"]
        s1 :: [Char]
s1 = ([[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (ShowS -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map(\[Char]
x -> [Char]
x [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"<span style='color:red;'>&lt;-</span>") [[Char]]
ss)) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
la
        la :: [Char]
la = if Integer -> [[Char]] -> [[Char]]
forall a. Integer -> [a] -> [a]
takeEnd Integer
1 [[Char]]
s [[Char]] -> [[Char]] -> Bool
forall a. Eq a => a -> a -> Bool
== [[Char]
""] then [Char]
"" else [[Char]] -> [Char]
forall a. [a] -> a
last [[Char]]
s

-- | Convert [[String]] to ByteString
listToByteStr::[[String]]->BS.ByteString
listToByteStr :: [[[Char]]] -> ByteString
listToByteStr [[[Char]]]
s = [Char] -> ByteString
forall a. Typeable a => a -> ByteString
toSBS ([Char] -> ByteString) -> [Char] -> ByteString
forall a b. (a -> b) -> a -> b
$ ([Char] -> ShowS) -> [Char] -> [[Char]] -> [Char]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
L.foldr(\[Char]
x [Char]
y-> [Char]
x [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"<br>" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
y) [] ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ ([[Char]] -> [[Char]] -> [[Char]])
-> [[Char]] -> [[[Char]]] -> [[Char]]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
L.foldr(\[[Char]]
x [[Char]]
y -> [[Char]]
x [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]
"<br>"] [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]]
y) [] [[[Char]]]
s

cssStrong::String->String
cssStrong :: ShowS
cssStrong [Char]
s = if Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
2 then [Char]
"<strong>" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
s [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"</strong>" else [Char]
s
            where 
                list :: [[Char]]
list = Regex -> [Char] -> [[Char]]
splitRegex([Char] -> Regex
mkRegex [Char]
":") [Char]
s
                len :: Int
len = [[Char]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Char]]
list


cssHead::[[String]]->[[String]]
cssHead :: [[[Char]]] -> [[[Char]]]
cssHead = ([[Char]] -> [[Char]]) -> [[[Char]]] -> [[[Char]]]
forall a b. (a -> b) -> [a] -> [b]
map(\[[Char]]
x -> let 
                        len :: Int
len = [[Char]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([[Char]] -> Int) -> [[Char]] -> Int
forall a b. (a -> b) -> a -> b
$ Regex -> [Char] -> [[Char]]
splitRegex([Char] -> Regex
mkRegex [Char]
":") ([[Char]] -> [Char]
forall a. [a] -> a
head [[Char]]
x) 
                        in if Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
2 then ([Char]
"<span style=\"color:gray;\">" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [[Char]] -> [Char]
forall a. [a] -> a
head [[Char]]
x [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"</span>")[Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: Int -> [[Char]] -> [[Char]]
forall a. Int -> [a] -> [a]
drop Int
1 [[Char]]
x else [[Char]]
x)

htmlLess::[[String]]->[[String]]
htmlLess :: [[[Char]]] -> [[[Char]]]
htmlLess = (([[Char]] -> [[Char]]) -> [[[Char]]] -> [[[Char]]]
forall a b. (a -> b) -> [a] -> [b]
map (([[Char]] -> [[Char]]) -> [[[Char]]] -> [[[Char]]])
-> (ShowS -> [[Char]] -> [[Char]])
-> ShowS
-> [[[Char]]]
-> [[[Char]]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map)(\[Char]
x -> (Regex -> [Char] -> ShowS
subRegex Regex
r [Char]
x) [Char]
"&lt;")
        where
            r :: Regex
r = [Char] -> Regex
mkRegex [Char]
"<"

htmlGreater::[[String]]->[[String]]
htmlGreater :: [[[Char]]] -> [[[Char]]]
htmlGreater = (([[Char]] -> [[Char]]) -> [[[Char]]] -> [[[Char]]]
forall a b. (a -> b) -> [a] -> [b]
map (([[Char]] -> [[Char]]) -> [[[Char]]] -> [[[Char]]])
-> (ShowS -> [[Char]] -> [[Char]])
-> ShowS
-> [[[Char]]]
-> [[[Char]]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map)(\[Char]
x -> (Regex -> [Char] -> ShowS
subRegex Regex
r [Char]
x) [Char]
"&gt;")
        where
            r :: Regex
r = [Char] -> Regex
mkRegex [Char]
">"

keyWord::[[String]]->[[String]]
keyWord :: [[[Char]]] -> [[[Char]]]
keyWord = (([[Char]] -> [[Char]]) -> [[[Char]]] -> [[[Char]]]
forall a b. (a -> b) -> [a] -> [b]
map (([[Char]] -> [[Char]]) -> [[[Char]]] -> [[[Char]]])
-> (ShowS -> [[Char]] -> [[Char]])
-> ShowS
-> [[[Char]]]
-> [[[Char]]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map)(\[Char]
x -> (Regex -> [Char] -> ShowS
subRegex Regex
r [Char]
x) [Char]
"<span style=\"color:green;\">\\0</span>")
        where
            r :: Regex
r = [Char] -> Regex
mkRegex [Char]
"CTRL[a-zA-Z_-]*"

redisGetLastCmd::String -> IO String
redisGetLastCmd :: [Char] -> IO [Char]
redisGetLastCmd [Char]
k = [Char] -> IO (Maybe [Char])
redisGet [Char]
k IO (Maybe [Char]) -> (Maybe [Char] -> IO [Char]) -> IO [Char]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Maybe [Char]
c -> case Maybe [Char]
c of
                                           Just [Char]
x  -> [Char] -> IO [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
x 
                                           Maybe [Char]
Nothing -> [Char] -> IO [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
""

{-|
    === KEY: apl symbol

    DATE: Monday, 24 July 2023 16:42 PDT

    APL symbol
    SEE: /Users/aaa/myfile/bitbucket/publicfile/aplSymbol.txt
    -- FIXED: Remove '/' from apl code in order to fix URL format
    -- Unicode code point: 9017  0x2339 ⌹
    -- https://unicodeplus.com/U+2339
    -- putStrLn "\9017"
-}
aplSymbol::[[String]]->[[String]]
aplSymbol :: [[[Char]]] -> [[[Char]]]
aplSymbol = (([[Char]] -> [[Char]]) -> [[[Char]]] -> [[[Char]]]
forall a b. (a -> b) -> [a] -> [b]
map (([[Char]] -> [[Char]]) -> [[[Char]]] -> [[[Char]]])
-> (ShowS -> [[Char]] -> [[Char]])
-> ShowS
-> [[[Char]]]
-> [[[Char]]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map) (\[Char]
x -> (Regex -> [Char] -> ShowS
subRegex Regex
rx [Char]
x) [Char]
rp)
  where
    -- rp = "<span style=\"color:yellow;font-size:18pt;\">\\0</span>"
    rs :: [Char]
rs = [r|
           ÷ × , / ? \ ¨ ì {} ← ↑ → ↓ ∆ ∇ ∈ − ∘ ∣ ∧ ∨ ∩ ∪ ∵ ∼ ≠ ≡ ≢ ≤ ≥ ⊂ ⊃ ⊖ ⊢ ⊣ ⊤ ⊥ ⊼ ⊽ ⋄ ⋆ ⌈ ⌊ ⌶ ⌷ ⌸ ⌹ ⌺ ⌻ ⌼ ⌽ ⌾ ⌿ ⍀ ⍁ ⍂ ⍃ ⍄ ⍅ ⍆ ⍇ ⍈ ⍉ ⍊ ⍋ ⍌ ⍍ ⍎ ⍏ ⍐ ⍑ ⍒ ⍓ ⍔ ⍕ ⍖ ⍗ ⍘ ⍙ ⍚ ⍛ ⍜ ⍝ ⍞ ⍟ ⍠ ⍡ ⍢ ⍣ ⍤ ⍥ ⍦ ⍧ ⍨ ⍩ ⍪ ⍫ ⍬ ⍭ ⍮ ⍯ ⍰ ⍱ ⍲ ⍳ ⍴ ⍵ ⍶ ⍷ ⍸ ⍹ ⍺ ⎕ ○
           |]
    -- Remove '/' from apl code in order to fix URL format
    pl :: [Char]
pl = let s :: [Char]
s = (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
filter (\Char
x -> Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
' ' Bool -> Bool -> Bool
&& Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'/') [Char]
rs in [Char]
"[" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
+ [Char]
s [Char] -> ShowS
forall a. [a] -> [a] -> [a]
+ [Char]
"]"
    rx :: Regex
rx = [Char] -> Regex
mkRegex [Char]
pl
    + :: [a] -> [a] -> [a]
(+) = [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
(++)
    rp :: [Char]
rp = [Char]
"<span style=\"color:yellow;\">\\0</span>"
    -- rx = mkRegex "[\9017\9018\9071\9037\9025\9056\9027\9016\9028\9072\9020\9044\9026\9043\9019\9036\247\9050\8900\9048\9066\8594\8867\8722\8802\8800\9049\9035\8710\8802\9068\9070\8592\8804\8801\8805\9065\9053\9014\9014\9055\8854\9061\9033\9052\9675\8868\168\9067\8739\9078\9078\9082\8892\8743\8592\9024\8869\9109\8594\8743\9066\9066\8968\9033\8854\9061\9022\9055\9021\9052\9052\9675\9066\9053\9023\8869\9058\9042\9067\9035\9049\9049\8710\8711\8801\8867\168\9050\9050\8900\8757\8835\247\9017\8595\8744\8746\8868\9046\9073\9062\9057\9045\9041\9046\8595\168\8834\8868\8712\9079\9079\8712\236\9024\8902\9079\8593\8970\9045\9058\8592\8594\9042\9035\8968\9065\8805\9061\9060\9075\9015\9075\8745\8745\8744\9080\9080\9075\8592\9060\9051\9051\8728\9066\9053\8592\8834\8867\9029\9063\9029\8804\8970\8866\9055\9055\9017\9017\8801\8968\8712\8712\8722\8970\8711\9074\8728\8722\9073\8800\8802\8764\9060\9051\9081\9081\9077\8893\8744\8728\8834\8757\9675\8835\8902\9032\9026\9020\9056\9037\9044\9018\9017\9047\9036\9016\9028\9019\9031\9027\9044\9071\9072\9032\9025\9040\9043\9031\9027\9028\9109\9054\9048\9048\9060\247\9023\9023\8868\9076\8739\9021\9076\8594\8835\8866\9030}\9030\8728?\8854\9021\9024\9070\9076\215\9023\9023\9024\9064\9057\9059\9015\9015\9059\8902\9069\8739\8593\9064\8764\215\9033\8712\8746\8593\8743\8745\8869\9039\9074\9053\9038\9034\9039\9077\215\9068\8866\9069\9064\9074\9073\8764]"

  
-- latex: \begin{document} \end{document}
keyWord1::[[String]]->[[String]]
keyWord1 :: [[[Char]]] -> [[[Char]]]
keyWord1 = (([[Char]] -> [[Char]]) -> [[[Char]]] -> [[[Char]]]
forall a b. (a -> b) -> [a] -> [b]
map (([[Char]] -> [[Char]]) -> [[[Char]]] -> [[[Char]]])
-> (ShowS -> [[Char]] -> [[Char]])
-> ShowS
-> [[[Char]]]
-> [[[Char]]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map)(\[Char]
x -> (Regex -> [Char] -> ShowS
subRegex Regex
r [Char]
x) [Char]
"<span style=\"color:green;\">\\0</span>")
        where
            r :: Regex
r = [Char] -> Regex
mkRegex [Char]
"\\\\[a-zA-Z0-9]+{[^}]+}"

keyDash::[[String]]->[[String]]
keyDash :: [[[Char]]] -> [[[Char]]]
keyDash = (([[Char]] -> [[Char]]) -> [[[Char]]] -> [[[Char]]]
forall a b. (a -> b) -> [a] -> [b]
map (([[Char]] -> [[Char]]) -> [[[Char]]] -> [[[Char]]])
-> (ShowS -> [[Char]] -> [[Char]])
-> ShowS
-> [[[Char]]]
-> [[[Char]]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map)(\[Char]
x -> (Regex -> [Char] -> ShowS
subRegex Regex
r [Char]
x) [Char]
"<span style=\"color:red;\">\\0</span>")
        where
            r :: Regex
r = [Char] -> Regex
mkRegex [Char]
"[-+]{10,}"

--keySymbol1::[[String]]->[[String]]
--keySymbol1 s = (map . map)(\x -> (subRegex r x) "<span style=\"color:blue;\">\\0</span>")  s
--        where
--            r = mkRegex "=>|=="

keySymbol1::[[String]]->[[String]]
keySymbol1 :: [[[Char]]] -> [[[Char]]]
keySymbol1 = (([[Char]] -> [[Char]]) -> [[[Char]]] -> [[[Char]]]
forall a b. (a -> b) -> [a] -> [b]
map (([[Char]] -> [[Char]]) -> [[[Char]]] -> [[[Char]]])
-> (ShowS -> [[Char]] -> [[Char]])
-> ShowS
-> [[[Char]]]
-> [[[Char]]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map)(\[Char]
x -> ShowS
changeSymbol [Char]
x)

--keyName::[[String]]->[[String]]
--keyName s = (map . map)(\x -> (subRegex r x) "<span style=\"color:pink; background:#CCF7F7;\">\\0</span>")  s
--        where
--            r = mkRegex "buffer|while|if|endif|Emacs|split|goto"

keyName::[[String]]->[[String]]
keyName :: [[[Char]]] -> [[[Char]]]
keyName [[[Char]]]
s = (([[Char]] -> [[Char]]) -> [[[Char]]] -> [[[Char]]]
forall a b. (a -> b) -> [a] -> [b]
map (([[Char]] -> [[Char]]) -> [[[Char]]] -> [[[Char]]])
-> (ShowS -> [[Char]] -> [[Char]])
-> ShowS
-> [[[Char]]]
-> [[[Char]]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map)(\[Char]
x -> [Char]
x [Char] -> SearchReplace RE [Char] -> [Char]
*=~/ 
    [ed|${adr}(\<where\>|\<let\>):?///<span style="color:blue;">${adr}</span>|]) [[[Char]]]
s

specialName::[[String]]->[[String]]
specialName :: [[[Char]]] -> [[[Char]]]
specialName = (([[Char]] -> [[Char]]) -> [[[Char]]] -> [[[Char]]]
forall a b. (a -> b) -> [a] -> [b]
map (([[Char]] -> [[Char]]) -> [[[Char]]] -> [[[Char]]])
-> (ShowS -> [[Char]] -> [[Char]])
-> ShowS
-> [[[Char]]]
-> [[[Char]]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map)(\[Char]
x -> [Char]
x [Char] -> SearchReplace RE [Char] -> [Char]
*=~/ 
    [ed|${adr}(\<new\>|::|\<sizeof\>):?///<span style="color:red;">${adr}</span>|])

javaClassName::[[String]]->[[String]]
javaClassName :: [[[Char]]] -> [[[Char]]]
javaClassName = (([[Char]] -> [[Char]]) -> [[[Char]]] -> [[[Char]]]
forall a b. (a -> b) -> [a] -> [b]
map (([[Char]] -> [[Char]]) -> [[[Char]]] -> [[[Char]]])
-> (ShowS -> [[Char]] -> [[Char]])
-> ShowS
-> [[[Char]]]
-> [[[Char]]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map)(\[Char]
x -> [Char]
x [Char] -> SearchReplace RE [Char] -> [Char]
*=~/ [ed|${adr}(\<interface\>|\<abstract\>|\<implements\>|\<class\>|\< = \>):?///<span style="color:#ef82ee;">${adr}</span>|])

        -- let s1 = "mydog dog dog (dog)" ?=~/ [ed|${adr}(\<dog\>):?///< div class="dog">${adr}< /div> |]
-------------------------------------------------------------------------------- 
-- Use following package lang extension and package for word boundary 
-- search and replacement
-- {-# LANGUAGE QuasiQuotes       #-}
-- import Text.RE.TDFA.String

-- add more ClassName here
javaFunClass::[[String]]->[[String]]
javaFunClass :: [[[Char]]] -> [[[Char]]]
javaFunClass = (([[Char]] -> [[Char]]) -> [[[Char]]] -> [[[Char]]]
forall a b. (a -> b) -> [a] -> [b]
map (([[Char]] -> [[Char]]) -> [[[Char]]] -> [[[Char]]])
-> (ShowS -> [[Char]] -> [[Char]])
-> ShowS
-> [[[Char]]]
-> [[[Char]]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map)(\[Char]
x -> [Char]
x [Char] -> SearchReplace RE [Char] -> [Char]
*=~/ 
    [ed|${adr}(\< Vector \>|\< List \>|\< Set \>|\< HashSet \>|\< HashMap \>|\< ArrayList \>|\< Integer \>|\< String \>):?///<span style="color:#218e2b;">${adr}</span>|])
    -- it is too slow [ed|${adr}(\<[A-Z][a-z_0-9]*\>):?///<span style="color:#218e2b;">${adr}</span>|]) s
-------------------------------------------------------------------------------- 
javaKeyWords::[[String]]->[[String]]
javaKeyWords :: [[[Char]]] -> [[[Char]]]
javaKeyWords = (([[Char]] -> [[Char]]) -> [[[Char]]] -> [[[Char]]]
forall a b. (a -> b) -> [a] -> [b]
map (([[Char]] -> [[Char]]) -> [[[Char]]] -> [[[Char]]])
-> (ShowS -> [[Char]] -> [[Char]])
-> ShowS
-> [[[Char]]]
-> [[[Char]]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map)(\[Char]
x -> [Char]
x [Char] -> SearchReplace RE [Char] -> [Char]
*=~/ 
    [ed|${adr}(\< abstract \>|\< assert \>|\< boolean \>|\< break \>|\< byte \>|\< case \>|\< catch \>|\< char \>|\< class \>|\< const \>|\< continue \>|\< default \>|\< do \>|\< double \>|\< else \>|\< enum \>|\< extends \>|\< final \>|\< finally \>|\< float \>|\< for \>|\< goto \>|\< if \>|\< implements \>|\< import \>|\< instanceof \>|\< int \>|\< interface \>|\< long \>|\< native \>|\< new \>|\< package \>|\< private \>|\< protected \>|\< public \>|\< return \>|\< short \>|\< static \>|\< strictfp \>|\< super \>|\< switch \>|\< synchronized \>|\< this \>|\< throw \>|\< throws \>|\< transient \>|\< try \>|\< void \>|\< volatile \>|\< while \>):?///<span style="color:#f50a93;">${adr}</span>|])

-------------------------------------------------------------------------------- 
javaCmdKeyWords::[[String]]->[[String]]
javaCmdKeyWords :: [[[Char]]] -> [[[Char]]]
javaCmdKeyWords = (([[Char]] -> [[Char]]) -> [[[Char]]] -> [[[Char]]]
forall a b. (a -> b) -> [a] -> [b]
map (([[Char]] -> [[Char]]) -> [[[Char]]] -> [[[Char]]])
-> (ShowS -> [[Char]] -> [[Char]])
-> ShowS
-> [[[Char]]]
-> [[[Char]]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map)(\[Char]
x -> [Char]
x [Char] -> SearchReplace RE [Char] -> [Char]
*=~/ 
    [ed|${adr}(\< java \>|\< javac \>|\< javadoc \>|\< jar \>):?///<span style="color:#35A993;">${adr}</span>|])

-------------------------------------------------------------------------------- 

mysqlKeyWords::[[String]]->[[String]]
mysqlKeyWords :: [[[Char]]] -> [[[Char]]]
mysqlKeyWords = (([[Char]] -> [[Char]]) -> [[[Char]]] -> [[[Char]]]
forall a b. (a -> b) -> [a] -> [b]
map (([[Char]] -> [[Char]]) -> [[[Char]]] -> [[[Char]]])
-> (ShowS -> [[Char]] -> [[Char]])
-> ShowS
-> [[[Char]]]
-> [[[Char]]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map)(\[Char]
x -> [Char]
x [Char] -> SearchReplace RE [Char] -> [Char]
*=~/ 
    [ed|${adr}(\< insert \>|\< create \>|\< from \>|\< select \>|\< table \>|\< into \>):?///<span style="color:#FF69B4;">${adr}</span>|])
-------------------------------------------------------------------------------- 

-- [[:graph:]] - ASCII char excluding space
-- match URL
keyURL::[[String]]->[[String]]
keyURL :: [[[Char]]] -> [[[Char]]]
keyURL = (([[Char]] -> [[Char]]) -> [[[Char]]] -> [[[Char]]]
forall a b. (a -> b) -> [a] -> [b]
map (([[Char]] -> [[Char]]) -> [[[Char]]] -> [[[Char]]])
-> (ShowS -> [[Char]] -> [[Char]])
-> ShowS
-> [[[Char]]]
-> [[[Char]]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map)(\[Char]
x -> (Regex -> [Char] -> ShowS
subRegex Regex
r [Char]
x) [Char]
"<a href=\"\\1\">\\1</a>")
        where
            r :: Regex
r = [Char] -> Regex
mkRegex [Char]
"(https?://[[:graph:]]+)"

spChar::[[String]]->[[String]]
spChar :: [[[Char]]] -> [[[Char]]]
spChar = (([[Char]] -> [[Char]]) -> [[[Char]]] -> [[[Char]]]
forall a b. (a -> b) -> [a] -> [b]
map (([[Char]] -> [[Char]]) -> [[[Char]]] -> [[[Char]]])
-> (ShowS -> [[Char]] -> [[Char]])
-> ShowS
-> [[[Char]]]
-> [[[Char]]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map)(\[Char]
x -> [Char] -> [Char] -> Char -> Char -> ShowS
styleChar [Char]
l [Char]
r Char
a Char
b [Char]
x)
        where
            l :: [Char]
l = [Char]
"<span style=\"color:red;\">"
            r :: [Char]
r = [Char]
"</span>"
            a :: Char
a = Char
'{' 
            b :: Char
b = Char
'}' 

bracketChar::[[String]]->[[String]]
bracketChar :: [[[Char]]] -> [[[Char]]]
bracketChar = (([[Char]] -> [[Char]]) -> [[[Char]]] -> [[[Char]]]
forall a b. (a -> b) -> [a] -> [b]
map (([[Char]] -> [[Char]]) -> [[[Char]]] -> [[[Char]]])
-> (ShowS -> [[Char]] -> [[Char]])
-> ShowS
-> [[[Char]]]
-> [[[Char]]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map)(\[Char]
x -> [Char] -> [Char] -> Char -> Char -> ShowS
styleChar [Char]
l [Char]
r Char
a Char
b [Char]
x)
        where
            l :: [Char]
l = [Char]
"<span style=\"color:blue;\">"
            r :: [Char]
r = [Char]
"</span>"
            a :: Char
a = Char
'(' 
            b :: Char
b = Char
')' 

sbChar::[[String]]->[[String]]
sbChar :: [[[Char]]] -> [[[Char]]]
sbChar = (([[Char]] -> [[Char]]) -> [[[Char]]] -> [[[Char]]]
forall a b. (a -> b) -> [a] -> [b]
map (([[Char]] -> [[Char]]) -> [[[Char]]] -> [[[Char]]])
-> (ShowS -> [[Char]] -> [[Char]])
-> ShowS
-> [[[Char]]]
-> [[[Char]]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map)(\[Char]
x -> [Char] -> [Char] -> Char -> Char -> ShowS
styleChar [Char]
l [Char]
r Char
a Char
b [Char]
x)
        where 
            l :: [Char]
l = [Char]
"<span style=\"color:#e012cd;\">"
            r :: [Char]
r = [Char]
"</span>"
            a :: Char
a = Char
'[' 
            b :: Char
b = Char
']' 

-- compose all Regex subRegex
-- transform = id
transformX :: [[[Char]]] -> [[[Char]]]
transformX = 
             [[[Char]]] -> [[[Char]]]
cssHead([[[Char]]] -> [[[Char]]])
-> ([[[Char]]] -> [[[Char]]]) -> [[[Char]]] -> [[[Char]]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
             [[[Char]]] -> [[[Char]]]
spChar([[[Char]]] -> [[[Char]]])
-> ([[[Char]]] -> [[[Char]]]) -> [[[Char]]] -> [[[Char]]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
             [[[Char]]] -> [[[Char]]]
bracketChar([[[Char]]] -> [[[Char]]])
-> ([[[Char]]] -> [[[Char]]]) -> [[[Char]]] -> [[[Char]]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
             [[[Char]]] -> [[[Char]]]
sbChar([[[Char]]] -> [[[Char]]])
-> ([[[Char]]] -> [[[Char]]]) -> [[[Char]]] -> [[[Char]]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
             [[[Char]]] -> [[[Char]]]
specialName([[[Char]]] -> [[[Char]]])
-> ([[[Char]]] -> [[[Char]]]) -> [[[Char]]] -> [[[Char]]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
             [[[Char]]] -> [[[Char]]]
javaClassName([[[Char]]] -> [[[Char]]])
-> ([[[Char]]] -> [[[Char]]]) -> [[[Char]]] -> [[[Char]]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
             [[[Char]]] -> [[[Char]]]
javaFunClass([[[Char]]] -> [[[Char]]])
-> ([[[Char]]] -> [[[Char]]]) -> [[[Char]]] -> [[[Char]]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
             [[[Char]]] -> [[[Char]]]
javaKeyWords([[[Char]]] -> [[[Char]]])
-> ([[[Char]]] -> [[[Char]]]) -> [[[Char]]] -> [[[Char]]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
             [[[Char]]] -> [[[Char]]]
javaCmdKeyWords([[[Char]]] -> [[[Char]]])
-> ([[[Char]]] -> [[[Char]]]) -> [[[Char]]] -> [[[Char]]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
             [[[Char]]] -> [[[Char]]]
mysqlKeyWords([[[Char]]] -> [[[Char]]])
-> ([[[Char]]] -> [[[Char]]]) -> [[[Char]]] -> [[[Char]]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.

             [[[Char]]] -> [[[Char]]]
keyURL([[[Char]]] -> [[[Char]]])
-> ([[[Char]]] -> [[[Char]]]) -> [[[Char]]] -> [[[Char]]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
             [[[Char]]] -> [[[Char]]]
keyDash([[[Char]]] -> [[[Char]]])
-> ([[[Char]]] -> [[[Char]]]) -> [[[Char]]] -> [[[Char]]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
             [[[Char]]] -> [[[Char]]]
keyName([[[Char]]] -> [[[Char]]])
-> ([[[Char]]] -> [[[Char]]]) -> [[[Char]]] -> [[[Char]]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
             [[[Char]]] -> [[[Char]]]
aplSymbol([[[Char]]] -> [[[Char]]])
-> ([[[Char]]] -> [[[Char]]]) -> [[[Char]]] -> [[[Char]]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
             ([[[Char]]] -> [[[Char]]]
htmlLess([[[Char]]] -> [[[Char]]])
-> ([[[Char]]] -> [[[Char]]]) -> [[[Char]]] -> [[[Char]]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.[[[Char]]] -> [[[Char]]]
htmlGreater)



wsApp :: WS.ServerApp
wsApp :: ServerApp
wsApp PendingConnection
pending = do
  IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    Connection
conn <- PendingConnection -> IO Connection
WS.acceptRequest PendingConnection
pending
    Text
msg <- Connection -> IO Text
forall a. WebSocketsData a => Connection -> IO a
WS.receiveData Connection
conn :: IO TS.Text
    [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
forall a. Show a => a -> [Char]
show Text
msg
    [Char] -> IO ()
putStrLn ([Char]
"weApp"::String)
    Connection -> Text -> IO ()
forall a. WebSocketsData a => Connection -> a -> IO ()
WS.sendTextData Connection
conn Text
msg
    
type Client = (Int, WS.Connection)

broadcast :: TS.Text -> [Client] -> IO ()
broadcast :: Text -> [Client] -> IO ()
broadcast Text
msg = (Connection -> IO ()) -> [Connection] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((Connection -> Text -> IO ()) -> Text -> Connection -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Connection -> Text -> IO ()
forall a. WebSocketsData a => Connection -> a -> IO ()
WS.sendTextData Text
msg) ([Connection] -> IO ())
-> ([Client] -> [Connection]) -> [Client] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Client -> Connection) -> [Client] -> [Connection]
forall a b. (a -> b) -> [a] -> [b]
map Client -> Connection
forall a b. (a, b) -> b
snd

addClient :: WS.Connection -> [Client] -> ([Client], Int)
addClient :: Connection -> [Client] -> ([Client], Int)
addClient Connection
conn [Client]
cs = let i :: Int
i = if [Client] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Client]
cs then Int
0 else [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ((Client -> Int) -> [Client] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Client -> Int
forall a b. (a, b) -> a
fst [Client]
cs) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
                    in  ((Int
i, Connection
conn)Client -> [Client] -> [Client]
forall a. a -> [a] -> [a]
:[Client]
cs, Int
i)

removeClient :: Int -> [Client] -> ([Client], ())
removeClient :: Int -> [Client] -> ([Client], ())
removeClient Int
i [Client]
cs = ((Client -> Bool) -> [Client] -> [Client]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Client
c -> Client -> Int
forall a b. (a, b) -> a
fst Client
c Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
i) [Client]
cs, ())

chat :: IORef [Client] -> WS.ServerApp
chat :: IORef [Client] -> ServerApp
chat IORef [Client]
ref PendingConnection
pending = do
    Connection
conn <- PendingConnection -> IO Connection
WS.acceptRequest PendingConnection
pending
    Int
identifier <- IORef [Client] -> ([Client] -> ([Client], Int)) -> IO Int
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef IORef [Client]
ref (Connection -> [Client] -> ([Client], Int)
addClient Connection
conn)
    (IO () -> IO () -> IO ()) -> IO () -> IO () -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
EXP.finally (Int -> IO ()
disconnect Int
identifier) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        Text
msg <- Connection -> IO Text
forall a. WebSocketsData a => Connection -> IO a
WS.receiveData Connection
conn
        -- putStrLn msg
        [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
forall a. Show a => a -> [Char]
show Text
msg
        [Client]
conns <- IORef [Client] -> IO [Client]
forall a. IORef a -> IO a
readIORef IORef [Client]
ref
        Text -> [Client] -> IO ()
broadcast Text
msg [Client]
conns
    where
    disconnect :: Int -> IO ()
disconnect Int
identifier = IORef [Client] -> ([Client] -> ([Client], ())) -> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef IORef [Client]
ref (Int -> [Client] -> ([Client], ())
removeClient Int
identifier)
       
{-|
     === Fake optional parameter

     > alternateLineColor2 []
     > alternateLineColor2 [("background", "green"), ("background", "cyan")]
-}                 
alternateLineColor2::[A.CSSPro] -> [[String]] -> [[String]]
alternateLineColor2 :: [CSSPro] -> [[[Char]]] -> [[[Char]]]
alternateLineColor2 [CSSPro]
cs [[[Char]]]
cx = case [CSSPro] -> Integer
forall (t :: * -> *) b a. (Foldable t, Num b) => t a -> b
len [CSSPro]
cs of
                    Integer
0 -> let style :: [Char]
style  = [CSSPro] -> [Char]
H2.style_ [([Char]
"color", [Char]
"#AAAAAA")] 
                             style' :: [Char]
style' = [CSSPro] -> [Char]
H2.style_ [([Char]
"color", [Char]
"white")]
                         -- in map(\row -> map(\(x, n) -> if (mod n 2) == 0 then H2.span_ style x else H2.span_ style' x ) $ zip row [0..]) cx
                         in ([[Char]] -> [[Char]]) -> [[[Char]]] -> [[[Char]]]
forall a b. (a -> b) -> [a] -> [b]
map(\[[Char]]
row -> ([Char] -> Integer -> [Char]) -> [[Char]] -> [Integer] -> [[Char]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\[Char]
x Integer
n -> if Integer -> Bool
forall a. Integral a => a -> Bool
even Integer
2 then [Char] -> ShowS
H2.span_ [Char]
style [Char]
x else [Char] -> ShowS
H2.span_ [Char]
style' [Char]
x) [[Char]]
row [Integer
0..]) [[[Char]]]
cx
                    Integer
2 -> let style1 :: [Char]
style1 = [CSSPro] -> [Char]
H2.style_ ([CSSPro] -> [Char]) -> [CSSPro] -> [Char]
forall a b. (a -> b) -> a -> b
$ [CSSPro] -> [CSSPro]
forall a. [a] -> [a]
init [CSSPro]
cs
                             style2 :: [Char]
style2 = [CSSPro] -> [Char]
H2.style_ ([CSSPro] -> [Char]) -> [CSSPro] -> [Char]
forall a b. (a -> b) -> a -> b
$ [CSSPro] -> [CSSPro]
forall a. [a] -> [a]
tail [CSSPro]
cs
                         -- in map(\row -> map(\(x, n) -> if (mod n 2) == 0 then H2.span_ style1 x else H2.span_ style2 x ) $ zip row [0..]) cx
                         in ([[Char]] -> [[Char]]) -> [[[Char]]] -> [[[Char]]]
forall a b. (a -> b) -> [a] -> [b]
map(\[[Char]]
row -> ([Char] -> Integer -> [Char]) -> [[Char]] -> [Integer] -> [[Char]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith(\[Char]
x Integer
n -> if Integer -> Bool
forall a. Integral a => a -> Bool
even Integer
2 then [Char] -> ShowS
H2.span_ [Char]
style1 [Char]
x else [Char] -> ShowS
H2.span_ [Char]
style2 [Char]
x) [[Char]]
row [Integer
0..]) [[[Char]]]
cx
                    Integer
_ -> [Char] -> [[[Char]]]
forall a. HasCallStack => [Char] -> a
error [r|Invalid input: => alternateLineColor[("background", "green"), ("background", "cyan")]|]
                 where
                   + :: [a] -> [a] -> [a]
(+) = [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
(++)

blockId::Integer -> String
blockId :: Integer -> [Char]
blockId Integer
n = [Char]
"t" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Integer -> [Char]
forall a. Show a => a -> [Char]
show Integer
n

svgIconUpdate::String
svgIconUpdate :: [Char]
svgIconUpdate = [r| 
      <svg xmlns='http://www.w3.org/2000/svg' class='ionicon' width="24" height="24" viewBox='0 0 512 512'>
      <title>Arrow Up</title>
      <path fill='none' stroke='currentColor' stroke-linecap='round' stroke-linejoin='round' stroke-width='48' d='M112 244l144-144 144 144M256 120v292'/>
      </svg>|]

svgIconInsert::String
svgIconInsert :: [Char]
svgIconInsert = [r|
      <svg xmlns='http://www.w3.org/2000/svg' class='ionicon' width="24" height="24" viewBox='0 0 512 512'>
	<title>Add Circle</title>
	<path d='M448 256c0-106-86-192-192-192S64 150 64 256s86 192 192 192 192-86 192-192z' fill='none' stroke='currentColor' stroke-miterlimit='10' stroke-width='32'/>
	<path fill='none' stroke='currentColor' stroke-linecap='round' stroke-linejoin='round' stroke-width='32' d='M256 176v160M336 256H176'/>
      </svg> |]

svgIconDelete::String
svgIconDelete :: [Char]
svgIconDelete = [r| 
   <svg version="1.1" xmlns="http://www.w3.org/2000/svg" width="24" height="24" viewBox="0 0 512 512">
   <title></title>
   <g id="icomoon-ignore"></g>
   <path d="M507.331 411.33c-0.002-0.002-0.004-0.004-0.006-0.005l-155.322-155.325 155.322-155.325c0.002-0.002 0.004-0.003 0.006-0.005 1.672-1.673 2.881-3.627 3.656-5.708 2.123-5.688 0.912-12.341-3.662-16.915l-73.373-73.373c-4.574-4.573-11.225-5.783-16.914-3.66-2.080 0.775-4.035 1.984-5.709 3.655 0 0.002-0.002 0.003-0.004 0.005l-155.324 155.326-155.324-155.325c-0.002-0.002-0.003-0.003-0.005-0.005-1.673-1.671-3.627-2.88-5.707-3.655-5.69-2.124-12.341-0.913-16.915 3.66l-73.374 73.374c-4.574 4.574-5.784 11.226-3.661 16.914 0.776 2.080 1.985 4.036 3.656 5.708 0.002 0.001 0.003 0.003 0.005 0.005l155.325 155.324-155.325 155.326c-0.001 0.002-0.003 0.003-0.004 0.005-1.671 1.673-2.88 3.627-3.657 5.707-2.124 5.688-0.913 12.341 3.661 16.915l73.374 73.373c4.575 4.574 11.226 5.784 16.915 3.661 2.080-0.776 4.035-1.985 5.708-3.656 0.001-0.002 0.003-0.003 0.005-0.005l155.324-155.325 155.324 155.325c0.002 0.001 0.004 0.003 0.006 0.004 1.674 1.672 3.627 2.881 5.707 3.657 5.689 2.123 12.342 0.913 16.914-3.661l73.373-73.374c4.574-4.574 5.785-11.227 3.662-16.915-0.776-2.080-1.985-4.034-3.657-5.707z"></path>
   </svg> |]

svgIconSubtract::String
svgIconSubtract :: [Char]
svgIconSubtract = [r|
    <svg version="1.1" xmlns="http://www.w3.org/2000/svg" width="24" height="24" viewBox="0 0 512 512">
    <title></title>
    <g id="icomoon-ignore">
    </g>
    <path d="M0 208v96c0 8.836 7.164 16 16 16h480c8.836 0 16-7.164 16-16v-96c0-8.836-7.164-16-16-16h-480c-8.836 0-16 7.164-16 16z"></path>
    </svg> |]

svgIconAdd::String
svgIconAdd :: [Char]
svgIconAdd = [r|
    <svg version="1.1" xmlns="http://www.w3.org/2000/svg" width="24" height="24" viewBox="0 0 512 512">
    <title></title>
    <g id="icomoon-ignore"></g>
    <path d="M496 192h-176v-176c0-8.836-7.164-16-16-16h-96c-8.836 0-16 7.164-16 16v176h-176c-8.836 0-16 7.164-16 16v96c0 8.836 7.164 16 16 16h176v176c0 8.836 7.164 16 16 16h96c8.836 0 16-7.164 16-16v-176h176c8.836 0 16-7.164 16-16v-96c0-8.836-7.164-16-16-16z"></path>
    </svg> |]

{-| 
    === Hide all the data in TextArea

    * IN USE

    @
    <form action="serverFun.hs" name="someName" method="POST">
    <textarea id="ttId" class="text" cols="86" rows ="20" name="textName"></textarea>

    <input type="submit" value="Email" class="submitButton">
    </form>

    <textarea cols="20" rows="20" id="textArea" style="display:none;font-size:18px;" class="hide"></textarea>

    <textarea autofocus="true" onfocus="textAreaAdjust(this);"></textarea>
    @
    
    We update the codeblock according to "header"(use ID?)
    

    TODO1: use Ajax to update codeblock in database
    See aronlib.js requestPreFromRedis

    @
    data CodeBlock = 
    CodeBlock 
    { id        :: Int64
    , header    :: TS.Text
    , codeblock :: TS.Text
    } deriving (Eq, Read, Show)
    @
    pid => id => from CodeBlock table from sqlite3

    :DATE: 26-10-2020
    :NOTE: USE IT NOW ✅ 
    :FIXME: Click hide/show DOES NOT WORK, the click location is off
    :IMG: file:///Users/aaa/myfile/bitbucket/image/clickhide.png
-} 
hiddenForm2::Integer -> String -> String  
hiddenForm2 :: Integer -> ShowS
hiddenForm2 Integer
pid [Char]
s = [r|
        <form action="/update" name="Update" class="hf" id='|] [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char] -> Integer -> [Char]
forall a. Show a => [Char] -> a -> [Char]
cid [Char]
"f" Integer
pid [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<>[r|'|] [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<>
    [r| method="POST"><textarea name="header" id='|] [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
pidStr [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [r|' rows="20" class="hide">|] [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
pidStr [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [r|</textarea>|][Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> 
    [r|<textarea  name="myblock" spellcheck="false" style="car et-color:red;" autofocus="true" onfocus="textAreaAdjust(this);" id= '|] [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
eleIdCodeBlock [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
pidStr [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [r|' |] [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> 
    [r|class="hide">|][Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<>[Char]
s[Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<>[r|</textarea><button type="button" |] [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
onClickUpdate [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [r| value="update" id="search-button">|]
    [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<>[Char]
svgIconUpdate [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<>
    [r|</button><button type="button" |] [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
onClickInsert [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [r| value="add" id="search-button">|]
    [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
svgIconInsert [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<>
    [r|</button><button type="button" |] [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
onClickDelete [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [r| value="delete" id="search-button">|]
    [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
svgIconDelete [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<>
    [r|</button><button type="button" |] [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
onClickAdd [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [r| value="addscore" id="search-button">|]
    [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
svgIconAdd [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<>
    [r|</button><button type="button" |] [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
onClickSubtract [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [r| value="subtractscore" id="search-button"> |]
    [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
svgIconSubtract [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<>
    [r|</button></div></form>
    |]
      where
        pidStr :: [Char]
pidStr = Integer -> [Char]
forall a. Show a => a -> [Char]
show Integer
pid 
        cid :: [Char] -> a -> [Char]
cid [Char]
s a
n = [Char]
s [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> [Char]
forall a. Show a => a -> [Char]
show a
n
        onClickUpdate :: [Char]
onClickUpdate   = [r| onclick="updateCodeBlock('|] [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
pidStr [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [r|');" |]
        onClickInsert :: [Char]
onClickInsert   = [r| onclick="insertCodeBlock('|] [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
pidStr [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [r|');" |]
        onClickDelete :: [Char]
onClickDelete   = [r| onclick="deleteCodeBlock('|] [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
pidStr [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [r|');" |]
        onClickAdd :: [Char]
onClickAdd      = [r| onclick="addScoreCodeBlock('|] [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
pidStr [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [r|');" |]
        onClickSubtract :: [Char]
onClickSubtract = [r| onclick="subtractScoreCodeBlock('|] [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
pidStr [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [r|');" |]
{-|
    === KEY:  

    @
     In Java
     Function f = x -> x + 1
     BiFunction f = (x, y) -> x + y
     
     
     foldr(\x y -> [div] ++ x ++ [cdiv] ++ brr + y) (0, []) zhtml
     
     The id can be used to for TextArea editor
     e.g.
      <TextArea onclick="editfun()" ></TextArea>
     
     <script>
     function editfun(){
     
     }
     
     </script>
     
     See file gf: /Users/aaa/myfile/bitbucket/html/showTextAreaOnClick.html
     
     <div id=\"3\" style=\"kk\"> code1 </div> 
     <div id=\"4\" style=\"kk\"> code2 </div> 
     
     ([[String]] -> [[String]]) 
     stylish allBlock

     Mon Dec  2 12:55:08 2019 
     Fixex issue inside 'stylish allBlock', apply <br> to stylish allBlock instead of zhtml

     TODO1
     foldListList ::([([String], Integer)]->[([String], Integer)])->[([String], Integer)]->String

    DATE: Mon 28 Nov 18:50:38 2022 
    NOTE: USE IT NOW
    @
-}
foldListList::([[String]]->[[String]])->[[String]]->String
foldListList :: ([[[Char]]] -> [[[Char]]]) -> [[[Char]]] -> [Char]
foldListList [[[Char]]] -> [[[Char]]]
stylish [[[Char]]]
allBlock = ([Char] -> ShowS) -> [Char] -> [[Char]] -> [Char]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
L.foldr[Char] -> ShowS
forall a. [a] -> [a] -> [a]
(+)[] ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ ([[Char]] -> [Char]) -> [[[Char]]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> [[Char]] -> [Char]
concatStr' []) [[[Char]]]
zhtml 
               where
                -- flip does not?
                concatStr' :: [Char] -> [[Char]] -> [Char]
concatStr' [Char]
x [[Char]]
y  = [[Char]] -> ShowS
concatStr [[Char]]
y [Char]
x
                -- Add PID in allBlock?
                code :: [([[Char]], [[Char]])]
code = [[[Char]]] -> [[[Char]]] -> [([[Char]], [[Char]])]
forall a b. [a] -> [b] -> [(a, b)]
zip ((([[Char]] -> [[Char]]) -> [[[Char]]] -> [[[Char]]]
forall a b. (a -> b) -> [a] -> [b]
map (([[Char]] -> [[Char]]) -> [[[Char]]] -> [[[Char]]])
-> (ShowS -> [[Char]] -> [[Char]])
-> ShowS
-> [[[Char]]]
-> [[[Char]]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map)([Char] -> ShowS
forall a. [a] -> [a] -> [a]
+ [Char]
br) ([[[Char]]] -> [[[Char]]]) -> [[[Char]]] -> [[[Char]]]
forall a b. (a -> b) -> a -> b
$ [[[Char]]] -> [[[Char]]]
stylish [[[Char]]]
allBlock) [[[Char]]]
allBlock -- code => stylish code
                -- n    => [1..] => Primary Key in CodeBlock
                -- code => [(x, b)] => [([String], [String])]
                -- zhtml = [[String]]
                zhtml :: [[[Char]]]
zhtml = (Integer -> ([[Char]], [[Char]]) -> [[Char]])
-> [Integer] -> [([[Char]], [[Char]])] -> [[[Char]]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith(\Integer
n ([[Char]]
x, [[Char]]
b) ->[Integer -> ShowS
hiddenForm2 Integer
n ([[Char]] -> [Char]
unlines [[Char]]
b)] [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
+
                                 [ShowS
forall a. (Semigroup a, IsString a) => a -> a
preT ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ (ShowS
H1.ondblclick_ ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ [Char] -> ShowS
fun [Char]
"showandhide" (Integer -> [Char]
ts Integer
n)) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
+ (ShowS
H1.class_ ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ [Char]
"co" [Char] -> Integer -> [Char]
+| Integer
n) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
+ (ShowS
H1.id_ ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ [Char]
"c" [Char] -> Integer -> [Char]
+| Integer
n)] [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
+
                                 [ShowS
div_ [Char]
ac] [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
+ [[Char]]
x [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
+ [[Char]
cdiv] [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
+ [[Char]
cpre] [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
+ [Integer -> [Char]
forall a. Show a => a -> [Char]
toClipboard Integer
n]) [Integer
1..] [([[Char]], [[Char]])]
code
                
                br :: [Char]
br          =  [Char]
"<br>"
                cdiv :: [Char]
cdiv        =  [Char]
"</div>"
                cpre :: [Char]
cpre        =  [Char]
"</pre>"
                preT :: a -> a
preT a
s      =  a
"<pre " a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
s a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
" >"
                ao :: [Char]
ao          =  [Char]
"<"
                ac :: [Char]
ac          =  [Char]
">"
                divo :: [Char]
divo        =  [Char]
"<div "
                div_ :: ShowS
div_ [Char]
s      =  [Char]
"<div " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
+ [Char]
s
                ts :: Integer -> [Char]
ts          =  Integer -> [Char]
intToString
                + :: [a] -> [a] -> [a]
(+)         =  [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
(++)
                +| :: [Char] -> Integer -> [Char]
(+|) [Char]
s Integer
n    =  [Char]
s [Char] -> ShowS
forall a. [a] -> [a] -> [a]
+ (Integer -> [Char]
ts Integer
n)
                fun :: [Char] -> ShowS
fun [Char]
s [Char]
arg   =  [Char]
s [Char] -> ShowS
forall a. [a] -> [a] -> [a]
+ [Char]
"(" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
+ [Char]
arg [Char] -> ShowS
forall a. [a] -> [a] -> [a]
+ [Char]
")"
                -- toClipboard n    = [r|<div class="butcen"><input type="button" class="butcopy" onClick="clip(document.getElementById('|] <> "c" <> (show n) <> [r|'));" name="cp" value="copy" ></div>|]
                toClipboard :: a -> [Char]
toClipboard a
n    = [r|<div class="butcen"><input type="button" class="butcopy" onClick="copyToClipboardFromTextArea('|] [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
eleIdCodeBlock [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> (a -> [Char]
forall a. Show a => a -> [Char]
show a
n) [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [r|');" name="cp" value="copy" ></div>|]
                inputNum :: Text -> Text
inputNum Text
n  = [NI.text|<div class="butcen"><input type="button" onClick="clip(document.getElementById('c${n}'));" name="cp" value="copy" ></div>|] 


                    

{-|
   @
   [([String], Integer, Integer,  Integer)]
   [(codeBody, pid,      addedtime, score)]

   [
     ( [ "line2" ]         -- [String]
     , 4                   -- pid
     , 8                   -- addedtime
     , 3                   -- score
     )
   ]

   [
        ( "23423"
        ,
            [
                (
                    [ "23423:*:what0000"   -- [String]
                    , "line 4"             
                    ]
                , 117                      -- table pid
                , 1635398867               -- addedtime
                , 33                       -- score
                )
            ,
                (
                    [ "23423:*:test"
                    , "line1000"
                    ]
                , 113
                , 1635380323
                , 0
                )
            ]
        )
    ,
        ( "updat"
        ,
            [
                (
                    [ "test:*: test10, ok, update444"
                    , " line 'dog'cat"
                    , "fac ← {⍵ > 1 : ⍵×fac ⍵ - 1 ⋄ 1}"
                    , "nice"
                    , "update"
                    , "line444"
                    , "line555"
                    ]
                , 35
                , 1635399200
                , 8
                )
            ]
        )
    ]


   @


-}
foldListList2::([[String]]->[[String]])->[([String], Integer, Integer, Integer)]->String
foldListList2 :: ([[[Char]]] -> [[[Char]]])
-> [([[Char]], Integer, Integer, Integer)] -> [Char]
foldListList2 [[[Char]]] -> [[[Char]]]
stylish [([[Char]], Integer, Integer, Integer)]
allBlock = ([Char] -> ShowS) -> [Char] -> [[Char]] -> [Char]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
L.foldr[Char] -> ShowS
forall a. [a] -> [a] -> [a]
(+)[]  [[Char]]
zhtml3
               where
                -- flip does not?
                concatStr' :: [Char] -> [[Char]] -> [Char]
concatStr' [Char]
x [[Char]]
y  = [[Char]] -> ShowS
concatStr [[Char]]
y [Char]
x
                -- Add PID in allBlock?
                -- show the newest added code first
  
                -- TODO: Add diffe rent sortings flag from user input
                sortAllBlock :: [([[Char]], Integer, Integer, Integer)]
sortAllBlock = (([[Char]], Integer, Integer, Integer)
 -> ([[Char]], Integer, Integer, Integer) -> Bool)
-> [([[Char]], Integer, Integer, Integer)]
-> [([[Char]], Integer, Integer, Integer)]
forall a. (a -> a -> Bool) -> [a] -> [a]
qqsort(\([[Char]]
_ , Integer
_ , Integer
time , Integer
score) ([[Char]]
_ , Integer
_ , Integer
time' , Integer
score') -> Integer
score Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
score') [([[Char]], Integer, Integer, Integer)]
allBlock
                
                -- allBlock' = map ft1 allBlock
                sortAllBlock' :: [[[Char]]]
sortAllBlock' = (([[Char]], Integer, Integer, Integer) -> [[Char]])
-> [([[Char]], Integer, Integer, Integer)] -> [[[Char]]]
forall a b. (a -> b) -> [a] -> [b]
map ([[Char]], Integer, Integer, Integer) -> [[Char]]
forall a b c d. (a, b, c, d) -> a
ft1 [([[Char]], Integer, Integer, Integer)]
sortAllBlock
                -- code = zip ((map . map)(\x -> x + br) $ stylish allBlock') allBlock -- code => stylish code
                code1 :: [([[Char]], [[Char]], Integer)]
code1 = ([[Char]]
 -> ([[Char]], Integer, Integer, Integer)
 -> ([[Char]], [[Char]], Integer))
-> [[[Char]]]
-> [([[Char]], Integer, Integer, Integer)]
-> [([[Char]], [[Char]], Integer)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\[[Char]]
s1 ([[Char]], Integer, Integer, Integer)
s2 -> ([[Char]]
s1, ([[Char]], Integer, Integer, Integer) -> [[Char]]
forall a b c d. (a, b, c, d) -> a
ft1 ([[Char]], Integer, Integer, Integer)
s2, ([[Char]], Integer, Integer, Integer) -> Integer
forall a b c d. (a, b, c, d) -> b
ft2 ([[Char]], Integer, Integer, Integer)
s2)) ((([[Char]] -> [[Char]]) -> [[[Char]]] -> [[[Char]]]
forall a b. (a -> b) -> [a] -> [b]
map (([[Char]] -> [[Char]]) -> [[[Char]]] -> [[[Char]]])
-> (ShowS -> [[Char]] -> [[Char]])
-> ShowS
-> [[[Char]]]
-> [[[Char]]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map) ([Char] -> ShowS
forall a. [a] -> [a] -> [a]
+ [Char]
br) ([[[Char]]] -> [[[Char]]]) -> [[[Char]]] -> [[[Char]]]
forall a b. (a -> b) -> a -> b
$ [[[Char]]] -> [[[Char]]]
stylish [[[Char]]]
sortAllBlock') [([[Char]], Integer, Integer, Integer)]
sortAllBlock
                -- Wed 27 May 01:28:32 2020 
                -- TODO1: Add id here to delete it

                -- zhtml3 =>
                -- <pre  ondblclick='showandhide(128)'   class='co0'   id='c128'  >
                -- <div>
                -- <span style="color:gray;">firstone:*: tt4, update, ok, newme, update</span>
                -- <br> test1 test2
                -- <br> test3 test4<br>
                -- </div>
                -- </pre>
                --
                zhtml3 :: [[Char]]
zhtml3 = (([[Char]], [[Char]], Integer) -> [Char])
-> [([[Char]], [[Char]], Integer)] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map(\([[Char]]
x, [[Char]]
b, Integer
n) -> [Char] -> ShowS
div_ [Char]
"" (Integer -> ShowS
hiddenForm2 Integer
n ([[Char]] -> [Char]
unlines [[Char]]
b) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
+
                                           (
                                             [Char] -> ShowS
H2.pre_ ([[Char]] -> ShowS
concatStr [[[Char]] -> [Char]
H2.ondblclick_ [[Char] -> ShowS
fun [Char]
"showandhide" (Integer -> [Char]
ts Integer
n)],
                                                                 [[Char]] -> [Char]
H2.class_ [[Char]
"co" [Char] -> Integer -> [Char]
forall a. Show a => [Char] -> a -> [Char]
++> Integer
0],
                                                                 [[Char]] -> [Char]
H2.id_ [[Char]
"c" [Char] -> Integer -> [Char]
forall a. Show a => [Char] -> a -> [Char]
++> Integer
n]   -- HTML element CAN NOT have multiple id =>  <pre id='s1' id='s2'>
                                                                ] [Char]
" "
                                                     )
                                                    ([Char] -> ShowS
H2.div_ [] ([[Char]] -> ShowS
concatStr [[Char]]
x [])) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
+ 
                                                    Integer -> [Char]
forall a. Show a => a -> [Char]
toClipboard Integer
n
                                           ))
                            ) [([[Char]], [[Char]], Integer)]
code1
                ft1 :: (a, b, c, d) -> a
ft1 (a
a, b
b, c
c, d
d) = a
a
                ft2 :: (a, b, c, d) -> b
ft2 (a
a, b
b, c
c, d
d) = b
b
                br :: [Char]
br          =  [Char]
"<br>"
                ts :: Integer -> [Char]
ts          =  Integer -> [Char]
intToString
                + :: [a] -> [a] -> [a]
(+)         =  [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
(++)
                ++> :: [Char] -> a -> [Char]
(++>) [Char]
s a
n     =  [Char]
s [Char] -> ShowS
forall a. [a] -> [a] -> [a]
+ (a -> [Char]
forall a. Show a => a -> [Char]
show a
n)
                +| :: [Char] -> Integer -> [Char]
(+|) [Char]
s Integer
n    =  [Char]
s [Char] -> ShowS
forall a. [a] -> [a] -> [a]
+ Integer -> [Char]
ts Integer
n
                fun :: [Char] -> ShowS
fun [Char]
s [Char]
arg   =  [Char]
s [Char] -> ShowS
forall a. [a] -> [a] -> [a]
+ [Char]
"(" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
+ [Char]
arg [Char] -> ShowS
forall a. [a] -> [a] -> [a]
+ [Char]
")"
                -- toClipboard n    = [r|<div class="butcen"><input type="button" class="butcopy" onClick="clip(document.getElementById('|] <> "c" <> (show n) <> [r|'));" name="cp" value="copy" ></div>|]
                toClipboard :: a -> [Char]
toClipboard a
n    = [r|<div class="butcen"><input type="button" class="butcopy" onClick="copyToClipboardFromTextArea('|] [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
eleIdCodeBlock [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> a -> [Char]
forall a. Show a => a -> [Char]
show a
n [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [r|');" name="cp" value="copy" ></div>|]
                inputNum :: Text -> Text
inputNum Text
n  = [NI.text|<div class="butcen"><input type="button" onClick="clip(document.getElementById('c${n}'));" name="cp" value="copy" ></div>|] 
                    



-- myfun  var  = [text|dog_cat_${var}_pig|] 

myfun :: Text -> Text
myfun Text
name = [NI.text|this_could_be_'${name}'_long_identifier|]
fun4 :: Text -> [Char]
fun4 Text
name = Text -> [Char]
forall a. Typeable a => a -> [Char]
toStr [NI.text|${name}|]

foldListListTxt::[[String]]->String
foldListListTxt :: [[[Char]]] -> [Char]
foldListListTxt [[[Char]]]
allBlock = ([Char] -> ShowS) -> [Char] -> [[Char]] -> [Char]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
L.foldr(\[Char]
x [Char]
y -> [Char]
x [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"\n" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
y) []  
                           ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ ([[Char]] -> [[Char]] -> [[Char]])
-> [[Char]] -> [[[Char]]] -> [[Char]]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
L.foldr(\[[Char]]
x [[Char]]
y -> [[Char]]
x [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]
"\n"] [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]]
y) [] [[[Char]]]
allBlock    -- f s => [[String]]
                           
foldListListTxt2::[([String], Integer, Integer, Integer)] -> String
foldListListTxt2 :: [([[Char]], Integer, Integer, Integer)] -> [Char]
foldListListTxt2 [([[Char]], Integer, Integer, Integer)]
allBlock = ([Char] -> ShowS) -> [Char] -> [[Char]] -> [Char]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
L.foldr(\[Char]
x [Char]
y -> [Char]
x [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"\n" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
y) [] ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$
                              ([[Char]] -> [[Char]] -> [[Char]])
-> [[Char]] -> [[[Char]]] -> [[Char]]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
L.foldr(\[[Char]]
x [[Char]]
y -> [[Char]]
x [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]
"\n"] [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]]
y) [] [[[Char]]]
allBlock'
                         where
                            allBlock' :: [[[Char]]]
allBlock' = (([[Char]], Integer, Integer, Integer) -> [[Char]])
-> [([[Char]], Integer, Integer, Integer)] -> [[[Char]]]
forall a b. (a -> b) -> [a] -> [b]
map ([[Char]], Integer, Integer, Integer) -> [[Char]]
forall a b c d. (a, b, c, d) -> a
x1 [([[Char]], Integer, Integer, Integer)]
allBlock
                            x1 :: (a, b, c, d) -> a
x1 (a
a, b
b, c
c, d
d) = a
a




-- /Library/WebServer/Documents/zsurface/pdf
pdfname :: [Char]
pdfname   = [Char]
"Very Important File"
img :: [Char]
img     = [Char]
"img.png"
pdfPath :: [Char]
pdfPath = [Char]
"/Library/WebServer/Documents/zsurface/pdf"
docRoot :: [Char]
docRoot = [Char]
"/Library/WebServer/Documents/zsurface"
doc :: [Char]
doc     = [Char]
""
cmdLog :: [Char]
cmdLog  = [Char]
"/Users/aaa/myfile/bitbucket/testfile/waiCmdLog.txt"

currCmdFile :: [Char]
currCmdFile = [Char]
"/Users/aaa/myfile/bitbucket/testfile/currCmd.txt"

logCurrCmd::[String] -> IO()
logCurrCmd :: [[Char]] -> IO ()
logCurrCmd = [Char] -> [[Char]] -> IO ()
writeToFile [Char]
currCmdFile

readCurrCmd::IO String                               
readCurrCmd :: IO [Char]
readCurrCmd = [Char] -> IO [Char]
readFileLatin1 [Char]
currCmdFile

              
{-|
                              [([String], Integer, Integer,  Integer)]

                              [(codeBody,   pid,   addedtime,  score)]
                                   ↓         ↓        ↓          ↓ 
-}
type HMap2 = M.HashMap String [([String], Integer, Integer,   Integer)]
          
type PDFMap = M.HashMap String String

-- Response html, css, js, pdf from Server
type RespMap = M.HashMap String String

genePDF::String->IO() 
genePDF :: [Char] -> IO ()
genePDF [Char]
p = do 
    [[Char]]
f <- [Char] -> IO [[Char]]
A.lsFile [Char]
p 
    -- mapM print f
    IO ()
A.fl
    let list :: [[Char]]
list = ShowS -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map(\[Char]
x -> [Char] -> [Char] -> ShowS
href ([Char]
doc [Char] -> ShowS
</> [Char]
x) [Char]
pdfname [Char]
img [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"<br>")  [[Char]]
f
    -- mapM print list
    [Char] -> [[Char]] -> IO ()
A.writeToFile [Char]
"./pdf.html" [[Char]]
list 


{-| 
    === Main Application entry

    @
    type Application = Request -> (Response -> IO ResponseReceived) -> IO ResponseReceived
    @

    * Add *src/aronlib.js* as *Javascript* library which includes all javascript functions
    * Copy to clipboard still not working so far.

    <http://localhost/html/indexWhatIdidtoday.html#orgc0b84d7 Here_is_Why>

    :NOTE: USE IT
-} 
-- app2::Ghci -> Connection -> IORef HMap2->Application
app2::Connection -> IORef HMap2 -> IORef PDFMap -> RespMap -> Application
app2 :: Connection
-> IORef HMap2
-> IORef (HashMap [Char] [Char])
-> HashMap [Char] [Char]
-> Application
app2 Connection
conn1 IORef HMap2
ref IORef (HashMap [Char] [Char])
pdfMapRef HashMap [Char] [Char]
rmap Request
request Response -> IO ResponseReceived
respond = do
  let x :: Integer
x = Integer
100
  let s :: [Char]
s = [Char]
"a"
  [[Char]] -> IO ()
logFileG [[Char]
"pathInfo_request=>" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Text] -> [Char]
forall a. Show a => a -> [Char]
show (Request -> [Text]
pathInfo Request
request)]
  case Request -> [Text]
pathInfo Request
request of 
   (Text
"test":[Text]
_)       -> Response -> IO ResponseReceived
respond (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ [Char] -> Response
responseNothing [Char]
"test nothing"
   (Text
"raw":[Text]
_)        -> Response -> IO ResponseReceived
respond Response
plainIndex
   (Text
"up":[Text]
_)         -> Response -> IO ResponseReceived
respond Response
uploadPage
   (Text
"insertinfo":[Text]
_) -> Response -> IO ResponseReceived
respond Response
insertinfo
   (Text
"listPage":[Text]
_)   -> Connection -> Application
listPage Connection
conn1 Request
request Response -> IO ResponseReceived
respond
   (Text
"insertUser":[Text]
_) -> Response -> IO ResponseReceived
respond Response
insertUser
   (Text
"login":[Text]
_)      -> Response -> IO ResponseReceived
respond Response
loginHtml
   (Text
"genepdf":[Text]
_)    -> Response -> IO ResponseReceived
respond (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ Connection -> Response
responseGenePDFHtml Connection
conn1
   (Text
"pdfimage":Text
fn:[Text]
_)-> do
                         let fname :: [Char]
fname = let p :: ByteString
p = Request -> ByteString
rawPathInfo Request
request 
                                     in ByteString -> [Char]
forall a. Typeable a => a -> [Char]
toStr (ByteString -> [Char])
-> ([ByteString] -> ByteString) -> [ByteString] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
forall a. [a] -> a
last ([ByteString] -> [Char]) -> [ByteString] -> [Char]
forall a b. (a -> b) -> a -> b
$ (ByteString -> Bool) -> [ByteString] -> [ByteString]
forall a. (a -> Bool) -> [a] -> [a]
filter(\ByteString
x -> ByteString -> Int
BS.length ByteString
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 ) ([ByteString] -> [ByteString]) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> a -> b
$ Word8 -> ByteString -> [ByteString]
A.splitBS (Char -> Word8
c2w_ Char
'/') ByteString
p  
                         [[Char]] -> IO ()
logFileG [[Char]
"pdfimage fname =>" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
fname]
                         Response -> IO ResponseReceived
respond (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> Response
sendImage [Char]
"pdfimage" [Char]
fname

   (Text
"pdf":Text
fn:[Text]
_)     -> do
                         let fname :: [Char]
fname = let p :: ByteString
p = Request -> ByteString
rawPathInfo Request
request 
                                     in ByteString -> [Char]
forall a. Typeable a => a -> [Char]
toStr (ByteString -> [Char])
-> ([ByteString] -> ByteString) -> [ByteString] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
forall a. [a] -> a
last ([ByteString] -> [Char]) -> [ByteString] -> [Char]
forall a b. (a -> b) -> a -> b
$ (ByteString -> Bool) -> [ByteString] -> [ByteString]
forall a. (a -> Bool) -> [a] -> [a]
filter(\ByteString
x -> ByteString -> Int
BS.length ByteString
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 ) ([ByteString] -> [ByteString]) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> a -> b
$ Word8 -> ByteString -> [ByteString]
A.splitBS (Char -> Word8
c2w_ Char
'/') ByteString
p  
                         [Char] -> IO ()
forall a. Show a => a -> IO ()
print [Char]
fname
                         [[Char]] -> IO ()
logFileG [[Char]
"pdf fname =>" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
fname]
                         Response -> IO ResponseReceived
respond (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> Response
sendPDF [Char]
"pdf" [Char]
fname 
                         -- respond $ pdfSentX $ strictTextToStrictByteString fn 
   (Text
"loginCheck":[Text]
_)      -> Connection -> Application
loginCheck Connection
conn1 Request
request Response -> IO ResponseReceived
respond
   (Text
"insertUserDB":[Text]
_)    -> Connection -> Application
insertUserDB Connection
conn1 Request
request Response -> IO ResponseReceived
respond
   (Text
"insert":[Text]
_)          -> Connection -> Application
insertDatabase Connection
conn1 Request
request Response -> IO ResponseReceived
respond
   (Text
"upload":[Text]
_)          -> [Char] -> Application
upload [Char]
updir Request
request Response -> IO ResponseReceived
respond
   (Text
"getjson":[Text]
_)         -> [Char] -> Application
upload [Char]
updir Request
request Response -> IO ResponseReceived
respond

   (Text
"snippet":[Text]
_)         -> do
                            -- mayCmd = Just "s grep"
                            let mayCmd :: Maybe [Char]
mayCmd = ByteString -> [Char]
forall a. Typeable a => a -> [Char]
toStr (ByteString -> [Char]) -> Maybe ByteString -> Maybe [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Request -> Maybe ByteString
getQueryString ByteString
"id" Request
request
                            [[Char]] -> IO ()
logFileG [[Char]
"mayCmd=>" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Maybe [Char] -> [Char]
forall a. Show a => a -> [Char]
show Maybe [Char]
mayCmd]
                            case Maybe [Char]
mayCmd of
                                Just [Char]
cmd -> [Char] -> [Char] -> IO ()
redisSet [Char]
keyLastCmd [Char]
cmd
                                Maybe [Char]
Nothing  -> [Char] -> [Char] -> IO ()
redisSet [Char]
keyLastCmd []
                            Response -> IO ResponseReceived
respond (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ Connection -> IORef HMap2 -> Maybe [Char] -> Response
responseFromCmd Connection
conn1 IORef HMap2
ref Maybe [Char]
mayCmd 
                            -- respond $ anyRoute2 conn1 ref request   -- anyRoute => Response, respond (Response) => IO ResponseReceived

   -- See $b/jslib/aronlib.js, send Ajax to server
   -- url = "http://localhost:8080/json"; in postMatrix.html
   -- geneRectMat::Application
   (Text
"json":[Text]
_)            -> Application
geneRectMat Request
request Response -> IO ResponseReceived
respond
   -- test json
   (Text
"testjson":[Text]
_)         -> do
                               -- jsonFile src/datadir/latex/indexEditorACE/indexEditorACE.json
                               [Char]
jsonFile <- [Char] -> EFileType -> IO [Char]
datadirFull [Char]
"indexEditorACE" EFileType
EJSON
                               Maybe EditorCode
mjson <- [Char] -> IO (Maybe EditorCode)
forall a. FromJSON a => [Char] -> IO (Maybe a)
jsonToRecord [Char]
jsonFile :: IO (Maybe EditorCode)
                               Maybe EditorCode -> IO ()
forall (m :: * -> *) a. (MonadIO m, Show a) => a -> m ()
pre Maybe EditorCode
mjson
                               case Maybe EditorCode
mjson of
                                 Just EditorCode
record -> Response -> IO ResponseReceived
respond (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ EditorCode -> Response
forall a. ToJSON a => a -> Response
responseJSON EditorCode
record
                                 Maybe EditorCode
Nothing -> Response -> IO ResponseReceived
respond (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ Response
responseHelp
   (Text
"htmlfetchjson":[Text]
_)         -> Response -> IO ResponseReceived
respond Response
htmlfetchjson

  
   (Text
"htmltable":[Text]
_)       -> Application
geneHTMLTable Request
request Response -> IO ResponseReceived
respond
   (Text
"updatebackground":[Text]
_) -> Application
updateBackground Request
request Response -> IO ResponseReceived
respond  -- change background color
   -- ("updatetextcolor":_) -> updateTextColor request respond    -- change text color

   (Text
"editor":[Text]
_)          -> Response -> IO ResponseReceived
respond Response
replyEditor
   (Text
"search":[Text]
_)          -> Response -> IO ResponseReceived
respond Response
searchUI
   (Text
"wordcount":[Text]
_)       -> Response -> IO ResponseReceived
respond Response
replyCssButton
   (Text
"wordcount_reply":[Text]
_) -> Response -> IO ResponseReceived
respond Response
wordcountReply
   -- ("matrix":_)          -> respond matrixReply
   (Text
"matrix":[Text]
_)          -> Connection -> IORef HMap2 -> Application
respondMatrix Connection
conn1 IORef HMap2
ref Request
request Response -> IO ResponseReceived
respond
   (Text
"htmltablecmd":[Text]
_)    -> Response -> IO ResponseReceived
respond Response
sendHTMLTableCmd
   (Text
"compiler":[Text]
_)        -> Application
receiveCode Request
request Response -> IO ResponseReceived
respond
   (Text
"editcode":[Text]
_)        -> Response -> IO ResponseReceived
respond (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ [Char] -> Response
responseHtml [Char]
"compileCode.html"      -- haskellwebapp2/compileCode.html
   (Text
"getcolor":[Text]
_)        -> Application
getPreFromRedis Request
request Response -> IO ResponseReceived
respond -- Send JSON PreColor{color::TS.Text, background::TS.Text} to client side, in aronlib.js
   (Text
"updatecode":[Text]
_)      -> Connection -> IORef HMap2 -> Application
updateCodeBlock Connection
conn1 IORef HMap2
ref Request
request Response -> IO ResponseReceived
respond -- CodeBlockReply{ok::String, retcmd::String, retbegt::Integer, retendt::Integer} deriving (Generic, Show) 
                                                                      -- SEE: aronlib.js updateCodeBlock
   (Text
"addscore":[Text]
_)        -> Connection -> IORef HMap2 -> Application
addScoreCodeBlock Connection
conn1 IORef HMap2
ref Request
request Response -> IO ResponseReceived
respond
   (Text
"subtractscore":[Text]
_)   -> Connection -> IORef HMap2 -> Application
subtractScoreCodeBlock Connection
conn1 IORef HMap2
ref Request
request Response -> IO ResponseReceived
respond
  
   (Text
"insertcode":[Text]
_)      -> Connection -> IORef HMap2 -> Application
insertCodeBlock Connection
conn1 IORef HMap2
ref Request
request Response -> IO ResponseReceived
respond -- Send JSON PreColor{color::TS.Text, background::TS.Text} to client side, in aronlib.js

   (Text
"editordata":[Text]
_)      -> Connection
-> IORef HMap2 -> IORef (HashMap [Char] [Char]) -> Application
receiveEditorData Connection
conn1 IORef HMap2
ref IORef (HashMap [Char] [Char])
pdfMapRef Request
request Response -> IO ResponseReceived
respond -- Receive Latex code from ACE editor, ace editor
   
   -- ("aceeditor":_)       -> respond $ responseHtml "indexEditorACE.html" -- Receive Latex code from ACE editor, ace editor
   --
   --                        NOTE: xfido.com/aceeditor?id=try919591
   --                        If try919591 is in the Redis db, return try919591.html else return default responseHelp
   --
   (Text
"apijson":[Text]
_)         -> let query :: [(ByteString, Maybe ByteString)]
query = Request -> [(ByteString, Maybe ByteString)]
queryString Request
request :: [(BS.ByteString, Maybe BS.ByteString)]
                                idParam :: Maybe ByteString
idParam = Maybe (Maybe ByteString) -> Maybe ByteString
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe (Maybe ByteString) -> Maybe ByteString)
-> Maybe (Maybe ByteString) -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ ByteString
-> [(ByteString, Maybe ByteString)] -> Maybe (Maybe ByteString)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup ByteString
"id" [(ByteString, Maybe ByteString)]
query :: Maybe BS.ByteString
                            in case ByteString -> [Char]
forall a. Typeable a => a -> [Char]
toStr (ByteString -> [Char]) -> Maybe ByteString -> Maybe [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ByteString
idParam of
                                 -- => try919591.html
                                 Just [Char]
s  -> do
                                   Maybe [Char]
redisValue <- [Char] -> IO (Maybe [Char])
redisGet [Char]
s
                                   case Maybe [Char]
redisValue of  -- indexEditorACEtry919591.html
                                        Just [Char]
v -> do
                                          [Char]
jsonFile <- [Char] -> EFileType -> IO [Char]
datadirFull [Char]
v EFileType
EJSON
                                          [Char]
jstr <- [Char] -> IO [Char]
readFileStr [Char]
jsonFile
                                          let decodeStr :: Maybe EditorCode
decodeStr = ByteString -> Maybe EditorCode
forall a. FromJSON a => ByteString -> Maybe a
DA.decode ([Char] -> ByteString
forall a. Typeable a => a -> ByteString
toLBS [Char]
jstr) :: Maybe EditorCode
                                          Maybe EditorCode -> IO ()
forall (m :: * -> *) a. (MonadIO m, Show a) => a -> m ()
pre Maybe EditorCode
decodeStr
                                          case Maybe EditorCode
decodeStr of
                                            Maybe EditorCode
Nothing  -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                                            Just EditorCode
x -> [[Char]] -> IO ()
logFileG [EditorCode -> [Char]
forall a. Show a => a -> [Char]
show EditorCode
x]  -- write to "/tmp/x.x"
                                          Response -> IO ResponseReceived
respond Response
responseHelp
                                        Maybe [Char]
_      -> Response -> IO ResponseReceived
respond Response
responseHelp
                                 Maybe [Char]
Nothing  -> Response -> IO ResponseReceived
respond Response
responseHelp

   (Text
"aceeditor":[Text]
_)       -> let query :: [(ByteString, Maybe ByteString)]
query = Request -> [(ByteString, Maybe ByteString)]
queryString Request
request :: [(BS.ByteString, Maybe BS.ByteString)]
                                idParam :: Maybe ByteString
idParam = Maybe (Maybe ByteString) -> Maybe ByteString
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe (Maybe ByteString) -> Maybe ByteString)
-> Maybe (Maybe ByteString) -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ ByteString
-> [(ByteString, Maybe ByteString)] -> Maybe (Maybe ByteString)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup ByteString
"id" [(ByteString, Maybe ByteString)]
query :: Maybe BS.ByteString
                            in case ByteString -> [Char]
forall a. Typeable a => a -> [Char]
toStr (ByteString -> [Char]) -> Maybe ByteString -> Maybe [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ByteString
idParam of
                                 -- => try919591.html
                                 Just [Char]
s  -> do
                                   Maybe [Char]
redisValue <- [Char] -> IO (Maybe [Char])
redisGet [Char]
s
                                   case Maybe [Char]
redisValue of  -- indexEditorACEtry919591.html
                                     -- Just v -> respond $ responseHtml $ v ++ ".html" -- Receive Latex code from ACE editor, ace editor
                                     --  src/datadir/latex/try919591/try919591.html
                                     Just [Char]
v -> do
                                       -- TODO:
                                       -- load src/datadir/latex/try919591/try919591.json
                                       [Char]
jsonFile <- [Char] -> EFileType -> IO [Char]
datadirFull [Char]
v EFileType
EJSON
                                       [Char]
jstr <- [Char] -> IO [Char]
readFileStr [Char]
jsonFile
                                       let decodeStr :: Maybe EditorCode
decodeStr = ByteString -> Maybe EditorCode
forall a. FromJSON a => ByteString -> Maybe a
DA.decode ([Char] -> ByteString
forall a. Typeable a => a -> ByteString
toLBS [Char]
jstr) :: Maybe EditorCode
                                       case Maybe EditorCode
decodeStr of
                                         Maybe EditorCode
Nothing  -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                                         (Just EditorCode
x) -> [[Char]] -> IO ()
logFileG [EditorCode -> [Char]
forall a. Show a => a -> [Char]
show EditorCode
x]  -- write to $glog
   
                                       [Char]
htmlFile <- [Char] -> EFileType -> IO [Char]
datadirFull [Char]
v EFileType
EHTML
                                       Response -> IO ResponseReceived
respond (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ [Char] -> Response
responseHtml [Char]
htmlFile  --  src/datadir/latex/try919591/try919591.html
                                     Maybe [Char]
_      -> Response -> IO ResponseReceived
respond Response
responseHelp
    
                                 -- xfido.com/aceeditor
                                 -- return default latex pdf file according to indexEditorACE.html
                                 Maybe [Char]
Nothing -> do
                                              [Char]
ran <- IO [Char]
randomName
                                              let pdfName :: [Char]
pdfName = [Char]
ran [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
".pdf"
                                              [Char]
fullrootdir <- IO [Char]
getRootDirFull
                                              let name :: [Char]
name = (ShowS
dropExt [Char]
"indexEditorACE.html") [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
ran [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
".html"  -- indexEditorACEtry919591.html
                                              let fullName :: [Char]
fullName = [Char]
fullrootdir [Char] -> ShowS
</> [Char]
name
                                              -- FIXME: 
                                              [Char] -> [Char] -> IO ()
copyFile ([Char]
fullrootdir [Char] -> ShowS
</> [Char]
indexEditorHTML) [Char]
fullName
                                              [[Char]] -> IO ()
logFileG [[Char]
fullrootdir [Char] -> ShowS
</> [Char]
indexEditorHTML]  -- write to "/tmp/x.x"
                                              
                                              -- mayEditorCode <- jsonToRecord "/dog" :: IO (Maybe EditorCode)
                                              Maybe EditorCode
mayEditorCode <- [Char] -> IO (Maybe EditorCode)
forall a. FromJSON a => [Char] -> IO (Maybe a)
jsonToRecord ([Char]
fullrootdir [Char] -> ShowS
</> [Char]
indexEditorJSON) :: IO (Maybe EditorCode)
                                              let jeditorcode :: EditorCode
jeditorcode = case Maybe EditorCode
mayEditorCode of
                                                    Just EditorCode
x -> EditorCode
x
                                                    Maybe EditorCode
Nothing -> [Char] -> EditorCode
forall a. HasCallStack => [Char] -> a
error [Char]
"Invalid JSON file: EditorCode"
                                              let clientCode :: [Char]
clientCode = EditorCode -> [Char]
editorcode EditorCode
jeditorcode
                                              IO ()
fl
                                              -- pre clientCode
                                              IO ()
fl
                                              let hiddenHtml :: [Char]
hiddenHtml = [r|<input  type="hidden" id='idlatex' name="myname" value="|] [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
pdfName [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [r|" /> |]
                                              -- KEY: video http://xfido.com/song/haskellwebapp2_help.mp4 
                                              -- let hiddenCompileOrSave = [r|<input  type="hidden" id='hidden_compile_save' name="compilesave" value="|] <> "savepage" <> [r|" /> |]
                                              let hiddenCompileOrSave :: [Char]
hiddenCompileOrSave = [r|<input  type="hidden" id='compilesaveID' name="compilesave" value="|] [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
"compilepage" [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [r|" /> |]
                                                                            
                                              [Char] -> [Char] -> IO ()
writeFileStr [Char]
"/tmp/xx.x" [Char]
clientCode
                                              let str :: [Char]
str = ShowS
strWithSlash ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ [Char]
clientCode
                                              [Char] -> [Char] -> [Char] -> IO ()
replaceFileLineNoRegex [Char]
fullName [Char]
hiddenLATEXCODE [Char]
clientCode

                                              -- target='_blank' => open a new tab
                                              let hiddenPDF :: [Char]
hiddenPDF = [r|<a href="|] [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
pdfName [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [r|" target='_blank' onclick='promptPDFName()'>PDF</a> |]
                                              [CSSPro] -> [Char] -> IO ()
replaceFileListStr [([Char]
"hidden123", [Char]
hiddenHtml), ([Char]
"hidden444", [Char]
hiddenPDF), ([Char]
hiddenCOMPILESAVE, [Char]
hiddenCompileOrSave)] [Char]
fullName
                                                    
                                              -- logFileG ["aceeditor:_ newName => " ++ fullName]  -- write to $glog
                                              [Char] -> [Char] -> IO ()
redisSet [Char]
ran [Char]
ran
                                              [[Char]] -> IO ()
logFileG [[Char]
"fullName=> " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
fullName]
                                              Response -> IO ResponseReceived
respond (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ [Char] -> Response
responseHtml [Char]
fullName -- Receive Latex code from ACE editor, ace editor
                                                    
   (Text
"commandservice":[Text]
_)  -> Connection -> IORef HMap2 -> Application
commandService Connection
conn1 IORef HMap2
ref Request
request Response -> IO ResponseReceived
respond
   (Text
"todojson":[Text]
_)        -> Connection -> IORef HMap2 -> Application
todoPostJSON Connection
conn1 IORef HMap2
ref Request
request Response -> IO ResponseReceived
respond   
   (Text
"deletecode":[Text]
_)      -> Connection -> IORef HMap2 -> Application
deleteCodeBlock Connection
conn1 IORef HMap2
ref Request
request Response -> IO ResponseReceived
respond -- Send JSON PreColor{color::TS.Text, background::TS.Text} to client side, in aronlib.js
   []                    -> Response -> IO ResponseReceived
respond Response
responseHelp
   [Text]
_                     -> do
                              let pdfFile :: [Char]
pdfFile = Text -> [Char]
forall a. Typeable a => a -> [Char]
toStr (Text -> [Char]) -> Text -> [Char]
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. [a] -> a
head ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Request -> [Text]
pathInfo Request
request
                              let mayFile :: Maybe [Char]
mayFile = [Char] -> HashMap [Char] [Char] -> Maybe [Char]
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup [Char]
pdfFile HashMap [Char] [Char]
rmap

                              -- type RespMap = M.HashMap String String
                              -- RespMap : rmap contains all *.css *.pdf *.js *.html files
                              [[Char]] -> IO ()
logFileG [[Char]
"kkkmayFile => " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Maybe [Char] -> [Char]
forall a. Show a => a -> [Char]
show Maybe [Char]
mayFile]
                              [[Char]] -> IO ()
logFileG [[Char]
"kkkpdfFile => " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> [Char]
show [Char]
pdfFile]
                              -- logFileG ["rmap =>    " ++ show rmap]
       
                              case Maybe [Char]
mayFile of
                                   Just [Char]
x -> case (ShowS
lowerStr ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
takeExt) [Char]
x of  -- MultiWayIf
                                                    [Char]
var | [Char]
var [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
".css"  -> Response -> IO ResponseReceived
respond (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ [Char] -> Response
responseCSS [Char]
x
                                                        | [Char]
var [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
".pdf"  -> Response -> IO ResponseReceived
respond (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ [Char] -> Response
responsePDF [Char]
x
                                                        | [Char]
var [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
".png"  -> Response -> IO ResponseReceived
respond (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ [Char] -> Response
responsePNG [Char]
x
                                                        | [Char]
var [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
".js"   -> Response -> IO ResponseReceived
respond (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ [Char] -> Response
responseJavascript [Char]
x
                                                        | [Char]
var [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
".html" -> Response -> IO ResponseReceived
respond (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ [Char] -> Response
responseHtml [Char]
x
                                                        | Bool
otherwise      -> Response -> IO ResponseReceived
respond (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ Response
responseHelp
                                   Maybe [Char]
_      -> do
                                               IO ()
fl
                                               -- pre rmap
                                               IO ()
fl
                                               -- pre mayFile
                                               -- pdfRef => M.HashMap String String
                                               --        => ("try919591" "try919591")
                                               HashMap [Char] [Char]
pdfmap <- IORef (HashMap [Char] [Char]) -> IO (HashMap [Char] [Char])
forall a. IORef a -> IO a
readIORef IORef (HashMap [Char] [Char])
pdfMapRef
                                               let mls :: [CSSPro]
mls = HashMap [Char] [Char] -> [CSSPro]
forall k v. HashMap k v -> [(k, v)]
M.toList HashMap [Char] [Char]
pdfmap
                                               -- queryId = try919591
                                               let queryId :: [Char]
queryId = ShowS
dropExt [Char]
pdfFile
                                               -- logFileG ["queryId => " ++ queryId]  -- write to $glog
                                               -- logFileG $ map show mls -- write to $glog
                                               HashMap [Char] [Char]
osMap <- [Char] -> IO (HashMap [Char] [Char])
confMap [Char]
configFile
                                               let datadirlatex :: [Char]
datadirlatex = [Char] -> HashMap [Char] [Char] -> [Char]
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> a
lookupJust [Char]
"datadirlatex" HashMap [Char] [Char]
osMap   -- "src/datadir/latex"
                                               -- => xfido.com/aceeditor?id=try919591
                                               --   => try919591.html
                                               -- DONE: TODO:   => try919591.pdf  => src/latex/try919591.pdf

                                               -- => datadirlatex </> v </> v ++ ".pdf"
                                               -- path=>src/datadir/latex/try977655/try977655.pdf
                                               -- URL: xfido.com/image/haskellwebapp2_fetch_pdf.png
                                               Maybe [Char]
redisValue <- [Char] -> IO (Maybe [Char])
redisGet [Char]
queryId
                                               -- logFileG ["redisValue=>" ++ show redisValue]
                                               case Maybe [Char]
redisValue of
                                                 Just [Char]
v -> do
                                                             let path :: [Char]
path = [Char]
datadirlatex [Char] -> ShowS
</> [Char]
v [Char] -> ShowS
</> [Char]
v [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
".pdf"
                                                             [[Char]] -> IO ()
logFileG [[Char]
"path=>" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
path]
                                                             -- KEY: send pdf file to client side
                                                             Response -> IO ResponseReceived
respond (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ [Char] -> Response
responsePDF [Char]
path
                                                 Maybe [Char]
_      -> do
                                                             [[Char]] -> IO ()
logFileG [[Char]
"ERROR: WaiLib.hs : pdf file not found in Redis =>  " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
queryId]
                                                             Response -> IO ResponseReceived
respond (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ [Char] -> Response
responseNothing [Char]
"ERROR : PDF => pdf file can not be found in Redis"


{-|
  NOTE: USE in main.hs
-}
resourceList::IO [(String, String)]
resourceList :: IO [CSSPro]
resourceList = do
  [Char]
fullrootdir <- IO [Char]
getRootDirFull
  [[Char]] -> IO ()
logFileG [[Char]
"fullrootdir=" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
fullrootdir]
  HashMap [Char] [Char]
osMap <- [Char] -> IO (HashMap [Char] [Char])
confMap [Char]
configFile
  let datadirlatex :: [Char]
datadirlatex = [Char] -> HashMap [Char] [Char] -> [Char]
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> a
lookupJust [Char]
"datadirlatex" HashMap [Char] [Char]
osMap   -- "src/datadir/latex"
  let f :: [Char] -> m [[Char]]
f [Char]
n = if let s1 :: Bool
s1 = [Char] -> [Char] -> Bool
containStr [Char]
"src/css" [Char]
n
                   s2 :: Bool
s2 = [Char] -> [Char] -> Bool
containStr [Char]
"src/js" [Char]
n
                   s3 :: Bool
s3 = [Char] -> [Char] -> Bool
containStr [Char]
"pdf/" [Char]
n  -- pdf
                   s4 :: Bool
s4 = [Char] -> [Char] -> Bool
containStr [Char]
"pdfimage/" [Char]
n  -- png
                   s5 :: Bool
s5 = [Char] -> [Char] -> Bool
containStr [Char]
datadirlatex [Char]
n
                   s6 :: Bool
s6 = [Char] -> [Char] -> Bool
containStr [Char]
"ace/theme" [Char]
n
                   s7 :: Bool
s7 = [Char] -> [Char] -> Bool
containStr [Char]
"ace/mode" [Char]
n
                   s8 :: Bool
s8 = [Char] -> [Char] -> Bool
containStr [Char]
"ace/build" [Char]
n
                   s9 :: Bool
s9 = Regex -> [Char] -> Bool
forall regex source.
RegexLike regex source =>
regex -> source -> Bool
matchTest ([Char] -> Regex
mkRegex [Char]
"/.*\\.html") [Char]
n
               in Bool
s1 Bool -> Bool -> Bool
|| Bool
s2 Bool -> Bool -> Bool
|| Bool
s3 Bool -> Bool -> Bool
|| Bool
s4 Bool -> Bool -> Bool
|| Bool
s5 Bool -> Bool -> Bool
|| Bool
s6 Bool -> Bool -> Bool
|| Bool
s7 Bool -> Bool -> Bool
|| Bool
s8 Bool -> Bool -> Bool
|| Bool
s9 then [[Char]] -> m [[Char]]
forall (m :: * -> *) a. Monad m => a -> m a
return [[Char]
n] else [[Char]] -> m [[Char]]
forall (m :: * -> *) a. Monad m => a -> m a
return []
  [[Char]]
ls <- [Char] -> ([Char] -> IO [[Char]]) -> IO [[Char]]
dirWalk [Char]
fullrootdir [Char] -> IO [[Char]]
forall (m :: * -> *). Monad m => [Char] -> m [[Char]]
f
  IO ()
fl
  -- pre ls
  [[Char]] -> IO ()
logFileG [[Char]]
ls 
  IO ()
fl
  let matchFileExt :: [Char] -> Bool
matchFileExt [Char]
x = [Char] -> [[Char]] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (ShowS
takeExt [Char]
x) [[Char]
".css", [Char]
".js", [Char]
".pdf", [Char]
".html", [Char]
".png"]
  
  let fls :: [CSSPro]
fls = ([Char] -> CSSPro) -> [[Char]] -> [CSSPro]
forall a b. (a -> b) -> [a] -> [b]
map(\[Char]
x -> (ShowS
takeName [Char]
x,  Integer -> ShowS
dropPath Integer
1 ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ ([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Bool -> Bool
not (Bool -> Bool) -> ([Char] -> Bool) -> [Char] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char] -> Bool
containStr [Char]
"haskellwebapp2")  ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ [Char] -> [[Char]]
splitPath [Char]
x)) ([[Char]] -> [CSSPro]) -> [[Char]] -> [CSSPro]
forall a b. (a -> b) -> a -> b
$ ([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter (\[Char]
x -> [Char] -> Bool
matchFileExt [Char]
x) [[Char]]
ls
  [CSSPro] -> IO [CSSPro]
forall (m :: * -> *) a. Monad m => a -> m a
return [CSSPro]
fls

plainIndex::Response
plainIndex :: Response
plainIndex = Status -> ResponseHeaders -> [Char] -> Maybe FilePart -> Response
responseFile
    Status
status200
    [(HeaderName
"Content-Type", ByteString
"text/html")]
    [Char]
"index.html"
    Maybe FilePart
forall a. Maybe a
Nothing

pdfFile::Response
pdfFile :: Response
pdfFile = Status -> ResponseHeaders -> [Char] -> Maybe FilePart -> Response
responseFile
    Status
status200
    [(HeaderName
"Content-Type", ByteString
"text/html")]
    [Char]
"pdf.html"
    Maybe FilePart
forall a. Maybe a
Nothing
    
{-|
    === Send pdf file to browser 
-}
sendPDF::FilePath -> FilePath -> Response
sendPDF :: [Char] -> [Char] -> Response
sendPDF [Char]
dir [Char]
fn = Status -> ResponseHeaders -> [Char] -> Maybe FilePart -> Response
responseFile
    Status
status200
    [(HeaderName
"Content-Type", ByteString
"application/pdf"),
     (HeaderName
"Content-Disposition", ByteString
"inline;filename=" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>  ByteString
fn')]
    ([Char]
dir [Char] -> ShowS
</> [Char]
fn)
    Maybe FilePart
forall a. Maybe a
Nothing
    where
        fn' :: ByteString
fn' = [Char] -> ByteString
forall a. Typeable a => a -> ByteString
toSBS [Char]
fn
        pdfdir :: [Char]
pdfdir = [Char]
"pdf/"


{-|
    === Send png file, image file to browser 
-}
sendImage::FilePath -> FilePath  -> Response
sendImage :: [Char] -> [Char] -> Response
sendImage [Char]
dir [Char]
fn = Status -> ResponseHeaders -> [Char] -> Maybe FilePart -> Response
responseFile
    Status
status200
    [(HeaderName, ByteString)
imgType,
     (HeaderName
"Content-Disposition", ByteString
"inline;filename=" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>  ByteString
fn')]
    ([Char]
dir [Char] -> ShowS
</> [Char]
fn)
    Maybe FilePart
forall a. Maybe a
Nothing
    where
        imgType :: (HeaderName, ByteString)
imgType = case ShowS
takeExt [Char]
fn of
                        [Char]
v | ShowS
lowerStr [Char]
v [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
".png"  -> (HeaderName
"Content-Type", ByteString
"image/png")
                        [Char]
v | ShowS
lowerStr [Char]
v [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
".gif"  -> (HeaderName
"Content-Type", ByteString
"image/gif")
                        [Char]
v | ShowS
lowerStr [Char]
v [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
".jpg"  -> (HeaderName
"Content-Type", ByteString
"image/jpeg")
                        [Char]
v | ShowS
lowerStr [Char]
v [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
".jpeg" -> (HeaderName
"Content-Type", ByteString
"image/jpeg")
                          | Bool
otherwise -> (HeaderName
"Content-Type", ByteString
"")
        fn' :: ByteString
fn' = [Char] -> ByteString
forall a. Typeable a => a -> ByteString
toSBS [Char]
fn
        pdfdir :: [Char]
pdfdir = [Char]
"pdf/"

pdfSentX::BS.ByteString -> Response
pdfSentX :: ByteString -> Response
pdfSentX ByteString
fn = Status -> ResponseHeaders -> [Char] -> Maybe FilePart -> Response
responseFile
    Status
status200
    [(HeaderName
"Content-Type", ByteString
"image/png"),
     (HeaderName
"Content-Disposition", ByteString
"inline;filename=" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>  ByteString
fn)]
    (ByteString -> [Char]
BU.toString (ByteString -> [Char]) -> ByteString -> [Char]
forall a b. (a -> b) -> a -> b
$ ByteString
pdfdir ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
fn)
    Maybe FilePart
forall a. Maybe a
Nothing
    where
        pdfdir :: ByteString
pdfdir = ByteString
"pdf/"

insertinfo::Response
insertinfo :: Response
insertinfo = Status -> ResponseHeaders -> [Char] -> Maybe FilePart -> Response
responseFile
    Status
status200
    [(HeaderName
"Content-Type", ByteString
"text/html")]
    [Char]
"insert.html"
    Maybe FilePart
forall a. Maybe a
Nothing

insertUser::Response
insertUser :: Response
insertUser = Status -> ResponseHeaders -> [Char] -> Maybe FilePart -> Response
responseFile
    Status
status200
    [(HeaderName
"Content-Type", ByteString
"text/html")]
    [Char]
"insertUser.html"
    Maybe FilePart
forall a. Maybe a
Nothing

loginHtml::Response
loginHtml :: Response
loginHtml = Status -> ResponseHeaders -> [Char] -> Maybe FilePart -> Response
responseFile
    Status
status200
    [(HeaderName
"Content-Type", ByteString
"text/html")]
    [Char]
"login.html"
    Maybe FilePart
forall a. Maybe a
Nothing
  
htmlfetchjson::Response
htmlfetchjson :: Response
htmlfetchjson = Status -> ResponseHeaders -> [Char] -> Maybe FilePart -> Response
responseFile
    Status
status200
    [(HeaderName
"Content-Type", ByteString
"text/html")]
    [Char]
"fetchjson.html"
    Maybe FilePart
forall a. Maybe a
Nothing


searchUI::Response
searchUI :: Response
searchUI = Status -> ResponseHeaders -> [Char] -> Maybe FilePart -> Response
responseFile
    Status
status200
    [(HeaderName
"Content-Type", ByteString
"text/html")]
    [Char]
"searchUI.html"
    Maybe FilePart
forall a. Maybe a
Nothing


notFound :: Response
notFound :: Response
notFound = Status -> ResponseHeaders -> ByteString -> Response
responseLBS
    Status
status404
    [(HeaderName
"Content-Type", ByteString
"text/plain")]
    ByteString
"404 - Not Found"


notFoundStr::IN.ByteString->Response
notFoundStr :: ByteString -> Response
notFoundStr ByteString
s = Status -> ResponseHeaders -> ByteString -> Response
responseLBS
    Status
status404
    [(HeaderName
"Content-Type", ByteString
"text/plain")]
    ByteString
s 

-- let path = "/Users/aaa/myfile/bitbucket/snippets/snippet_test.m
snippetP :: [Char]
snippetP = [Char]
"myfile/bitbucket/snippets/snippet_test.hs"

-- snippetP = "myfile/bitbucket/snippets/snippet.hs"


mapClear2::[String] -> HMap2 -> HMap2
mapClear2 :: [[Char]] -> HMap2 -> HMap2
mapClear2 [[Char]]
cx HMap2
m = (HMap2 -> [Char] -> HMap2) -> HMap2 -> [[Char]] -> HMap2
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (([Char] -> HMap2 -> HMap2) -> HMap2 -> [Char] -> HMap2
forall a b c. (a -> b -> c) -> b -> a -> c
flip [Char] -> HMap2 -> HMap2
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
M.delete) HMap2
m [[Char]]
cx

insertAll2::[(String, [([String], Integer, Integer, Integer)])] -> HMap2 -> HMap2
insertAll2 :: [([Char], [([[Char]], Integer, Integer, Integer)])]
-> HMap2 -> HMap2
insertAll2 [] HMap2
m = HMap2
m 
insertAll2 (([Char], [([[Char]], Integer, Integer, Integer)])
x:[([Char], [([[Char]], Integer, Integer, Integer)])]
cx) HMap2
m = [([Char], [([[Char]], Integer, Integer, Integer)])]
-> HMap2 -> HMap2
insertAll2 [([Char], [([[Char]], Integer, Integer, Integer)])]
cx ([Char] -> [([[Char]], Integer, Integer, Integer)] -> HMap2 -> HMap2
insertAppend2 (([Char], [([[Char]], Integer, Integer, Integer)]) -> [Char]
forall a b. (a, b) -> a
fst ([Char], [([[Char]], Integer, Integer, Integer)])
x) (([Char], [([[Char]], Integer, Integer, Integer)])
-> [([[Char]], Integer, Integer, Integer)]
forall a b. (a, b) -> b
snd ([Char], [([[Char]], Integer, Integer, Integer)])
x) HMap2
m)
          
insertAppend2::String -> [([String], Integer, Integer, Integer)] -> HMap2 -> HMap2
insertAppend2 :: [Char] -> [([[Char]], Integer, Integer, Integer)] -> HMap2 -> HMap2
insertAppend2 [Char]
k [([[Char]], Integer, Integer, Integer)]
ls HMap2
m = [Char] -> [([[Char]], Integer, Integer, Integer)] -> HMap2 -> HMap2
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
M.insert [Char]
k ([([[Char]], Integer, Integer, Integer)]
ls [([[Char]], Integer, Integer, Integer)]
-> [([[Char]], Integer, Integer, Integer)]
-> [([[Char]], Integer, Integer, Integer)]
forall a. [a] -> [a] -> [a]
++ [([[Char]], Integer, Integer, Integer)]
rls) HMap2
m
      where 
          rls :: [([[Char]], Integer, Integer, Integer)]
rls = [([[Char]], Integer, Integer, Integer)]
-> Maybe [([[Char]], Integer, Integer, Integer)]
-> [([[Char]], Integer, Integer, Integer)]
forall a. a -> Maybe a -> a
fromMaybe [] ([Char] -> HMap2 -> Maybe [([[Char]], Integer, Integer, Integer)]
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup [Char]
k HMap2
m)

{-|
    == Generate 'HMap2' from a list of codeblock

    >Data HMap2 = M.HashMap String [([String], Integer, Integer, Integer)]
-}
listToPrefixMap::[([String], ([String], Integer, Integer, Integer))] -> IORef HMap2 -> IO ()
listToPrefixMap :: [([[Char]], ([[Char]], Integer, Integer, Integer))]
-> IORef HMap2 -> IO ()
listToPrefixMap [([[Char]], ([[Char]], Integer, Integer, Integer))]
pplist IORef HMap2
ref = do
        -- let path = "/Users/aaa/myfile/bitbucket/snippets/snippet_test.hs"
        -- let path = "/Users/aaa/myfile/bitbucket/snippets/snippet.hs"

        -- readSnippet::FilePath->IO [([String], [String])]
        -- pplist <- readSnippet path
        -- fw "\npplist"
        -- pre pplist
        let keylist :: [([[Char]], ([[Char]], Integer, Integer, Integer))]
keylist = (([[Char]], ([[Char]], Integer, Integer, Integer))
 -> ([[Char]], ([[Char]], Integer, Integer, Integer)))
-> [([[Char]], ([[Char]], Integer, Integer, Integer))]
-> [([[Char]], ([[Char]], Integer, Integer, Integer))]
forall a b. (a -> b) -> [a] -> [b]
L.map(\([[Char]], ([[Char]], Integer, Integer, Integer))
x -> ([[[Char]]] -> [[Char]]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([[[Char]]] -> [[Char]]) -> [[[Char]]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ ([Char] -> [[Char]]) -> [[Char]] -> [[[Char]]]
forall a b. (a -> b) -> [a] -> [b]
L.map(\[Char]
y -> [Char] -> [[Char]]
prefix [Char]
y) (([[Char]], ([[Char]], Integer, Integer, Integer)) -> [[Char]]
forall a b. (a, b) -> a
fst ([[Char]], ([[Char]], Integer, Integer, Integer))
x), ([[Char]], ([[Char]], Integer, Integer, Integer))
-> ([[Char]], Integer, Integer, Integer)
forall a b. (a, b) -> b
snd ([[Char]], ([[Char]], Integer, Integer, Integer))
x) ) [([[Char]], ([[Char]], Integer, Integer, Integer))]
pplist 

        -- fw "keylist"
        -- pre keylist
        -- [(["dog", "cat"], ([String], Integer))]
        -- keylist = [(["d", "do", "dog", "c", "ca", "cat"], ([String], Integer))]
        let mymap :: [[([Char], ([[Char]], Integer, Integer, Integer))]]
mymap = (([[Char]], ([[Char]], Integer, Integer, Integer))
 -> [([Char], ([[Char]], Integer, Integer, Integer))])
-> [([[Char]], ([[Char]], Integer, Integer, Integer))]
-> [[([Char], ([[Char]], Integer, Integer, Integer))]]
forall a b. (a -> b) -> [a] -> [b]
map(\([[Char]], ([[Char]], Integer, Integer, Integer))
cx -> [([Char]
x, ([[Char]], Integer, Integer, Integer)
y) | [Char]
x <- ([[Char]], ([[Char]], Integer, Integer, Integer)) -> [[Char]]
forall a b. (a, b) -> a
fst ([[Char]], ([[Char]], Integer, Integer, Integer))
cx, ([[Char]], Integer, Integer, Integer)
y <- [([[Char]], ([[Char]], Integer, Integer, Integer))
-> ([[Char]], Integer, Integer, Integer)
forall a b. (a, b) -> b
snd ([[Char]], ([[Char]], Integer, Integer, Integer))
cx]]) [([[Char]], ([[Char]], Integer, Integer, Integer))]
keylist
        let lmap :: [([Char], ([[Char]], Integer, Integer, Integer))]
lmap = [[([Char], ([[Char]], Integer, Integer, Integer))]]
-> [([Char], ([[Char]], Integer, Integer, Integer))]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join [[([Char], ([[Char]], Integer, Integer, Integer))]]
mymap  -- use join
        -- fw "mymap"
        -- pre mymap
        -- pre $ typeOf lmap
        -- sort x of [(x, y)]
        let sortedList :: [([Char], ([[Char]], Integer, Integer, Integer))]
sortedList = (([Char], ([[Char]], Integer, Integer, Integer))
 -> ([Char], ([[Char]], Integer, Integer, Integer)) -> Bool)
-> [([Char], ([[Char]], Integer, Integer, Integer))]
-> [([Char], ([[Char]], Integer, Integer, Integer))]
forall a. (a -> a -> Bool) -> [a] -> [a]
qqsort(\([Char], ([[Char]], Integer, Integer, Integer))
x ([Char], ([[Char]], Integer, Integer, Integer))
y -> ([Char], ([[Char]], Integer, Integer, Integer))
-> ([Char], ([[Char]], Integer, Integer, Integer)) -> Bool
forall a b b. Ord a => (a, b) -> (a, b) -> Bool
f ([Char], ([[Char]], Integer, Integer, Integer))
x ([Char], ([[Char]], Integer, Integer, Integer))
y) [([Char], ([[Char]], Integer, Integer, Integer))]
lmap                                        
              where f :: (a, b) -> (a, b) -> Bool
f (a, b)
x (a, b)
y = (a, b) -> a
forall a b. (a, b) -> a
fst (a, b)
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> (a, b) -> a
forall a b. (a, b) -> a
fst (a, b)
y
        -- convert list [(x, y)] to map
        let mmap :: HashMap [Char] ([[Char]], Integer, Integer, Integer)
mmap = [([Char], ([[Char]], Integer, Integer, Integer))]
-> HashMap [Char] ([[Char]], Integer, Integer, Integer)
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
M.fromList [([Char], ([[Char]], Integer, Integer, Integer))]
lmap                                                         
        let group :: [[([Char], ([[Char]], Integer, Integer, Integer))]]
group = (([Char], ([[Char]], Integer, Integer, Integer))
 -> ([Char], ([[Char]], Integer, Integer, Integer)) -> Bool)
-> [([Char], ([[Char]], Integer, Integer, Integer))]
-> [[([Char], ([[Char]], Integer, Integer, Integer))]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy(\([Char], ([[Char]], Integer, Integer, Integer))
x ([Char], ([[Char]], Integer, Integer, Integer))
y -> ([Char], ([[Char]], Integer, Integer, Integer))
-> ([Char], ([[Char]], Integer, Integer, Integer)) -> Bool
forall a b b. Eq a => (a, b) -> (a, b) -> Bool
f ([Char], ([[Char]], Integer, Integer, Integer))
x ([Char], ([[Char]], Integer, Integer, Integer))
y) [([Char], ([[Char]], Integer, Integer, Integer))]
sortedList                                       
              where f :: (a, b) -> (a, b) -> Bool
f (a, b)
x (a, b)
y = (a, b) -> a
forall a b. (a, b) -> a
fst (a, b)
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== (a, b) -> a
forall a b. (a, b) -> a
fst (a, b)
y                                 

        -- fw "group"
        -- pre group
        --
        -- unzip::[("dog", "dogs"), ("cat", "cats")] => (["dog", "cat"], ["dogs", "cats"])
        let uzip :: [([[Char]], [([[Char]], Integer, Integer, Integer)])]
uzip = ([([Char], ([[Char]], Integer, Integer, Integer))]
 -> ([[Char]], [([[Char]], Integer, Integer, Integer)]))
-> [[([Char], ([[Char]], Integer, Integer, Integer))]]
-> [([[Char]], [([[Char]], Integer, Integer, Integer)])]
forall a b. (a -> b) -> [a] -> [b]
map(\[([Char], ([[Char]], Integer, Integer, Integer))]
x -> [([Char], ([[Char]], Integer, Integer, Integer))]
-> ([[Char]], [([[Char]], Integer, Integer, Integer)])
forall a b. [(a, b)] -> ([a], [b])
unzip [([Char], ([[Char]], Integer, Integer, Integer))]
x) [[([Char], ([[Char]], Integer, Integer, Integer))]]
group
        -- fw "uzip"
        -- pre uzip

        -- Fixed bug: unique $ snd x => remove duplicated values
        -- cause duplicated blocks: let tupleList = map(\x -> (head . fst $ x, snd x)) uzip
        -- tupleList => [("haskell", [["dog", "line1"], ["cat", "line2"]])]
        -- tupleList => [(String, [[String]])
        let tupleList :: [([Char], [([[Char]], Integer, Integer, Integer)])]
tupleList = (([[Char]], [([[Char]], Integer, Integer, Integer)])
 -> ([Char], [([[Char]], Integer, Integer, Integer)]))
-> [([[Char]], [([[Char]], Integer, Integer, Integer)])]
-> [([Char], [([[Char]], Integer, Integer, Integer)])]
forall a b. (a -> b) -> [a] -> [b]
map(\([[Char]], [([[Char]], Integer, Integer, Integer)])
x -> ([[Char]] -> [Char]
forall a. [a] -> a
head ([[Char]] -> [Char])
-> (([[Char]], [([[Char]], Integer, Integer, Integer)])
    -> [[Char]])
-> ([[Char]], [([[Char]], Integer, Integer, Integer)])
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([[Char]], [([[Char]], Integer, Integer, Integer)]) -> [[Char]]
forall a b. (a, b) -> a
fst (([[Char]], [([[Char]], Integer, Integer, Integer)]) -> [Char])
-> ([[Char]], [([[Char]], Integer, Integer, Integer)]) -> [Char]
forall a b. (a -> b) -> a -> b
$ ([[Char]], [([[Char]], Integer, Integer, Integer)])
x, [([[Char]], Integer, Integer, Integer)]
-> [([[Char]], Integer, Integer, Integer)]
forall a. Ord a => [a] -> [a]
unique ([([[Char]], Integer, Integer, Integer)]
 -> [([[Char]], Integer, Integer, Integer)])
-> [([[Char]], Integer, Integer, Integer)]
-> [([[Char]], Integer, Integer, Integer)]
forall a b. (a -> b) -> a -> b
$ ([[Char]], [([[Char]], Integer, Integer, Integer)])
-> [([[Char]], Integer, Integer, Integer)]
forall a b. (a, b) -> b
snd ([[Char]], [([[Char]], Integer, Integer, Integer)])
x)) [([[Char]], [([[Char]], Integer, Integer, Integer)])]
uzip
        -- fw "tupleList"
        -- pre tupleList
        -- NOTE: Sorting here is bad idea
        -- let tupleList' = map(\(k, s) ->(k,  qqsort(\(_,id,time,score) (_,id',time', score') -> score > score') s)) tupleList
        -- fw "tupleList'"
        -- pre tupleList'

        -- modifyIORef::IORef a -> (a -> a) -> IO()
        -- modifyIORef ref (insertAll2 tupleList)
        IORef HMap2 -> (HMap2 -> HMap2) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef HMap2
ref ([([Char], [([[Char]], Integer, Integer, Integer)])]
-> HMap2 -> HMap2
insertAll2 [([Char], [([[Char]], Integer, Integer, Integer)])]
tupleList)
        HMap2
hmap <- IORef HMap2 -> IO HMap2
forall a. IORef a -> IO a
readIORef IORef HMap2
ref
        -- fw "hmap"
        -- pre hmap
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return () 
                
                                    
-- type HMap2 = M.HashMap String [([String], Integer, Integer, Integer)]
spanBlockX1::([[String]]->[[String]])-> HMap2 -> (Maybe BS.ByteString) -> String
spanBlockX1 :: ([[[Char]]] -> [[[Char]]]) -> HMap2 -> Maybe ByteString -> [Char]
spanBlockX1 [[[Char]]] -> [[[Char]]]
f HMap2
hmap Maybe ByteString
mKey = ([[[Char]]] -> [[[Char]]])
-> [([[Char]], Integer, Integer, Integer)] -> [Char]
foldListList2 [[[Char]]] -> [[[Char]]]
f ([([[Char]], Integer, Integer, Integer)] -> [Char])
-> [([[Char]], Integer, Integer, Integer)] -> [Char]
forall a b. (a -> b) -> a -> b
$ case ([Char] -> HMap2 -> Maybe [([[Char]], Integer, Integer, Integer)]
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup (ByteString -> [Char]
forall a. Typeable a => a -> [Char]
toStr (ByteString -> [Char]) -> ByteString -> [Char]
forall a b. (a -> b) -> a -> b
$ Maybe ByteString -> ByteString
forall a. HasCallStack => Maybe a -> a
fromJust Maybe ByteString
mKey) HMap2
hmap) of 
                                     Just [([[Char]], Integer, Integer, Integer)]
s -> [([[Char]], Integer, Integer, Integer)]
s  -- [([String], Integer, Integer, Integer)]
                                     Maybe [([[Char]], Integer, Integer, Integer)]
_      -> [([[Char]
"span Block: spanBlockX1 => nothing"], Integer
0, Integer
0, Integer
0)] -- Just s -> [["my cool code", "my nice code"]]


spanBlockFunc::([[String]]->[[String]])-> [[String]]->String
spanBlockFunc :: ([[[Char]]] -> [[[Char]]]) -> [[[Char]]] -> [Char]
spanBlockFunc [[[Char]]] -> [[[Char]]]
f [[[Char]]]
codeblock = ([[[Char]]] -> [[[Char]]]) -> [[[Char]]] -> [Char]
foldListList [[[Char]]] -> [[[Char]]]
f [[[Char]]]
codeblock

                         

-- USED 
spanBlockXX2::HMap2 ->(Maybe BS.ByteString)->String
spanBlockXX2 :: HMap2 -> Maybe ByteString -> [Char]
spanBlockXX2 HMap2
hmap Maybe ByteString
mKey = [([[Char]], Integer, Integer, Integer)] -> [Char]
foldListListTxt2 ([([[Char]], Integer, Integer, Integer)] -> [Char])
-> [([[Char]], Integer, Integer, Integer)] -> [Char]
forall a b. (a -> b) -> a -> b
$ case ([Char] -> HMap2 -> Maybe [([[Char]], Integer, Integer, Integer)]
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup (ByteString -> [Char]
forall a. Typeable a => a -> [Char]
toStr (ByteString -> [Char]) -> ByteString -> [Char]
forall a b. (a -> b) -> a -> b
$ Maybe ByteString -> ByteString
forall a. HasCallStack => Maybe a -> a
fromJust Maybe ByteString
mKey) HMap2
hmap) of 
                                     Just [([[Char]], Integer, Integer, Integer)]
s -> [([[Char]], Integer, Integer, Integer)]
s
                                     Maybe [([[Char]], Integer, Integer, Integer)]
_      -> [([[Char]
"spanBlockXX2: nothing Txt"], Integer
0, Integer
0, Integer
0)]
∘ :: [a] -> [a] -> [a]
(∘) = [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
(++)



htmlPre::String -> String
htmlPre :: ShowS
htmlPre [Char]
s = [r| <pre style="font-size:29px;white-space: pre-wrap;" id="id00"> |] [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
s [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [r| </pre> |]

{-|
    == User input, autocomplete, search field
-}
replyHtml::String->String->String
replyHtml :: [Char] -> ShowS
replyHtml [Char]
s [Char]
listCmd = [r|
            <HTML>   
            <HEAD>   
            <meta charset="utf-8">
            <TITLE>Search Code Snippet</TITLE>
            <LINK rel="stylesheet" type="text/css" href="css/mystyle.css"> 
            <script src="js/aronlib.js"></script>
            <!--
            <LINK rel="stylesheet" type="text/css" href="/style.css"> 
            -->
            </HEAD>
            <BODY> 
            |] [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
s [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [r| </BODY></HTML> |]

{-| 
    snippet?id=queryStr
    S8.unpack: ByteString to String
    type Application = Request -> (Response -> IO ResponseReceived) -> IO ResponseReceived
    anyRoute => Response

    :NOTE: Use 
-}                 
anyRoute2::Connection -> IORef HMap2 -> Request-> Response
anyRoute2 :: Connection -> IORef HMap2 -> Request -> Response
anyRoute2 Connection
conn IORef HMap2
ref Request
req =
    -- get query from client
    -- look up the value of id, e.g. snippet?id=value
    -- http://localhost:8080/snippet?id=n%20test
    --                                    ↑
    --                                    + space = %20
    -- Maybe s 
    -- search s from the HMap
    -- replace the format html if any value is found
    -- Otherwise, reply "nothing"
    let query :: [(ByteString, Maybe ByteString)]
query = Request -> [(ByteString, Maybe ByteString)]
queryString Request
req :: [(BS.ByteString, Maybe BS.ByteString)]
        cmd :: Maybe [Char]
cmd = let mayText :: Maybe ByteString
mayText = Maybe (Maybe ByteString) -> Maybe ByteString
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe (Maybe ByteString) -> Maybe ByteString)
-> Maybe (Maybe ByteString) -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ ByteString
-> [(ByteString, Maybe ByteString)] -> Maybe (Maybe ByteString)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup ByteString
"id" [(ByteString, Maybe ByteString)]
query :: Maybe BS.ByteString in ByteString -> [Char]
forall a. Typeable a => a -> [Char]
toStr (ByteString -> [Char]) -> Maybe ByteString -> Maybe [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ByteString
mayText
    in  Connection -> IORef HMap2 -> Maybe [Char] -> Response
responseFromCmd Connection
conn IORef HMap2
ref Maybe [Char]
cmd 
            -- responseBuilder :: Status -> ResponseHeaders -> Builder -> Response
{-|            
    -- http://localhost:8080/snippet?id=n%20test
    --                                    ↑
    --                                    + space = %20
-}
getQueryString::BS.ByteString -> Request -> Maybe BS.ByteString 
getQueryString :: ByteString -> Request -> Maybe ByteString
getQueryString ByteString
ids Request
req = let query :: [(ByteString, Maybe ByteString)]
query = Request -> [(ByteString, Maybe ByteString)]
queryString Request
req :: [(BS.ByteString, Maybe BS.ByteString)]
                         in Maybe (Maybe ByteString) -> Maybe ByteString
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe (Maybe ByteString) -> Maybe ByteString)
-> Maybe (Maybe ByteString) -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ ByteString
-> [(ByteString, Maybe ByteString)] -> Maybe (Maybe ByteString)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup ByteString
ids [(ByteString, Maybe ByteString)]
query :: Maybe BS.ByteString

responseFromCmd::Connection -> IORef HMap2 -> Maybe String -> Response
responseFromCmd :: Connection -> IORef HMap2 -> Maybe [Char] -> Response
responseFromCmd Connection
conn IORef HMap2
ref Maybe [Char]
cmd = 
       case Maybe [Char]
cmd of  
            -- responseBuilder :: Status -> ResponseHeaders -> Builder -> Response
            Just [Char]
s -> do 
                      -- record command and write to file
                      -- store s in Redis here
                      case [Char]
s of
                           [Char]
var | [Char] -> Integer
forall (t :: * -> *) b a. (Foldable t, Num b) => t a -> b
len [Char]
var Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
3 -> case Int -> ShowS
forall a. Int -> [a] -> [a]
take Int
2 [Char]
s of
                                 [Char]
var | [Char]
var [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"c " -> Connection -> [Char] -> Response
responseCmd Connection
conn [Char]
s     -- Shell commands
                                     | [Char]
var [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"j " -> [Char] -> Response
responseJavaHtml [Char]
s     -- Java AronLib.java with Html, CSS.
                                     | [Char]
var [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"h " -> [Char] -> Response
responseHaskellHtml [Char]
s  -- Haskell AronModule.hs with HTML, CSS.
                                     | [Char]
var [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"k " -> [Char] -> Response
queryLibHaskell [Char]
s      -- Haskell AronModule.hs No HTML
                                     | [Char]
var [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"x " -> [Char] -> Response
queryLibCpp [Char]
s          -- Cpp     AronLib.hs No HTML
                                     | [Char]
var [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"i " -> [Char] -> [Char] -> Response
queryLibJavaPackage [Char]
"Aron." [Char]
s       -- Java $b/javalib/AronLib.java
                                     | [Char]
var [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"e " -> [Char] -> Response
queryRedisSnippet [Char]
s
                                     | [Char]
var [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"p " -> [Char] -> [Char] -> Response
queryLibJavaPackage [Char]
"Print." [Char]
s -- Java $b/javalib/Print.java
                                     | [Char]
var [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"n " -> [Char] -> IORef HMap2 -> Response
responseSnippetTxt2 [Char]
s IORef HMap2
ref  -- Snippet with No HTML, CSS.
                                     | [Char]
var [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"o " -> [Char] -> IORef HMap2 -> Response
responseSnippetJSON [Char]
s IORef HMap2
ref  -- Snippet with Json format
                                     | [Char]
var [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"s " -> Connection -> [Char] -> IORef HMap2 -> Response
responseSnippetHTML2 Connection
conn [Char]
s IORef HMap2
ref -- Snippet with Html,No Search field
                                     | Bool
otherwise   -> [Char] -> Response
responseNothing [Char]
""  -- responseSearch conn "search 1"
                               | Bool
otherwise   -> [Char] -> Response
responseNothing [Char]
"nothing55" -- responseSearch conn "search 2" 
            Maybe [Char]
_      -> Connection -> [Char] -> Response
responseSearch Connection
conn [Char]
"response nothingkkk"

-- | http://localhost:8000/up/
-- | NOTE: file => /upload dir
-- | Plz see uploadPage.html 
-- | /Users/aaa/myfile/bitbucket/haskellwebapp2/uploadPage.html
-- | responseFile :: H.Status -> H.ResponseHeaders -> FilePath -> Maybe FilePart -> Response
uploadPage::Response
uploadPage :: Response
uploadPage = Status -> ResponseHeaders -> [Char] -> Maybe FilePart -> Response
responseFile
    Status
status200
    [(HeaderName
"Content-Type", ByteString
"text/html")]
    [Char]
"uploadPage.html"
    Maybe FilePart
forall a. Maybe a
Nothing

data SearchType = CmdT | JavaT | HaskellT | SnippetT

readCmd::FilePath -> SearchType -> IO String
readCmd :: [Char] -> SearchType -> IO [Char]
readCmd [Char]
fn SearchType
t = do
               -- cmdList  <- readFileToList fn
               [[Char]]
cmdList  <- [Char] -> IO [[Char]]
readFileLatin1ToList [Char]
fn
               -- filter out "va" from list and apply f to each element
               let sortedList :: [[Char]]
sortedList = [[Char]] -> [[Char]]
groupCountFilter [[Char]]
cmdList 
               let tupList :: [[Char]]
tupList = ([Char], Integer) -> [Char]
forall a. Show a => a -> [Char]
show (([Char], Integer) -> [Char]) -> [([Char], Integer)] -> [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Char]] -> [([Char], Integer)]
groupCount [[Char]]
sortedList
               -- writeToFile "/tmp/aa.x" tupList
               -- let sortedList = ["33", "11", "22", "bb", "aa"]
               let htmlStr :: [Char]
htmlStr = [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ ShowS -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map(\[Char]
x -> let left :: [Char]
left = [Char]
"<option value=\""; 
                                                    right :: [Char]
right = [Char]
"\">" 
                                                in case SearchType
t of 
                                                        SearchType
CmdT     -> [Char]
left [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
x [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
right
                                                        SearchType
JavaT    -> [Char]
left [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
x [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
right
                                                        SearchType
HaskellT -> [Char]
left [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
x [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
right
                                                        SearchType
SnippetT -> [Char]
left [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
x [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
right
                                         ) ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ [[Char]]
sortedList 
               [Char] -> IO [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
htmlStr 


{-| 
    === Filter some commands out from a list.
-} 
groupCountFilter::[String] -> [String]
groupCountFilter :: [[Char]] -> [[Char]]
groupCountFilter [[Char]]
cs = ([Char], Integer) -> [Char]
forall a b. (a, b) -> a
fst (([Char], Integer) -> [Char]) -> [([Char], Integer)] -> [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Char]] -> [([Char], Integer)]
groupCount (let f::String -> Maybe String
                                              f :: [Char] -> Maybe [Char]
f [Char]
"va" = Maybe [Char]
forall a. Maybe a
Nothing
                                              f [Char]
s    = [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
s
                                          in ([Char] -> Maybe [Char]) -> [[Char]] -> [[Char]]
forall a b. (a -> Maybe b) -> [a] -> [b]
filtermap ( [Char] -> Maybe [Char]
f ([Char] -> Maybe [Char]) -> ShowS -> [Char] -> Maybe [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
trim) [[Char]]
cs)
optionHtml::[String] -> String
optionHtml :: [[Char]] -> [Char]
optionHtml [[Char]]
cs = [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ ShowS -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map(\[Char]
x -> [r| <option value="|] [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
x [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [r|">|]) [[Char]]
cs 

responseNothing::String -> Response                                                    
responseNothing :: [Char] -> Response
responseNothing [Char]
s = Status -> ResponseHeaders -> StreamingBody -> Response
responseStream                                                   
              Status
status200                                                            
              [(HeaderName
hContentType, ByteString
"text/html")] (StreamingBody -> Response) -> StreamingBody -> Response
forall a b. (a -> b) -> a -> b
$ \Builder -> IO ()
write IO ()
flush -> do                   
              Builder -> IO ()
write (Builder -> IO ()) -> Builder -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Builder
byteString (ByteString -> Builder) -> ByteString -> Builder
forall a b. (a -> b) -> a -> b
$ [Char] -> ByteString
forall a. Typeable a => a -> ByteString
toSBS ([Char]
"responseNothing : " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
s)

responseNothingBS::BS.ByteString -> Response                                               
responseNothingBS :: ByteString -> Response
responseNothingBS ByteString
bs = Status -> ResponseHeaders -> StreamingBody -> Response
responseStream                                                   
              Status
status200                                                            
              [(HeaderName
hContentType,  ByteString
"application/json")] (StreamingBody -> Response) -> StreamingBody -> Response
forall a b. (a -> b) -> a -> b
$ \Builder -> IO ()
write IO ()
flush -> do                   
              Builder -> IO ()
write (Builder -> IO ()) -> Builder -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Builder
byteString ByteString
bs

{-|
    === Response JSON record to client side
-}
responseJSON::(DA.ToJSON a) => a -> Response
responseJSON :: a -> Response
responseJSON a
rd = ByteString -> Response
responseJSONBS (ByteString -> Response) -> ByteString -> Response
forall a b. (a -> b) -> a -> b
$ (ByteString -> ByteString
forall a. Typeable a => a -> ByteString
toSBS (ByteString -> ByteString) -> (a -> ByteString) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ByteString
forall a. ToJSON a => a -> ByteString
DA.encode) a
rd
              
responseJSONBS::BS.ByteString -> Response
responseJSONBS :: ByteString -> Response
responseJSONBS ByteString
bs = Status -> ResponseHeaders -> StreamingBody -> Response
responseStream
              Status
status200
              [(HeaderName
hContentType,  ByteString
"application/json")] (StreamingBody -> Response) -> StreamingBody -> Response
forall a b. (a -> b) -> a -> b
$ \Builder -> IO ()
write IO ()
flush -> do                   
              Builder -> IO ()
write (Builder -> IO ()) -> Builder -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Builder
byteString ByteString
bs  


responseNothingTest::Response                                               
responseNothingTest :: Response
responseNothingTest = Status -> ResponseHeaders -> StreamingBody -> Response
responseStream                                                   
              Status
status200                                                            
              [(HeaderName
hContentType,  ByteString
"application/pdf"),
               (HeaderName
"Content-Disposition", ByteString
"inline;filename=kkk.pdf")] (StreamingBody -> Response) -> StreamingBody -> Response
forall a b. (a -> b) -> a -> b
$ \Builder -> IO ()
write IO ()
flush -> do                   
              Builder -> IO ()
write (Builder -> IO ()) -> Builder -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Builder
byteString (ByteString -> Builder) -> ByteString -> Builder
forall a b. (a -> b) -> a -> b
$ [Char] -> ByteString
forall a. Typeable a => a -> ByteString
toSBS ([Char]
"dog"::String)

replyTaskHtml::BS.ByteString -> BS.ByteString -> BS.ByteString 
replyTaskHtml :: ByteString -> ByteString -> ByteString
replyTaskHtml ByteString
url ByteString
s = [r|
            <HTML>   
            <HEAD>   
            <meta charset="utf-8">
            <TITLE>Search Code Snippet</TITLE> 
            <LINK rel="stylesheet" type="text/css" href="/style.css"> 
            </HEAD>
            <BODY> 
            <div style="text-align:center;">
            <br>
            <p> |] ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
s ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> [r|</p><br><a href= |] ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
url ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> [r|>Back</a></div></BODY></HTML> |]


            -- <p> |] <> s <> [r|</p><br><a href="http://localhost:8000">Back</a></div></BODY></HTML> |]

--listPage::BS.ByteString -> Response                                               
--listPage bs = responseStream                                                   
--              status200                                                            
--              [(hContentType,  "text/html")] $ \write flush -> do                   
--              write $ byteString bs  

listPage::Connection -> Application
listPage :: Connection -> Application
listPage Connection
conn Request
req Response -> IO ResponseReceived
response = do
              [User]
userList <- Connection -> Query -> IO [User]
forall r. FromRow r => Connection -> Query -> IO [r]
query_ Connection
conn Query
"SELECT uid, name, email, password, task, money FROM user" :: IO [User]
              let listTask :: ByteString
listTask = [ByteString] -> ByteString
BS.concat ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ (User -> ByteString) -> [User] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map (\User
x -> [r|<div>|] ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> (Text -> ByteString
t2b (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ User -> Text
task User
x) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> [r|</div><br>|]) [User]
userList -- => TS.Text
              -- response $ responseTaskBS (task (head userList))
              ByteString
hostURL <- IO [Char]
getHostName IO [Char] -> ([Char] -> IO ByteString) -> IO ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString)
-> ([Char] -> ByteString) -> [Char] -> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ByteString
forall a. Typeable a => a -> ByteString
toSBS
              Response -> IO ResponseReceived
response (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ ByteString -> Response
responseTaskBS (ByteString -> Response) -> ByteString -> Response
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> ByteString
replyTaskHtml ByteString
hostURL ByteString
listTask 
        where
            t2b :: Text -> ByteString
t2b = Text -> ByteString
strictTextToStrictByteString

responseTaskBS::BS.ByteString -> Response                                               
responseTaskBS :: ByteString -> Response
responseTaskBS ByteString
bs = Status -> ResponseHeaders -> StreamingBody -> Response
responseStream                                                   
               Status
status200                                                            
               [(HeaderName
hContentType,  ByteString
"text/html")] (StreamingBody -> Response) -> StreamingBody -> Response
forall a b. (a -> b) -> a -> b
$ \Builder -> IO ()
write IO ()
flush -> do                   
               Builder -> IO ()
write (Builder -> IO ()) -> Builder -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Builder
byteString ByteString
bs  



--writeSB::String -> Builder
--writeSB = write $ byteString $ strToStrictByteString 

  -- write $ byteString $ toSBS $ replyHtml (escapeHtml retStr) listCmd 

{-|
   === Response output from shell command
   1. The maximum number of lines are 200, " | head -200"

   2. Exit code can not be checked, ExitSuccess
   
   Wed May  8 23:10:41 2019 
   3 Error can be checked in stderr  
   >(e, so, si) <- A.runSh $ toSText (drop 2 ncmd) 
   > if si is NOT empty then there is stderr

   >type streamBody = (Builder -> IO()) -> IO() -> IO()
 -} 
responseCmd::Connection -> String -> Response
responseCmd :: Connection -> [Char] -> Response
responseCmd Connection
conn [Char]
cmd = Status -> ResponseHeaders -> StreamingBody -> Response
responseStream 
              Status
status200
              [(HeaderName
hContentType, ByteString
"text/html")] (StreamingBody -> Response) -> StreamingBody -> Response
forall a b. (a -> b) -> a -> b
$ \Builder -> IO ()
write IO ()
flush -> do
              -- code <- A.run (cmd ++ "\n")
              -- There is problem with top 500 lines
              -- It seems to be working with 200 lines 
              let ccmd :: [Char]
ccmd = ShowS
trim [Char]
cmd
              let ncmd :: [Char]
ncmd = [Char]
ccmd [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
topN
                  
              -- Log the current user input. 
              -- logCurrCmd [ccmd]
              -- runSh :: TS.Text -> IO (ExitCode, TS.Text, TS.Text)    
              (ExitCode
e, Text
so, Text
si) <- Text -> IO (ExitCode, Text, Text)
runSh (Text -> IO (ExitCode, Text, Text))
-> Text -> IO (ExitCode, Text, Text)
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
forall a. Typeable a => a -> Text
toSText (Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
2 [Char]
ncmd) 
              -- ExitCode can not capture exit code of cmd1 in "cmd1 | cmd2"
              -- Wed May  8 23:27:04 2019 
              -- Fixed Error: 
              -- If there is error, si will NOT be empty String
              -- Otherwise, there is NO error.
              let ok :: Bool
ok = Text -> Bool
forall a. Typeable a => a -> Bool
isOk Text
si 
              let shellRet :: [Char]
shellRet = if Bool
ok then (Text -> [Char]
forall a. Typeable a => a -> [Char]
toStr Text
so) else ([Char]
"Invalid Shell Command:" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
ncmd)
              -- if ok then writeToFileAppend cmdLog [ccmd] else return () 
              if Bool
ok then do
                  -- NOT USED
                  [[Char]]
sortList <- Connection -> [Char] -> IO [[Char]]
queryUserInput Connection
conn [Char]
ccmd
                  -- execute_ conn "CREATE TABLE IF NOT EXISTS userinput (id INTEGER PRIMARY KEY AUTOINCREMENT, xcmd TEXT)"
                  -- execute conn "INSERT INTO userinput (xcmd) VALUES (?)" (UserInput 0 (toSText ccmd))
                  -- cmdsql <- query_ conn "SELECT id, xcmd FROM userinput"::IO [UserInput]
                  -- let cmdList = map toStr (map (xcmd) cmdsql::[TS.Text]) -- [UserInput] => [Text] => [String]
                  -- pa cmdList 
                  -- let sortList = groupCountFilter cmdList
                  -- FIXME: replace htmlBody with htmlBody.htmlbs
                  -- FIXME: replace searchForm with searchForm.htmlbs
                  -- logFile2 "/tmp/bb1.txt" [htmlBodyH $ (searchForm (optionHtml sortList)) ∘ (htmlPre shellRet)]
                  -- write $ byteString $ toSBS $ htmlBodyH $ (searchForm (optionHtml sortList)) ∘ (htmlPre shellRet)
                  Builder -> IO ()
write (Builder -> IO ()) -> Builder -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Builder
byteString (ByteString -> Builder) -> ByteString -> Builder
forall a b. (a -> b) -> a -> b
$ [Char] -> ByteString
forall a. Typeable a => a -> ByteString
toSBS ([Char] -> ByteString) -> [Char] -> ByteString
forall a b. (a -> b) -> a -> b
$ ShowS
htmlPre [Char]
shellRet
              else IO ()
flush
        where
            topN :: [Char]
topN = [Char]
" | head -200"
            isOk :: a -> Bool
isOk a
si = (a -> [Char]
forall a. Typeable a => a -> [Char]
toStr a
si) [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
""

queryUserInput::Connection -> String -> IO [String]
queryUserInput :: Connection -> [Char] -> IO [[Char]]
queryUserInput Connection
conn [Char]
cmd = do
  Connection -> Query -> IO ()
execute_ Connection
conn Query :: Text -> Query
Query{fromQuery :: Text
fromQuery = [Char] -> Text
s2Text [Char]
"CREATE TABLE IF NOT EXISTS userinput (id INTEGER PRIMARY KEY AUTOINCREMENT, xcmd TEXT)"}
  Connection -> Query -> UserInput -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
execute  Connection
conn Query :: Text -> Query
Query{fromQuery :: Text
fromQuery = [Char] -> Text
s2Text [Char]
"INSERT INTO userinput (xcmd) VALUES (?)"} (Int64 -> Text -> UserInput
UserInput Int64
0 ([Char] -> Text
forall a. Typeable a => a -> Text
toSText [Char]
cmd))
  [UserInput]
cmdsql <- Connection -> Query -> IO [UserInput]
forall r. FromRow r => Connection -> Query -> IO [r]
query_ Connection
conn Query
"SELECT id, xcmd FROM userinput"::IO [UserInput]
  let cmdList :: [[Char]]
cmdList = (Text -> [Char]) -> [Text] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map Text -> [Char]
forall a. Typeable a => a -> [Char]
toStr ((UserInput -> Text) -> [UserInput] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (UserInput -> Text
xcmd) [UserInput]
cmdsql::[TS.Text]) -- [UserInput] => [Text] => [String]
  -- pa cmdList 
  [[Char]] -> IO [[Char]]
forall (m :: * -> *) a. Monad m => a -> m a
return ([[Char]] -> IO [[Char]]) -> [[Char]] -> IO [[Char]]
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [[Char]]
groupCountFilter [[Char]]
cmdList
  
responseJavaHtml::String -> Response
responseJavaHtml :: [Char] -> Response
responseJavaHtml [Char]
cmd = Status -> ResponseHeaders -> StreamingBody -> Response
responseStream 
              Status
status200
              [(HeaderName
"Content-Type", ByteString
"text/html")] (StreamingBody -> Response) -> StreamingBody -> Response
forall a b. (a -> b) -> a -> b
$ \Builder -> IO ()
write IO ()
flush -> do
              let tcmd :: [Char]
tcmd = ShowS
trim [Char]
cmd                  -- " j  list " => "j  list"
              let hKey :: [Char]
hKey  = ShowS
trim ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
2 [Char]
tcmd       -- "j  list"   => "list"
              let jCmd :: [Char]
jCmd = ShowS
redisKey [Char]
hKey             -- "list"      => "Aron.list"
              [[Char]]
ls <- [Char] -> IO [[Char]]
A.run ([Char] -> IO [[Char]]) -> [Char] -> IO [[Char]]
forall a b. (a -> b) -> a -> b
$ [Char]
query_redis [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
jCmd   
              let lsEscapeHtml :: [[Char]]
lsEscapeHtml = ShowS -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map(\[Char]
x -> ShowS
escapeHtml [Char]
x) [[Char]]
ls
              let ls2 :: [[[Char]]]
ls2 = ([Char] -> [[Char]]) -> [[Char]] -> [[[Char]]]
forall a b. (a -> b) -> [a] -> [b]
map(\[Char]
s -> [[Char]
s]) [[Char]]
lsEscapeHtml 
              -- let repStr = foldr(\x y -> x ++ "<br>" ++ y) [] code
              let repStr :: [Char]
repStr = [[[Char]]] -> [Char]
H1.table [[[Char]]]
ls2
              -- FIXME: take cmd from database
              -- writeToFileAppend cmdLog [tcmd] 
              -- listCmd <- readCmd cmdLog JavaT
              Builder -> IO ()
write (Builder -> IO ()) -> Builder -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Builder
byteString (ByteString -> Builder) -> ByteString -> Builder
forall a b. (a -> b) -> a -> b
$ [Char] -> ByteString
forall a. Typeable a => a -> ByteString
toSBS ([Char] -> ByteString) -> [Char] -> ByteString
forall a b. (a -> b) -> a -> b
$ ([[[Char]]] -> [[[Char]]]) -> [[[Char]]] -> [Char]
spanBlockFunc ([CSSPro] -> [[[Char]]] -> [[[Char]]]
alternateLineColor2 [([Char]
"color", [Char]
"#AAAAAA"), ([Char]
"color", [Char]
"white")] ([[[Char]]] -> [[[Char]]])
-> ([[[Char]]] -> [[[Char]]]) -> [[[Char]]] -> [[[Char]]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[[Char]]] -> [[[Char]]]
transformX) [[[Char]]
ls] 
              IO ()
flush
              where
                redisKey :: ShowS
redisKey [Char]
s = [Char]
"Aron." [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
s

{-|
  === Html table contains png/pdf file gallery
-}
responseGenePDFHtml::Connection -> Response                                                 
responseGenePDFHtml :: Connection -> Response
responseGenePDFHtml Connection
conn = Status -> ResponseHeaders -> StreamingBody -> Response
responseStream                                                
              Status
status200                                                              
              [(HeaderName
"Content-Type", ByteString
"text/html")] (StreamingBody -> Response) -> StreamingBody -> Response
forall a b. (a -> b) -> a -> b
$ \Builder -> IO ()
write IO ()
flush -> do
              -- bs <- getPDFPath "pdf/" >>= \path -> PDF.pdfMain conn path

              [Char]
pa <- [Char] -> IO [Char]
getEnv [Char]
"PWD" IO [Char] -> ([Char] -> IO [Char]) -> IO [Char]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[Char]
x -> [Char] -> IO [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> IO [Char]) -> [Char] -> IO [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
x [Char] -> ShowS
</> [Char]
"pdf/"  -- TEST ONLY
              ByteString
bs <- [Char] -> IO [Char]
PDF.getPDFPath [Char]
pa IO [Char] -> ([Char] -> IO ByteString) -> IO ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[Char]
path -> Connection -> [Char] -> IO ByteString
PDF.pdfMain Connection
conn [Char]
path  -- TEST ONLY
              Builder -> IO ()
write (Builder -> IO ()) -> Builder -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Builder
byteString ByteString
bs  
              IO ()
flush                                                                  

  
responseHaskellHtml::String -> Response
responseHaskellHtml :: [Char] -> Response
responseHaskellHtml [Char]
cmd = Status -> ResponseHeaders -> StreamingBody -> Response
responseStream 
              Status
status200
              [(HeaderName
"Content-Type", ByteString
"text/html")] (StreamingBody -> Response) -> StreamingBody -> Response
forall a b. (a -> b) -> a -> b
$ \Builder -> IO ()
write IO ()
flush -> do
              -- append "AronModule." Reddis for Haskell lib
              let tcmd :: [Char]
tcmd = ShowS
trim [Char]
cmd
              let hKey :: [Char]
hKey = ShowS
redisKey ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ ShowS
trim ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
2 [Char]
tcmd  -- "h list" => AronModule.list
              [[Char]]
code <- [Char] -> IO [[Char]]
A.run ([Char] -> IO [[Char]]) -> [Char] -> IO [[Char]]
forall a b. (a -> b) -> a -> b
$ [Char]
query_redis [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
hKey   
              let codeEsc :: [[Char]]
codeEsc = ShowS -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map(\[Char]
x -> ShowS
escapeHtml [Char]
x) [[Char]]
code -- ["code"]
              let repStr :: [Char]
repStr = ([Char] -> ShowS) -> [Char] -> [[Char]] -> [Char]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr(\[Char]
x [Char]
y -> [Char]
x [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"<br>" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
y) [] [[Char]]
codeEsc -- ["code']
              [Char] -> IO ()
forall (m :: * -> *) a. (MonadIO m, Show a) => a -> m ()
pre [Char]
repStr
              -- writeToFileAppend cmdLog [tcmd] 
              -- listCmd <- readCmd cmdLog HaskellT 
              -- write $ byteString $ toSBS $ replyHtml repStr ""
              Builder -> IO ()
write (Builder -> IO ()) -> Builder -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Builder
byteString (ByteString -> Builder) -> ByteString -> Builder
forall a b. (a -> b) -> a -> b
$ [Char] -> ByteString
forall a. Typeable a => a -> ByteString
toSBS ([Char] -> ByteString) -> [Char] -> ByteString
forall a b. (a -> b) -> a -> b
$ ([[[Char]]] -> [[[Char]]]) -> [[[Char]]] -> [Char]
spanBlockFunc ([CSSPro] -> [[[Char]]] -> [[[Char]]]
alternateLineColor2 [([Char]
"color", [Char]
"#AAAAAA"), ([Char]
"color", [Char]
"white")] ([[[Char]]] -> [[[Char]]])
-> ([[[Char]]] -> [[[Char]]]) -> [[[Char]]] -> [[[Char]]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[[Char]]] -> [[[Char]]]
transformX) [[[Char]]
code]
              IO ()
flush
              where
                redisKey :: ShowS
redisKey [Char]
s = [Char]
"AronModule." [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
s
              
queryRedisSnippet::String -> Response
queryRedisSnippet :: [Char] -> Response
queryRedisSnippet [Char]
cmd = Status -> ResponseHeaders -> StreamingBody -> Response
responseStream
                        Status
status200
                        [(HeaderName
"Content-Type", ByteString
"text/html")] (StreamingBody -> Response) -> StreamingBody -> Response
forall a b. (a -> b) -> a -> b
$ \Builder -> IO ()
write IO ()
flush -> do
                        let tcmd :: [Char]
tcmd = ShowS
trim [Char]
cmd
                        -- AronModule. ++ "h writeToFile" => AronModule.writeToFile
                        let qstr :: [Char]
qstr = Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
2 [Char]
tcmd -- "h list" => "list"
                        let hKey :: [Char]
hKey = [Char]
preKey [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ (ShowS
trim ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ [Char]
qstr)   
                        [Char] -> IO ()
forall (m :: * -> *) a. (MonadIO m, Show a) => a -> m ()
pre [Char]
hKey
                        [[Char]]
code <- [Char] -> IO [[Char]]
A.run ([Char] -> IO [[Char]]) -> [Char] -> IO [[Char]]
forall a b. (a -> b) -> a -> b
$ [Char]
query_redis [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
hKey   
                        [[Char]] -> IO ()
forall (m :: * -> *) a. (MonadIO m, Show a) => a -> m ()
pre [[Char]]
code  
                        if [[Char]] -> Integer
forall (t :: * -> *) b a. (Foldable t, Num b) => t a -> b
len [[Char]]
code Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0 
                          -- then let repStr = init $ foldr(\x y -> x ++ "\n" ++ y) [] tcode in write $ byteString $ toSBS repStr 
                        then let repStr :: [Char]
repStr = [[Char]] -> [Char]
unlines [[Char]]
code in Builder -> IO ()
write (Builder -> IO ()) -> Builder -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Builder
byteString (ByteString -> Builder) -> ByteString -> Builder
forall a b. (a -> b) -> a -> b
$ [Char] -> ByteString
forall a. Typeable a => a -> ByteString
toSBS [Char]
repStr 
                        else Builder -> IO ()
write (Builder -> IO ()) -> Builder -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Builder
byteString ByteString
emptySBS 
                        IO ()
flush
                        where
                            preKey :: [Char]
preKey = [Char]
"snippet."


{-| 
    === Run ghci_stack.sh as a process, return some info
-} 
ghcidRun::Ghci -> String -> Response
ghcidRun :: Ghci -> [Char] -> Response
ghcidRun Ghci
ghci [Char]
cmd = Status -> ResponseHeaders -> StreamingBody -> Response
responseStream 
        Status
status200
        [(HeaderName
"Content-Type", ByteString
"text/html")] (StreamingBody -> Response) -> StreamingBody -> Response
forall a b. (a -> b) -> a -> b
$ \Builder -> IO ()
write IO ()
flush -> do
        let tcmd :: [Char]
tcmd = Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
2 ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ ShowS
trim [Char]
cmd
        [Char] -> IO ()
putStrLn [Char]
tcmd
        [Char] -> IO ()
putStrLn [Char]
cmd
        -- exec :: Ghci -> String -> IO [String]
        let executeStatement :: [Char] -> IO [[Char]]
executeStatement = Ghci -> [Char] -> IO [[Char]]
exec Ghci
ghci 
        ByteString
sbs <- [Char] -> ([Char] -> IO [[Char]]) -> IO ByteString
forall (m :: * -> *) t.
MonadIO m =>
t -> (t -> m [[Char]]) -> m ByteString
getGhciInfo [Char]
tcmd [Char] -> IO [[Char]]
executeStatement
        Builder -> IO ()
write (Builder -> IO ()) -> Builder -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Builder
byteString ByteString
sbs 
        IO ()
flush
 where
  f::Stream -> String -> IO()
  f :: Stream -> [Char] -> IO ()
f Stream
a [Char]
b = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

  getGhciInfo :: t -> (t -> m [[Char]]) -> m ByteString
getGhciInfo t
cmd t -> m [[Char]]
f = do
       -- f str >>= print . head
       [[Char]]
ls <- t -> m [[Char]]
f t
cmd
       [[Char]] -> m ()
forall (m :: * -> *) a. (MonadIO m, Show a) => a -> m ()
pre [[Char]]
ls
--        let str = if (len ls > 0) then (let list = map (\x -> lastNon $ filterNonEmpty $ splitRegex (mkRegex "\\.") x) ls
--                                       in unlines list
--                                      ) else ""
       ByteString -> m ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> m ByteString) -> ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ [Char] -> ByteString
forall a. Typeable a => a -> ByteString
toSBS ([Char] -> ByteString) -> [Char] -> ByteString
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
unlines [[Char]]
ls 

  lastNon::[String] -> String
  lastNon :: [[Char]] -> [Char]
lastNon [[Char]]
cx = if [[Char]] -> Integer
forall (t :: * -> *) b a. (Foldable t, Num b) => t a -> b
len [[Char]]
cx Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0 then [[Char]] -> [Char]
forall a. [a] -> a
last [[Char]]
cx else [Char]
""

{-| 
    === query function info from redis without Html

    >query_redis = "$HOME/myfile/symbin/RedisQuery "

    >preKey = "AronModule."  AronModule.hs
    >preKey = "Aron."        Aron.java
-}
queryLibHaskell::String -> Response
queryLibHaskell :: [Char] -> Response
queryLibHaskell [Char]
cmd = Status -> ResponseHeaders -> StreamingBody -> Response
responseStream 
              Status
status200
              [(HeaderName
"Content-Type", ByteString
"text/html")] (StreamingBody -> Response) -> StreamingBody -> Response
forall a b. (a -> b) -> a -> b
$ \Builder -> IO ()
write IO ()
flush -> do
              let tcmd :: [Char]
tcmd = ShowS
trim [Char]
cmd
              [Char] -> IO ()
putStrLn [Char]
cmd

              -- AronModule. ++ "h writeToFile" => AronModule.writeToFile
              let qstr :: [Char]
qstr = Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
2 [Char]
tcmd -- "h list" => "list"
              let hKey :: [Char]
hKey = [Char]
preKey [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ (ShowS
trim ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ [Char]
qstr)   
              [Char] -> IO ()
forall (m :: * -> *) a. (MonadIO m, Show a) => a -> m ()
pre [Char]
hKey
              [[Char]]
code <- [Char] -> IO [[Char]]
A.run ([Char] -> IO [[Char]]) -> [Char] -> IO [[Char]]
forall a b. (a -> b) -> a -> b
$ [Char]
query_redis [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
hKey   
              [Char] -> IO ()
fw [Char]
"beg"
              [[Char]] -> IO ()
forall (m :: * -> *) a. (MonadIO m, Show a) => a -> m ()
pre [[Char]]
code
              [Char] -> IO ()
fw [Char]
"end"
              [Char] -> IO ()
forall a. Show a => a -> IO ()
pp ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"tcmd=" [Char] -> ShowS
forall a. Show a => [Char] -> a -> [Char]
<<< [Char]
tcmd

              let tcode :: [[Char]]
tcode = [Char] -> [[Char]] -> [[Char]]
sortedByMatchedStrIndex [Char]
qstr [[Char]]
code
              [Char] -> IO ()
fw [Char]
"tcode beg"                           
              [[Char]] -> IO ()
forall (m :: * -> *) a. (MonadIO m, Show a) => a -> m ()
pre [[Char]]
tcode
              [Char] -> IO ()
fw [Char]
"tcode end"
              if [[Char]] -> Integer
forall (t :: * -> *) b a. (Foldable t, Num b) => t a -> b
len [[Char]]
tcode Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0 
              -- then let repStr = init $ foldr(\x y -> x ++ "\n" ++ y) [] tcode in write $ byteString $ toSBS repStr 
              then let repStr :: [Char]
repStr = [[Char]] -> [Char]
unlines [[Char]]
tcode in Builder -> IO ()
write (Builder -> IO ()) -> Builder -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Builder
byteString (ByteString -> Builder) -> ByteString -> Builder
forall a b. (a -> b) -> a -> b
$ [Char] -> ByteString
forall a. Typeable a => a -> ByteString
toSBS [Char]
repStr 
              else Builder -> IO ()
write (Builder -> IO ()) -> Builder -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Builder
byteString ByteString
emptySBS 
              IO ()
flush
              where
                preKey :: [Char]
preKey = [Char]
"AronModule."

                -- sorted string according to index of search term.
                -- gx file:///Users/aaa/myfile/bitbucket/stackproject/jupyterlab/sorted_haskell_function.html
                sortedByMatchedStrIndex :: [Char] -> [[Char]] -> [[Char]]
sortedByMatchedStrIndex [Char]
qstr [[Char]]
code = ([Char] -> [Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> a -> Bool) -> [a] -> [a]
qqsort(\[Char]
a [Char]
b -> let la :: Int
la = [Char] -> [Char] -> Int
matchIndex [Char]
qstr ([Char] -> Int) -> [Char] -> Int
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
forall a. [a] -> a
head ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> [[Char]]
splitStr [Char]
"::" [Char]
a 
                                                                       lb :: Int
lb = [Char] -> [Char] -> Int
matchIndex [Char]
qstr ([Char] -> Int) -> [Char] -> Int
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
forall a. [a] -> a
head ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> [[Char]]
splitStr [Char]
"::" [Char]
b 
                                                                   in  Int
la Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
lb ) ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ ShowS -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ShowS
trim [[Char]]
code

                matchIndex :: [Char] -> [Char] -> Int
matchIndex [Char]
q [Char]
s = case [Char] -> [Char] -> Maybe (Int, Int)
matchAny [Char]
q [Char]
s of
                                   Just (Int, Int)
x -> (Int, Int) -> Int
forall a b. (a, b) -> a
fst (Int, Int)
x
                                   Maybe (Int, Int)
_      -> Int
10 

queryLibCpp::String -> Response
queryLibCpp :: [Char] -> Response
queryLibCpp [Char]
cmd = Status -> ResponseHeaders -> StreamingBody -> Response
responseStream 
              Status
status200
              [(HeaderName
"Content-Type", ByteString
"text/html")] (StreamingBody -> Response) -> StreamingBody -> Response
forall a b. (a -> b) -> a -> b
$ \Builder -> IO ()
write IO ()
flush -> do
              let tcmd :: [Char]
tcmd = ShowS
trim [Char]
cmd
              [Char] -> IO ()
putStrLn [Char]
cmd

              -- AronModule. ++ "h writeToFile" => AronModule.writeToFile
              let qstr :: [Char]
qstr = Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
2 [Char]
tcmd -- "h list" => "list"
              let hKey :: [Char]
hKey = [Char]
preKey [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ (ShowS
trim ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ [Char]
qstr)   
              [Char] -> IO ()
forall (m :: * -> *) a. (MonadIO m, Show a) => a -> m ()
pre [Char]
hKey
              [[Char]]
code <- [Char] -> IO [[Char]]
A.run ([Char] -> IO [[Char]]) -> [Char] -> IO [[Char]]
forall a b. (a -> b) -> a -> b
$ [Char]
query_redis [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
hKey   
              [[Char]] -> IO ()
forall (m :: * -> *) a. (MonadIO m, Show a) => a -> m ()
pre [[Char]]
code
              if [[Char]] -> Integer
forall (t :: * -> *) b a. (Foldable t, Num b) => t a -> b
len [[Char]]
code Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0 
              -- then let repStr = init $ foldr(\x y -> x ++ "\n" ++ y) [] tcode in write $ byteString $ toSBS repStr 
              then let repStr :: [Char]
repStr = [[Char]] -> [Char]
unlines [[Char]]
code in Builder -> IO ()
write (Builder -> IO ()) -> Builder -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Builder
byteString (ByteString -> Builder) -> ByteString -> Builder
forall a b. (a -> b) -> a -> b
$ [Char] -> ByteString
forall a. Typeable a => a -> ByteString
toSBS [Char]
repStr 
              else Builder -> IO ()
write (Builder -> IO ()) -> Builder -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Builder
byteString ByteString
emptySBS 
              IO ()
flush
              where
                preKey :: [Char]
preKey = [Char]
"AronLib."

                -- sorted string according to index of search term.
                -- gx file:///Users/aaa/myfile/bitbucket/stackproject/jupyterlab/sorted_haskell_function.html
                sortedByMatchedStrIndex :: [Char] -> [[Char]] -> [[Char]]
sortedByMatchedStrIndex [Char]
qstr [[Char]]
code = ([Char] -> [Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> a -> Bool) -> [a] -> [a]
qqsort(\[Char]
a [Char]
b -> let la :: Int
la = [Char] -> [Char] -> Int
matchIndex [Char]
qstr ([Char] -> Int) -> [Char] -> Int
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
forall a. [a] -> a
head ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> [[Char]]
splitStr [Char]
"::" [Char]
a 
                                                                       lb :: Int
lb = [Char] -> [Char] -> Int
matchIndex [Char]
qstr ([Char] -> Int) -> [Char] -> Int
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
forall a. [a] -> a
head ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> [[Char]]
splitStr [Char]
"::" [Char]
b 
                                                                   in  Int
la Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
lb ) ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ ShowS -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ShowS
trim [[Char]]
code

                matchIndex :: [Char] -> [Char] -> Int
matchIndex [Char]
q [Char]
s = case [Char] -> [Char] -> Maybe (Int, Int)
matchAny [Char]
q [Char]
s of
                                   Just (Int, Int)
x -> (Int, Int) -> Int
forall a b. (a, b) -> a
fst (Int, Int)
x
                                   Maybe (Int, Int)
_      -> Int
10 


{-|
    === Should use 'queryLibJavaPackage'

    NOT BEEN USED
-} 
queryLibJava::String -> Response
queryLibJava :: [Char] -> Response
queryLibJava [Char]
cmd = Status -> ResponseHeaders -> StreamingBody -> Response
responseStream 
              Status
status200
              [(HeaderName
"Content-Type", ByteString
"text/html")] (StreamingBody -> Response) -> StreamingBody -> Response
forall a b. (a -> b) -> a -> b
$ \Builder -> IO ()
write IO ()
flush -> do
              let tcmd :: [Char]
tcmd = ShowS
trim [Char]
cmd
              [Char] -> IO ()
putStrLn [Char]
cmd
              let hKey :: [Char]
hKey = [Char]
preKey [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ (ShowS
trim ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
2 [Char]
tcmd)
              [[Char]]
code <- [Char] -> IO [[Char]]
A.run ([Char] -> IO [[Char]]) -> [Char] -> IO [[Char]]
forall a b. (a -> b) -> a -> b
$ [Char]
query_redis [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
hKey   
              let tcode :: [[Char]]
tcode = ShowS -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ShowS
trim [[Char]]
code
              if [[Char]] -> Integer
forall (t :: * -> *) b a. (Foldable t, Num b) => t a -> b
len [[Char]]
tcode Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0 
              then let repStr :: [Char]
repStr = ShowS
forall a. [a] -> [a]
init ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ ([Char] -> ShowS) -> [Char] -> [[Char]] -> [Char]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr(\[Char]
x [Char]
y -> [Char]
x [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"\n" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
y) [] [[Char]]
tcode in Builder -> IO ()
write (Builder -> IO ()) -> Builder -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Builder
byteString (ByteString -> Builder) -> ByteString -> Builder
forall a b. (a -> b) -> a -> b
$ [Char] -> ByteString
forall a. Typeable a => a -> ByteString
toSBS [Char]
repStr 
              else Builder -> IO ()
write (Builder -> IO ()) -> Builder -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Builder
byteString ByteString
emptySBS 
              IO ()
flush
              where
                preKey :: [Char]
preKey = [Char]
"Aron."

{-|
    === Get java $jlib/AronLib.java without HTML
-} 
queryLibJavaPackage::String -> String -> Response
queryLibJavaPackage :: [Char] -> [Char] -> Response
queryLibJavaPackage [Char]
preKey [Char]
cmd = Status -> ResponseHeaders -> StreamingBody -> Response
responseStream 
              Status
status200
              [(HeaderName
"Content-Type", ByteString
"text/html")] (StreamingBody -> Response) -> StreamingBody -> Response
forall a b. (a -> b) -> a -> b
$ \Builder -> IO ()
write IO ()
flush -> do
              let tcmd :: [Char]
tcmd = ShowS
trim [Char]
cmd
              [Char] -> IO ()
putStrLn [Char]
cmd
              -- preKey = Print.  tcmd = "p list"
              -- => hKey = Print.list
              let hKey :: [Char]
hKey = [Char]
preKey [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ (ShowS
trim ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
2 [Char]
tcmd)
              [[Char]]
code <- [Char] -> IO [[Char]]
A.run ([Char] -> IO [[Char]]) -> [Char] -> IO [[Char]]
forall a b. (a -> b) -> a -> b
$ [Char]
query_redis [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
hKey   
              let tcode :: [[Char]]
tcode = ShowS -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ShowS
trim [[Char]]
code
              if [[Char]] -> Integer
forall (t :: * -> *) b a. (Foldable t, Num b) => t a -> b
len [[Char]]
tcode Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0 
              then let repStr :: [Char]
repStr = ShowS
forall a. [a] -> [a]
init ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ ([Char] -> ShowS) -> [Char] -> [[Char]] -> [Char]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr(\[Char]
x [Char]
y -> [Char]
x [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"\n" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
y) [] [[Char]]
tcode in Builder -> IO ()
write (Builder -> IO ()) -> Builder -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Builder
byteString (ByteString -> Builder) -> ByteString -> Builder
forall a b. (a -> b) -> a -> b
$ [Char] -> ByteString
forall a. Typeable a => a -> ByteString
toSBS [Char]
repStr 
              else Builder -> IO ()
write (Builder -> IO ()) -> Builder -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Builder
byteString ByteString
emptySBS 
              IO ()
flush
              where
                -- preKey = "Aron."



{-| 
    === Get user input: cmd = "s java regex", autocomplete commands

   TODO1 add host name here
   name <- run "uname"
   ls <- run "uname" >>= \x -> if len x > 0 then return head x else []

   :NOTE: USE in anyRoute2

   @
   data Response
       = ResponseFile H.Status H.ResponseHeaders FilePath (Maybe FilePart)
       | ResponseBuilder H.Status H.ResponseHeaders Builder
       | ResponseStream H.Status H.ResponseHeaders StreamingBody
       | ResponseRaw (IO B.ByteString -> (B.ByteString -> IO ()) -> IO ()) Response
     deriving Typeable

   responseStream::Status -> ResponseHeaders -> StreamingBody -> Response
   type StreamingBody = ( Builder -> IO() ) -> IO () -> IO ()
   @


-} 
responseSearch::Connection -> String -> Response                                                    
responseSearch :: Connection -> [Char] -> Response
responseSearch Connection
conn [Char]
s = Status -> ResponseHeaders -> StreamingBody -> Response
responseStream                                                   
              Status
status200  -- Status     ↓---- ResponseHeaders                                                        
              [(HeaderName
hContentType, ByteString
"text/html")] (StreamingBody -> Response) -> StreamingBody -> Response
forall a b. (a -> b) -> a -> b
$ \Builder -> IO ()
write IO ()
flush -> do                   
              --                                ↑     ↑
              --                                |     --------> IO ()
              --                                --------------> Builder -> IO()
              -- create table if table: userinput does not exist
              Connection -> Query -> IO ()
execute_ Connection
conn Query
sql_create_table 
              [UserInput]
cmdsql <- Connection -> Query -> IO [UserInput]
forall r. FromRow r => Connection -> Query -> IO [r]
query_ Connection
conn Query
sql_select ::IO [UserInput]
              let cmdList :: [[Char]]
cmdList = let ls :: [Text]
ls = (UserInput -> Text) -> [UserInput] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (UserInput -> Text
xcmd) [UserInput]
cmdsql::[TS.Text] in (Text -> [Char]) -> [Text] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map Text -> [Char]
forall a. Typeable a => a -> [Char]
toStr [Text]
ls::[String]
              let sortList :: [[Char]]
sortList = [[Char]] -> [[Char]]
groupCountFilter [[Char]]
cmdList
              -- limit the number of commands
              let autoList :: [[Char]]
autoList = Int -> [[Char]] -> [[Char]]
forall a. Int -> [a] -> [a]
take Int
20 [[Char]]
sortList
              -- bs <- readFileRepPat "src/htmlBody.htmlbs" "replacekey00" $
              -- bs <- (readFileRepPat "src/searchForm.html" "replaceSearchForm" $ toSBS $ optionHtml autoList)
                     -- >>= readFileRepPat "src/htmlBody.html" "replacekey00" 
              -- let htmlByteStr = toSBS $ htmlBodyH  $ (searchForm (optionHtml autoList))
              -- ls <- runCmd "uname"
              -- let osName = if len ls > 0 then head ls else []
              -- <input  type='hidden' id='osid' name="myname" value="Bjner Stroustrup Cheetah Chateau">
              -- let divStr = [r|<input type='hidden' id='osid' value='|] <> osName <> [r|' />|]
              -- let divSBS = toSBS divStr
              -- let osidStr = "hiddenosid"::BS.ByteString
              -- let bb = searchReplaceAnySBS bs osidStr divSBS
                  
              [[Char]]
rls <- [Char] -> IO [[Char]]
runCmd [Char]
"uname"
              let osName :: [Char]
osName = if [[Char]] -> Integer
forall (t :: * -> *) b a. (Foldable t, Num b) => t a -> b
len [[Char]]
rls Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0 then [[Char]] -> [Char]
forall a. [a] -> a
head [[Char]]
rls else []
              ByteString
bb <- [[Char]] -> [Char] -> IO ByteString
searchMainHtml [[Char]]
autoList [Char]
osName    
              [Char] -> [ByteString] -> IO ()
writeFileListBS [Char]
"/tmp/bs1.html" [ByteString
bb]
              -- write $ byteString $ BS.concat ([bs] ++ [divSBS])
              [[Char]] -> IO ()
logFileG [[Char]
"logme"] -- /tmp/x.x
              Builder -> IO ()
write (Builder -> IO ()) -> Builder -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Builder
byteString (ByteString -> Builder) -> ByteString -> Builder
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
BS.concat [ByteString
bb]
              -- ↑            ↑
              --              --- byteString::ByteString -> Builder
              -- write::Builder -> IO()
              -- 
          where 
            sql_create_table :: Query
sql_create_table = Query
"CREATE TABLE IF NOT EXISTS userinput (id INTEGER PRIMARY KEY AUTOINCREMENT, xcmd TEXT)"
            sql_select :: Query
sql_select = Query
"SELECT id, xcmd FROM userinput"


searchMainHtml::[String] -> String -> IO BS.ByteString
searchMainHtml :: [[Char]] -> [Char] -> IO ByteString
searchMainHtml [[Char]]
autoList [Char]
osName = do
  ByteString
bs <- ([Char] -> ByteString -> ByteString -> IO ByteString
readFileRepPat [Char]
"src/searchForm.html" ByteString
"replaceSearchForm" (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ [Char] -> ByteString
forall a. Typeable a => a -> ByteString
toSBS ([Char] -> ByteString) -> [Char] -> ByteString
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
optionHtml [[Char]]
autoList)
                     IO ByteString -> (ByteString -> IO ByteString) -> IO ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> ByteString -> ByteString -> IO ByteString
readFileRepPat [Char]
"src/htmlBody.html" ByteString
"replacekey00" 
  let divStr :: [Char]
divStr = [r|<input type='hidden' id='osid' value='|] [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
osName [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [r|' />|]
  let divSBS :: ByteString
divSBS = [Char] -> ByteString
forall a. Typeable a => a -> ByteString
toSBS [Char]
divStr
  let osidStr :: ByteString
osidStr = ByteString
"hiddenosid"::BS.ByteString
  let bb :: ByteString
bb = ByteString -> ByteString -> ByteString -> ByteString
searchReplaceAnySBS ByteString
bs ByteString
osidStr ByteString
divSBS
  [CSSPro]
ls <- IO [CSSPro]
getPreStyle
  let s :: [Char]
s = [[Char]] -> ShowS
concatStr ((CSSPro -> [Char]) -> [CSSPro] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map CSSPro -> [Char]
cssToStr [CSSPro]
ls) []
  let sub :: ByteString
sub = [Char] -> ByteString
forall a. Typeable a => a -> ByteString
toSBS ([Char] -> ByteString) -> [Char] -> ByteString
forall a b. (a -> b) -> a -> b
$ [Char]
"<style>.co0{" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
+ [Char]
s [Char] -> ShowS
forall a. [a] -> [a] -> [a]
+ [Char]
"}</style>"
  let pat1 :: ByteString
pat1 = ByteString
"replacestylecolor"::BS.ByteString
  let b1 :: ByteString
b1 = ByteString -> ByteString -> ByteString -> ByteString
searchReplaceAnySBS ByteString
bb ByteString
pat1 ByteString
sub
  ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
b1
  where
    + :: [a] -> [a] -> [a]
(+) = [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
(++)
            
{-| 
    === Get user input: cmd = "s java regex", autocomplete commands

    1. remove spaces from cmd
    2. insert cmd to table: userinput if userinput exists, otherwise create table: userinput
        1. sorted all cmd and create Html form with all cmd
        2. create Html output from cmd query.

        + store user input commands, autocomplete commands in a table: userinput
        + if table does not exist, create one, otherwise insert data to table: userinput
        + autocomplete, query commands from sqlite table

    3. No Search field, only query blocks data

    :NOTE: USE in anyRoute2

    REFNOTE: /Users/aaa/myfile/bitbucket/publicfile/notdelete/codeblock.hs

    XXX
-}               
responseSnippetHTML2::Connection -> String -> IORef HMap2-> Response
responseSnippetHTML2 :: Connection -> [Char] -> IORef HMap2 -> Response
responseSnippetHTML2 Connection
conn [Char]
cmd IORef HMap2
ref = Status -> ResponseHeaders -> StreamingBody -> Response
responseStream
              Status
status200
              [(HeaderName
"Content-Type", ByteString
"text/html"), (HeaderName
"Access-Control-Allow-Origin", ByteString
"*")] (StreamingBody -> Response) -> StreamingBody -> Response
forall a b. (a -> b) -> a -> b
$ \Builder -> IO ()
write IO ()
flush -> do
              let sCmd :: [Char]
sCmd = ShowS
trim [Char]
cmd

              -- store user input commands, autocomplete commands in a table: userinput
              -- if table does not exist, create one, otherwise insert data to table: userinput
              -- autocomplete, query commands from sqlite table
              -- logCurrCmd [sCmd]
              -- create table if table: userinput does not exist
              Connection -> Query -> IO ()
execute_ Connection
conn Query
sql_create_table 
              Connection -> Query -> UserInput -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
execute Connection
conn Query
sql_insert (Int64 -> Text -> UserInput
UserInput Int64
0 ([Char] -> Text
forall a. Typeable a => a -> Text
toSText [Char]
cmd))
              [UserInput]
cmdsql <- Connection -> Query -> IO [UserInput]
forall r. FromRow r => Connection -> Query -> IO [r]
query_ Connection
conn Query
sql_select ::IO [UserInput]
              let cmdList :: [[Char]]
cmdList = let ls :: [Text]
ls = (UserInput -> Text) -> [UserInput] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map UserInput -> Text
xcmd [UserInput]
cmdsql::[TS.Text] in (Text -> [Char]) -> [Text] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map Text -> [Char]
forall a. Typeable a => a -> [Char]
toStr [Text]
ls::[String]
              -- pa cmdList 

              let sortList :: [[Char]]
sortList = [[Char]] -> [[Char]]
groupCountFilter [[Char]]
cmdList
              -- limit the number of commands
              let autoList :: [[Char]]
autoList = Int -> [[Char]] -> [[Char]]
forall a. Int -> [a] -> [a]
take Int
20 [[Char]]
sortList

              -- pa sortList 
              -- writeToFileAppend cmdLog [sCmd] 
              -- listCmd <- readCmd cmdLog SnippetT 
              -- write $ byteString $ toSBS $ replyHtml (spanBlock hmap (Just (toSBS (drop 2 sCmd)) )) listCmd 
              HMap2
hmap <- IORef HMap2 -> IO HMap2
forall a. IORef a -> IO a
readIORef IORef HMap2
ref
              [Char] -> IO ()
forall (m :: * -> *) a. (MonadIO m, Show a) => a -> m ()
pre [Char]
sCmd
              [Char] -> IO ()
fw [Char]
"--"
              -- pre $ spanBlockX transform hmap (Just (toSBS (drop 2 sCmd)))
              -- let htmlByteStr = toSBS $ spanBlockX transform hmap (Just (toSBS (drop 2 sCmd)))
              -- let htmlByteStr = toSBS $ spanBlockX1 transform hmap (Just (toSBS (drop 2 sCmd)))
              let htmlByteStr :: ByteString
htmlByteStr = [Char] -> ByteString
forall a. Typeable a => a -> ByteString
toSBS ([Char] -> ByteString) -> [Char] -> ByteString
forall a b. (a -> b) -> a -> b
$ ([[[Char]]] -> [[[Char]]]) -> HMap2 -> Maybe ByteString -> [Char]
spanBlockX1 [[[Char]]] -> [[[Char]]]
transformX HMap2
hmap (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ([Char] -> ByteString
forall a. Typeable a => a -> ByteString
toSBS (Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
2 [Char]
sCmd)))
              [[Char]] -> IO ()
logFileG ([[Char]] -> IO ()) -> [[Char]] -> IO ()
forall a b. (a -> b) -> a -> b
$ [ByteString -> [Char]
forall a. Typeable a => a -> [Char]
toStr ByteString
htmlByteStr]

              -- following line causes the server error
              -- writeFileBS "/tmp/b.html" htmlByteStr
              -- response html byte string
              -- byteString::ByteString -> Builder
              Builder -> IO ()
write (Builder -> IO ()) -> Builder -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Builder
byteString ByteString
htmlByteStr 

              IO ()
flush
              where 
                sql_create_table :: Query
sql_create_table = Query
"CREATE TABLE IF NOT EXISTS userinput (id INTEGER PRIMARY KEY AUTOINCREMENT, xcmd TEXT)"
                sql_insert :: Query
sql_insert = Query
"INSERT INTO userinput (xcmd) VALUES (?)" 
                sql_select :: Query
sql_select = Query
"SELECT id, xcmd FROM userinput"
              
              

{-| 
    === Query snippet from HMap2 without Html

    :NOTE: USE in anyRoute2

    cmd -> "n emacs"
-}            
responseSnippetTxt2::String -> IORef HMap2 -> Response
responseSnippetTxt2 :: [Char] -> IORef HMap2 -> Response
responseSnippetTxt2 [Char]
cmd IORef HMap2
ref = Status -> ResponseHeaders -> StreamingBody -> Response
responseStream
              Status
status200
              [(HeaderName
"Content-Type", ByteString
"text/html")] (StreamingBody -> Response) -> StreamingBody -> Response
forall a b. (a -> b) -> a -> b
$ \Builder -> IO ()
write IO ()
flush -> do
              let sCmd :: [Char]
sCmd = ShowS
trim [Char]
cmd
              [Char] -> IO ()
putStrLn [Char]
cmd
              -- store command to log file
              -- TODO: Write cmd to database
              -- writeToFileAppend cmdLog [sCmd] 
              -- Get the HMap from IO reference
              HMap2
hmap <- IORef HMap2 -> IO HMap2
forall a. IORef a -> IO a
readIORef IORef HMap2
ref 
              -- drop 2 sCmd : "n java" => "java"
              -- key = "java" => use the key in hmap 
              -- response the byteString to client
              Builder -> IO ()
write (Builder -> IO ()) -> Builder -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Builder
byteString (ByteString -> Builder) -> ByteString -> Builder
forall a b. (a -> b) -> a -> b
$ [Char] -> ByteString
forall a. Typeable a => a -> ByteString
toSBS ([Char] -> ByteString) -> [Char] -> ByteString
forall a b. (a -> b) -> a -> b
$ HMap2 -> Maybe ByteString -> [Char]
spanBlockXX2 HMap2
hmap (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ([Char] -> ByteString
forall a. Typeable a => a -> ByteString
toSBS (Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
2 [Char]
sCmd)))
              IO ()
flush
  
-- spanBlockXX2 hmap mKey = foldListListTxt2 $ case (M.lookup (toStr $ fromJust mKey) hmap) of 
                                     -- Just s -> s
                                     -- _      -> [(["spanBlockXX2: nothing Txt"], 0, 0, 0)]


{-|
 === KEY: json snippet, json codeblock

 @
  SEE: $j/HttpRequestJson.java
       $scr/sj.sh
 @
 
-}
responseSnippetJSON::String -> IORef HMap2 -> Response
responseSnippetJSON :: [Char] -> IORef HMap2 -> Response
responseSnippetJSON [Char]
cmd IORef HMap2
ref = Status -> ResponseHeaders -> StreamingBody -> Response
responseStream
              Status
status200
              [(HeaderName
hContentType,  ByteString
"application/json")] (StreamingBody -> Response) -> StreamingBody -> Response
forall a b. (a -> b) -> a -> b
$ \Builder -> IO ()
write IO ()
flush -> do
              let sCmd :: [Char]
sCmd = ShowS
trim [Char]
cmd
              [Char] -> IO ()
putStrLn [Char]
cmd
              -- store command to log file
              -- TODO: Write cmd to database
              -- writeToFileAppend cmdLog [sCmd] 
              -- Get the HMap from IO reference
              HMap2
hmap <- IORef HMap2 -> IO HMap2
forall a. IORef a -> IO a
readIORef IORef HMap2
ref
              let may :: Maybe [([[Char]], Integer, Integer, Integer)]
may = [Char] -> HMap2 -> Maybe [([[Char]], Integer, Integer, Integer)]
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup (Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
2 [Char]
sCmd) HMap2
hmap
              let lt :: [([[Char]], Integer)]
lt = case Maybe [([[Char]], Integer, Integer, Integer)]
may of
                           Just [([[Char]], Integer, Integer, Integer)]
cx -> (([[Char]], Integer, Integer, Integer) -> ([[Char]], Integer))
-> [([[Char]], Integer, Integer, Integer)] -> [([[Char]], Integer)]
forall a b. (a -> b) -> [a] -> [b]
map(\([[Char]]
a, Integer
n, Integer
_, Integer
_) -> ([[Char]]
a, Integer
n)) [([[Char]], Integer, Integer, Integer)]
cx
                           Maybe [([[Char]], Integer, Integer, Integer)]
_      -> [([[Char]
"nothing"], Integer
0)]
              let ls :: [[[Char]]]
ls = (([[Char]], Integer) -> [[Char]])
-> [([[Char]], Integer)] -> [[[Char]]]
forall a b. (a -> b) -> [a] -> [b]
map ([[Char]], Integer) -> [[Char]]
forall a b. (a, b) -> a
fst [([[Char]], Integer)]
lt  
              let lr :: [Integer]
lr = (([[Char]], Integer) -> Integer)
-> [([[Char]], Integer)] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map ([[Char]], Integer) -> Integer
forall a b. (a, b) -> b
snd [([[Char]], Integer)]
lt
              -- drop 2 sCmd : "n java" => "java"
              -- key = "java" => use the key in hmap 
              -- response the byteString to client
              -- let snippet = SnippetJSON{name = "genematkk",  snippet = [["dog", "cat", "excited"], ["aa", "bb", "cc"]]}
              let snippet :: SnippetJSON
snippet = SnippetJSON :: [Integer] -> Text -> [[[Char]]] -> SnippetJSON
SnippetJSON{$sel:pidls:SnippetJSON :: [Integer]
pidls = [Integer]
lr, $sel:name:SnippetJSON :: Text
name = Text
"responseSnippetJSON fun",  $sel:snippet:SnippetJSON :: [[[Char]]]
snippet = [[[Char]]]
ls} 
              [[Char]] -> IO ()
logFileG [SnippetJSON -> [Char]
forall a. Show a => a -> [Char]
show SnippetJSON
snippet] 
              let gbs :: ByteString
gbs = (ByteString -> ByteString
forall a. Typeable a => a -> ByteString
toSBS (ByteString -> ByteString)
-> (SnippetJSON -> ByteString) -> SnippetJSON -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SnippetJSON -> ByteString
forall a. ToJSON a => a -> ByteString
DA.encode) SnippetJSON
snippet
              Builder -> IO ()
write (Builder -> IO ()) -> Builder -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Builder
byteString ByteString
gbs
              IO ()
flush              

{-|
    === Generate matrix from Json javascript XMLHttpRequest

    * See *haskellwebapp2/postMatrix.html*
    * <file:///Users/aaa/myfile/bitbucket/haskellwebapp2/postMatrix.html postMatrix.html>
    * <http://localhost:8080/matrix Link To Matrix>
    *
    * Receive request from client
    * Decode body
    * Pattern matching Record Maybe 'GeneMatrix'
    * Construct record 'MatInt' if ncol and nrow are in 'GeneMatrix', otherwise create an empty 'MatInt'

    @
      MatInt{name="", matrix=[]}
    @
-} 
geneRectMat::Application
geneRectMat :: Application
geneRectMat Request
req Response -> IO ResponseReceived
response = do 
        ByteString
str <- Request -> IO ByteString
getRequestBodyChunk Request
req
        
        let may :: Maybe GeneMatrix
may = ByteString -> Maybe GeneMatrix
forall a. FromJSON a => ByteString -> Maybe a
DA.decode (ByteString -> Maybe GeneMatrix) -> ByteString -> Maybe GeneMatrix
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
forall a. Typeable a => a -> ByteString
toLBS ByteString
str :: Maybe GeneMatrix 
        [Char] -> IO ()
fw [Char]
"may"
        Maybe GeneMatrix -> IO ()
forall a. Show a => a -> IO ()
print Maybe GeneMatrix
may
        let matJson :: GeneMatrix
matJson = case Maybe GeneMatrix
may of 
                    (Just GeneMatrix
x) -> GeneMatrix
x 
                    Maybe GeneMatrix
_        -> GeneMatrix :: Text -> Integer -> Integer -> GeneMatrix
GeneMatrix{$sel:cmd:GeneMatrix :: Text
cmd = Text
"", $sel:ncol:GeneMatrix :: Integer
ncol = Integer
0, $sel:nrow:GeneMatrix :: Integer
nrow=Integer
0} 
        [Char] -> IO ()
fw [Char]
"matJson"
        GeneMatrix -> IO ()
forall a. Show a => a -> IO ()
print GeneMatrix
matJson
        -- get ncol and nrow from client, otherwise set MatInt{name="", matrix=[]} 
        let gmatrix :: MatInt
gmatrix = case (GeneMatrix -> Text
cmd GeneMatrix
matJson) of 
                                -- genematrix is from file => haskellwebapp2/postMatrix.html
                                Text
"genematrix" -> let nc :: Integer
nc = (GeneMatrix -> Integer
ncol GeneMatrix
matJson) 
                                                    nr :: Integer
nr = (GeneMatrix -> Integer
nrow GeneMatrix
matJson)
                                                in MatInt :: Text -> [[Integer]] -> MatInt
MatInt{$sel:name:MatInt :: Text
name = Text
"genemat", $sel:matrix:MatInt :: [[Integer]]
matrix = Integer -> Integer -> [[Integer]]
geneMatMN Integer
nc Integer
nr}
                                Text
_            -> MatInt :: Text -> [[Integer]] -> MatInt
MatInt{$sel:name:MatInt :: Text
name = Text
"genemat", $sel:matrix:MatInt :: [[Integer]]
matrix = []} 
        let gbs :: ByteString
gbs = (ByteString -> ByteString
forall a. Typeable a => a -> ByteString
toSBS (ByteString -> ByteString)
-> (MatInt -> ByteString) -> MatInt -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MatInt -> ByteString
forall a. ToJSON a => a -> ByteString
DA.encode) MatInt
gmatrix
        [Char] -> IO ()
fw [Char]
"gbs"
        [Char] -> IO ()
forall (m :: * -> *) a. (MonadIO m, Show a) => a -> m ()
pre ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> [Char]
forall a. Typeable a => a -> [Char]
toStr ByteString
gbs 
        let json :: ByteString
json = (ByteString -> ByteString
forall a. Typeable a => a -> ByteString
toSBS (ByteString -> ByteString)
-> (GeneMatrix -> ByteString) -> GeneMatrix -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GeneMatrix -> ByteString
forall a. ToJSON a => a -> ByteString
DA.encode) GeneMatrix :: Text -> Integer -> Integer -> GeneMatrix
GeneMatrix{$sel:cmd:GeneMatrix :: Text
cmd = Text
"mycmd", $sel:ncol:GeneMatrix :: Integer
ncol=Integer
3, $sel:nrow:GeneMatrix :: Integer
nrow=Integer
4}
        [Char] -> IO ()
fw [Char]
"str"
        ByteString -> IO ()
S8.putStrLn ByteString
str
        [Char] -> IO ()
fw [Char]
"response gbs"
        Response -> IO ResponseReceived
response (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ ByteString -> Response
responseNothingBS ByteString
gbs

        
{-|
    === Generate HTML Table
-}
geneHTMLTable::Application
geneHTMLTable :: Application
geneHTMLTable Request
req Response -> IO ResponseReceived
response = do 
        ByteString
str <- Request -> IO ByteString
getRequestBodyChunk Request
req        
        let may :: Maybe GeneMatrix
may = (ByteString -> Maybe GeneMatrix
forall a. FromJSON a => ByteString -> Maybe a
DA.decode (ByteString -> Maybe GeneMatrix)
-> (ByteString -> ByteString) -> ByteString -> Maybe GeneMatrix
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
forall a. Typeable a => a -> ByteString
toLBS) ByteString
str :: Maybe GeneMatrix 
        [Char] -> IO ()
fw [Char]
"may"
        Maybe GeneMatrix -> IO ()
forall a. Show a => a -> IO ()
print Maybe GeneMatrix
may
        let htabJson :: GeneMatrix
htabJson = case Maybe GeneMatrix
may of 
                    (Just GeneMatrix
x) -> GeneMatrix
x 
                    Maybe GeneMatrix
_        -> GeneMatrix :: Text -> Integer -> Integer -> GeneMatrix
GeneMatrix{$sel:cmd:GeneMatrix :: Text
cmd = Text
"", $sel:ncol:GeneMatrix :: Integer
ncol = Integer
0, $sel:nrow:GeneMatrix :: Integer
nrow = Integer
0} 
        [Char] -> IO ()
fw [Char]
"htabJson"
        GeneMatrix -> IO ()
forall a. Show a => a -> IO ()
print GeneMatrix
htabJson
        -- get ncol and nrow from client, otherwise set MatInt{name="", matrix=[]} 
        let htmlTable :: HTMLTable
htmlTable = case (GeneMatrix -> Text
cmd GeneMatrix
htabJson) of 
                                -- genematrix is from file => haskellwebapp2/postMatrix.html
                                Text
"htmltable"  -> let nc :: Integer
nc = (GeneMatrix -> Integer
ncol GeneMatrix
htabJson) 
                                                    nr :: Integer
nr = (GeneMatrix -> Integer
nrow GeneMatrix
htabJson)
                                                in HTMLTable :: Text -> [Text] -> HTMLTable
HTMLTable{$sel:name:HTMLTable :: Text
name = Text
"htmltable", $sel:matrix:HTMLTable :: [Text]
matrix = Integer -> Integer -> [Text]
htmlTableRowColSText Integer
nc Integer
nr}
                                Text
_            -> HTMLTable :: Text -> [Text] -> HTMLTable
HTMLTable{$sel:name:HTMLTable :: Text
name = Text
"htmltable", $sel:matrix:HTMLTable :: [Text]
matrix = []} 
        let htab :: ByteString
htab = (ByteString -> ByteString
forall a. Typeable a => a -> ByteString
toSBS (ByteString -> ByteString)
-> (HTMLTable -> ByteString) -> HTMLTable -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HTMLTable -> ByteString
forall a. ToJSON a => a -> ByteString
DA.encode) HTMLTable
htmlTable
        [Char] -> IO ()
fw [Char]
"htab"
        [Char] -> IO ()
forall (m :: * -> *) a. (MonadIO m, Show a) => a -> m ()
pre ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> [Char]
forall a. Typeable a => a -> [Char]
toStr ByteString
htab
        [Char] -> IO ()
fw [Char]
"htmltable"
        HTMLTable -> IO ()
forall (m :: * -> *) a. (MonadIO m, Show a) => a -> m ()
pre HTMLTable
htmlTable
        [Char] -> IO ()
fw [Char]
"str"
        ByteString -> IO ()
S8.putStrLn ByteString
str
        [Char] -> IO ()
fw [Char]
"response htab"
        Response -> IO ResponseReceived
response (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ HTMLTable -> Response
forall a. ToJSON a => a -> Response
responseJSON HTMLTable
htmlTable

       
{-|
	=== Get text color and background color from Redis

        * The function will be called from Ajax in aronlib.js
        * Click on the background/color => make a Ajax call

        @
         ("getcolor":_)        -> getPreFromRedis request respond -- Send JSON PreColor{color::TS.Text, background::TS.Text} to client side, in aronlib.js
        @

        > aronlib.js => Ajax => getPreFromRedis

        > getPreStyle::IO [(String, String)]

        * send JSON to client

        > data PreColor = PreColor{color::TS.Text, background::TS.Text}

        > redis-cli
        > keys 'HTMLPre.color'
        > keys 'HTMLPre.background-color'

        * Redis KEYS 'color'
        * Redis KEYS 'background-color'
-}
getPreFromRedis::Application
getPreFromRedis :: Application
getPreFromRedis Request
req Response -> IO ResponseReceived
response = do
                   [CSSPro]
styleList <- IO [CSSPro]
getPreStyle
                   let preColor :: PreColor
preColor = if [CSSPro] -> Integer
forall (t :: * -> *) b a. (Foldable t, Num b) => t a -> b
len [CSSPro]
styleList Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
2
                         then let m :: HashMap [Char] [Char]
m = [CSSPro] -> HashMap [Char] [Char]
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
M.fromList [CSSPro]
styleList
                              in  PreColor :: Text -> Text -> PreColor
PreColor{$sel:color:PreColor :: Text
color = case ([Char] -> HashMap [Char] [Char] -> Maybe [Char]
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup [Char]
"color" HashMap [Char] [Char]
m) of
                                                               Just [Char]
x -> [Char] -> Text
forall a. Typeable a => a -> Text
toSText [Char]
x
                                                               Maybe [Char]
_      -> Text
""
                                          ,
                                           $sel:background:PreColor :: Text
background = case ([Char] -> HashMap [Char] [Char] -> Maybe [Char]
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup [Char]
"background-color" HashMap [Char] [Char]
m) of
                                                               Just [Char]
x -> [Char] -> Text
forall a. Typeable a => a -> Text
toSText [Char]
x
                                                               Maybe [Char]
_      -> Text
""
                                          }
                         else PreColor :: Text -> Text -> PreColor
PreColor{$sel:color:PreColor :: Text
color = Text
"", $sel:background:PreColor :: Text
background = Text
""}
                   -- Form a JSON object PreColor and send it back to client side
                   [Char] -> IO ()
fw [Char]
"preColor"
                   PreColor -> IO ()
forall (m :: * -> *) a. (MonadIO m, Show a) => a -> m ()
pre PreColor
preColor
                   
                   Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (PreColor -> Text
color PreColor
preColor Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"") (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
forall a. Show a => a -> IO ()
print [Char]
"Redis has no key 'color' => WaiLib.hs getPreFromRedis"
                   Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (PreColor -> Text
background PreColor
preColor Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"") (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
forall a. Show a => a -> IO ()
print [Char]
"Redis has no key 'background' => WaiLib.hs getPreFromRedis" IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                   if (PreColor -> Text
color PreColor
preColor Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"") then [Char] -> IO ()
forall a. Show a => a -> IO ()
print [Char]
"empty" else [Char] -> IO ()
forall a. Show a => a -> IO ()
print [Char]
"not empty"
                   Response -> IO ResponseReceived
response (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ PreColor -> Response
forall a. ToJSON a => a -> Response
responseJSON PreColor
preColor

{-|
 ==== KEY: Update snippet from client side

 * Need pid from client side

 SEE: 'hiddenForm2'
 @
 Post method 
    <form action="/update" name="Update" class="hf" id="f123" method="POST">
 
 -- In AronModule.hs
 data UpdateCodeBlock = UpdateCodeBlock{pid::Integer, newcode::String, begt::Integer, endt::Integer} deriving (GEN.Generic, Show)
                                         ↑ 
                                         + -> Primary Key in TABLE: CodeBlock

 Duplicate row id = pid,  and set show=0
 @           
-}
updateCodeBlock::Connection -> IORef HMap2 -> Application
updateCodeBlock :: Connection -> IORef HMap2 -> Application
updateCodeBlock Connection
conn IORef HMap2
ref Request
req Response -> IO ResponseReceived
response = do
  ByteString
str <- Request -> IO ByteString
getRequestBodyChunk Request
req
  let may :: Maybe UpdateCodeBlock
may = (ByteString -> Maybe UpdateCodeBlock
forall a. FromJSON a => ByteString -> Maybe a
DA.decode (ByteString -> Maybe UpdateCodeBlock)
-> (ByteString -> ByteString)
-> ByteString
-> Maybe UpdateCodeBlock
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
forall a. Typeable a => a -> ByteString
toLBS) ByteString
str :: Maybe UpdateCodeBlock
  [Char] -> IO ()
fw [Char]
"may"
  Maybe UpdateCodeBlock -> IO ()
forall (m :: * -> *) a. (MonadIO m, Show a) => a -> m ()
pre Maybe UpdateCodeBlock
may
  let codeJson :: UpdateCodeBlock
codeJson = case Maybe UpdateCodeBlock
may of 
        (Just UpdateCodeBlock
x) -> UpdateCodeBlock
x 
        Maybe UpdateCodeBlock
_        -> UpdateCodeBlock :: Integer -> [Char] -> Integer -> Integer -> UpdateCodeBlock
UpdateCodeBlock{$sel:pid:UpdateCodeBlock :: Integer
pid = Integer
0, $sel:newcode:UpdateCodeBlock :: [Char]
newcode=[Char]
"no code", $sel:begt:UpdateCodeBlock :: Integer
begt=Integer
0, $sel:endt:UpdateCodeBlock :: Integer
endt=Integer
0} 
  [Char] -> IO ()
fw [Char]
"updateCodeBlock WaiLib.hs"
  UpdateCodeBlock -> IO ()
forall (m :: * -> *) a. (MonadIO m, Show a) => a -> m ()
pre UpdateCodeBlock
codeJson
  -- Duplicate row id = pid,  and set show=0
  Connection -> Integer -> IO ()
duplicatedRowNoShow Connection
conn (Integer -> IO ()) -> Integer -> IO ()
forall a b. (a -> b) -> a -> b
$ UpdateCodeBlock -> Integer
pid UpdateCodeBlock
codeJson
  Connection -> Integer -> Text -> IO ()
updateDatabaseNewCodeTable Connection
conn (UpdateCodeBlock -> Integer
pid UpdateCodeBlock
codeJson) ([Char] -> Text
forall a. Typeable a => a -> Text
toSText ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ UpdateCodeBlock -> [Char]
newcode UpdateCodeBlock
codeJson)
  -- if update ok, then send back "ok"
  [Char]
cmd <- [Char] -> IO [Char]
redisGetLastCmd [Char]
keyLastCmd
  let begtClient :: Integer
begtClient = UpdateCodeBlock -> Integer
begt UpdateCodeBlock
codeJson
  let upcodeblock :: CodeBlockReply
upcodeblock = CodeBlockReply :: [Char] -> [Char] -> [Char] -> Integer -> Integer -> CodeBlockReply
CodeBlockReply{$sel:ok:CodeBlockReply :: [Char]
ok = [Char]
"True", $sel:retcmd:CodeBlockReply :: [Char]
retcmd = [Char]
"update", $sel:retdata:CodeBlockReply :: [Char]
retdata = [Char]
cmd, $sel:retbegt:CodeBlockReply :: Integer
retbegt = Integer
begtClient, $sel:retendt:CodeBlockReply :: Integer
retendt = Integer
0}
  [([[Char]], ([[Char]], Integer, Integer, Integer))]
newList <- Connection
-> IO [([[Char]], ([[Char]], Integer, Integer, Integer))]
readDatabaseCodeBlock Connection
conn 
  -- pre newList
  -- read the map out from ref
  -- conver all the keys to list of keyssnippetMap::[([String], [String])] -> IORef HMap -> IO ()
  -- rehash the map
  -- type HMap = M.HashMap String [[String]] 
  -- IORef HMap => ref
  [([[Char]], ([[Char]], Integer, Integer, Integer))]
-> IORef HMap2 -> IO ()
updatePrefixMap [([[Char]], ([[Char]], Integer, Integer, Integer))]
newList IORef HMap2
ref
    
--   hmap <- readIORef ref 
--   let keys = M.keys hmap
--   modifyIORef ref (mapClear2 keys)
--   listToPrefixMap newList ref
  Response -> IO ResponseReceived
response (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ CodeBlockReply -> Response
forall a. ToJSON a => a -> Response
responseJSON CodeBlockReply
upcodeblock

{-|
    === KEY: validate snippet format and padding

    * Check whether the input data is valid format
    * At least two lines
    * First line: a:b:c

    @
    snippet:*: code
    line 1

    a:b:c len ["a", "b", "c"] > 2


    Input:
    dog, cat pig
    line 1
 
    Padding:
    314:*:dog, cat pig
    line 1
   
    @
-}
validateFormat::String -> String  -> (Bool, String)
validateFormat :: [Char] -> [Char] -> (Bool, [Char])
validateFormat [Char]
s [Char]
ran = if Bool
b then (Bool
False, [Char]
s) else ((Bool -> Bool
not (Bool -> Bool) -> ([[Char]] -> Bool) -> [[Char]] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) [[Char]]
ls', [[Char]] -> [Char]
unlines [[Char]]
ls')
  where
    ls :: [[Char]]
ls = [Char] -> [[Char]]
lines [Char]
s
    sp :: [Char] -> [[Char]]
sp [Char]
e = [Char] -> [Char] -> [[Char]]
splitStr [Char]
":" [Char]
e
    n :: Integer
n = ([[Char]] -> Integer
forall (t :: * -> *) b a. (Foldable t, Num b) => t a -> b
len ([[Char]] -> Integer)
-> ([[Char]] -> [[Char]]) -> [[Char]] -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]]
sp ([Char] -> [[Char]])
-> ([[Char]] -> [Char]) -> [[Char]] -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> [Char]
forall a. [a] -> a
head) [[Char]]
ls  -- a:b:c => len ["a", "b", "c"], n == 0 => padding with  random:*: xxx
    b :: Bool
b = [[Char]] -> Integer
forall (t :: * -> *) b a. (Foldable t, Num b) => t a -> b
len [[Char]]
ls Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
1
    x :: [Char]
x = [[Char]] -> [Char]
forall a. [a] -> a
head [[Char]]
ls
    cs :: [[Char]]
cs = [[Char]] -> [[Char]]
forall a. [a] -> [a]
tail [[Char]]
ls
    pad :: ShowS
pad [Char]
ran = [Char]
ran [Char] -> ShowS
forall a. [a] -> [a] -> [a]
+ [Char]
":*:" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
+ [Char]
x
    ls' :: [[Char]]
ls' = if Integer
n Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
1 then (ShowS
pad [Char]
ran) [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [[Char]]
cs else [[Char]]
ls  -- splitStr ":" "abc" => ["abc"]
    + :: [a] -> [a] -> [a]
(+) = [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
(++)

{-|
    === KEY: insert code block, insert code to database, update prefix map

    * It supports command line and Emacs

    @

    @
-}
insertCodeBlock::Connection -> IORef HMap2 -> Application
insertCodeBlock :: Connection -> IORef HMap2 -> Application
insertCodeBlock Connection
conn IORef HMap2
ref Request
req Response -> IO ResponseReceived
response = do
  ByteString
str <- Request -> IO ByteString
getRequestBodyChunk Request
req
  [Char] -> IO ()
fw [Char]
"str"
  ByteString -> IO ()
forall (m :: * -> *) a. (MonadIO m, Show a) => a -> m ()
pre ByteString
str
  [Char] -> IO ()
fw [Char]
"req"
  Request -> IO ()
forall (m :: * -> *) a. (MonadIO m, Show a) => a -> m ()
pre Request
req
  let may :: Maybe UpdateCodeBlock
may = (ByteString -> Maybe UpdateCodeBlock
forall a. FromJSON a => ByteString -> Maybe a
DA.decode (ByteString -> Maybe UpdateCodeBlock)
-> (ByteString -> ByteString)
-> ByteString
-> Maybe UpdateCodeBlock
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
forall a. Typeable a => a -> ByteString
toLBS) ByteString
str :: Maybe UpdateCodeBlock
  [Char] -> IO ()
fw [Char]
"may"
  Maybe UpdateCodeBlock -> IO ()
forall (m :: * -> *) a. (MonadIO m, Show a) => a -> m ()
pre Maybe UpdateCodeBlock
may
  let codeJson :: UpdateCodeBlock
codeJson = case Maybe UpdateCodeBlock
may of 
        (Just UpdateCodeBlock
x) -> UpdateCodeBlock
x 
        Maybe UpdateCodeBlock
_        -> UpdateCodeBlock :: Integer -> [Char] -> Integer -> Integer -> UpdateCodeBlock
UpdateCodeBlock{$sel:pid:UpdateCodeBlock :: Integer
pid = Integer
0, $sel:newcode:UpdateCodeBlock :: [Char]
newcode = [Char]
"no code insertCodeBlock", $sel:begt:UpdateCodeBlock :: Integer
begt = Integer
0, $sel:endt:UpdateCodeBlock :: Integer
endt = Integer
0} 
  [Char] -> IO ()
fw [Char]
"codeJson"
  UpdateCodeBlock -> IO ()
forall (m :: * -> *) a. (MonadIO m, Show a) => a -> m ()
pre UpdateCodeBlock
codeJson
  let code :: [Char]
code = UpdateCodeBlock -> [Char]
newcode UpdateCodeBlock
codeJson
  let ls :: [[Char]]
ls = [Char] -> [[Char]]
lines ([Char] -> [[Char]]) -> [Char] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ ShowS
forall a. Typeable a => a -> [Char]
toStr [Char]
code
  [[Char]] -> IO ()
forall (m :: * -> *) a. (MonadIO m, Show a) => a -> m ()
pre [[Char]]
ls
  [[Char]] -> IO ()
forall (m :: * -> *) a. (MonadIO m, Show a) => a -> m ()
pre ([[Char]] -> IO ()) -> [[Char]] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> [[Char]]
splitStr [Char]
":" ([[Char]] -> [Char]
forall a. [a] -> a
head [[Char]]
ls)
  [Char] -> IO ()
forall (m :: * -> *) a. (MonadIO m, Show a) => a -> m ()
pre [Char]
code
  let begtClient :: Integer
begtClient = UpdateCodeBlock -> Integer
begt UpdateCodeBlock
codeJson
  -- KEY: Last command, top command
  [Char]
cmd <- [Char] -> IO [Char]
redisGetLastCmd [Char]
keyLastCmd
  let upcodeblock :: CodeBlockReply
upcodeblock = CodeBlockReply :: [Char] -> [Char] -> [Char] -> Integer -> Integer -> CodeBlockReply
CodeBlockReply{$sel:ok:CodeBlockReply :: [Char]
ok = [Char]
"True", $sel:retcmd:CodeBlockReply :: [Char]
retcmd = [Char]
"add", $sel:retdata:CodeBlockReply :: [Char]
retdata = [Char]
cmd, $sel:retbegt:CodeBlockReply :: Integer
retbegt = Integer
begtClient, $sel:retendt:CodeBlockReply :: Integer
retendt = Integer
0}
  [Char]
randStr <- Integer -> Integer -> IO Integer
randomInteger Integer
100000 Integer
1000000 IO Integer -> (Integer -> IO [Char]) -> IO [Char]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Integer
x -> [Char] -> IO [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> IO [Char]) -> [Char] -> IO [Char]
forall a b. (a -> b) -> a -> b
$ Integer -> [Char]
intToString Integer
x
  
  let (Bool
isValid, [Char]
code') = [Char] -> [Char] -> (Bool, [Char])
validateFormat (ShowS
forall a. Typeable a => a -> [Char]
toStr [Char]
code) [Char]
randStr
  [Char] -> IO ()
forall (m :: * -> *) a. (MonadIO m, Show a) => a -> m ()
pre [Char]
code'
  if Bool
isValid
    then do
    Connection -> Integer -> Text -> IO ()
insertDatabaseNewCodeTable Connection
conn (UpdateCodeBlock -> Integer
pid UpdateCodeBlock
codeJson) ([Char] -> Text
forall a. Typeable a => a -> Text
toSText [Char]
code')
    -- if update ok, then send back "ok"
    [([[Char]], ([[Char]], Integer, Integer, Integer))]
newList <- Connection
-> IO [([[Char]], ([[Char]], Integer, Integer, Integer))]
readDatabaseCodeBlock Connection
conn 
    -- pre newList
    -- read the map out from ref
    -- conver all the keys to list of keyssnippetMap::[([String], [String])] -> IORef HMap -> IO ()
    -- rehash the map
    -- type HMap = M.HashMap String [[String]] 
    -- IORef HMap => ref
    [([[Char]], ([[Char]], Integer, Integer, Integer))]
-> IORef HMap2 -> IO ()
updatePrefixMap [([[Char]], ([[Char]], Integer, Integer, Integer))]
newList IORef HMap2
ref
    -- pre newList
    
    --   hmap <- readIORef ref 
    --   let keys = M.keys hmap
    --   modifyIORef ref (mapClear2 keys)
    --   listToPrefixMap newList ref
    Response -> IO ResponseReceived
response (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ CodeBlockReply -> Response
forall a. ToJSON a => a -> Response
responseJSON CodeBlockReply
upcodeblock
  else do
    [Char] -> IO ()
putStrLn [Char]
"ERROR: Invalid file format"
    let upcodeblock' :: CodeBlockReply
upcodeblock' = [Char] -> CodeBlockReply -> CodeBlockReply
updateOk [Char]
"False" CodeBlockReply
upcodeblock
    Response -> IO ResponseReceived
response (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ CodeBlockReply -> Response
forall a. ToJSON a => a -> Response
responseJSON CodeBlockReply
upcodeblock'


data EditorCode = EditorCode{
  EditorCode -> Integer
editorbeg::Integer,
  EditorCode -> Integer
editorend::Integer,
  EditorCode -> [Char]
editorfile::String,
  EditorCode -> [Char]
editorcmd::String,
  EditorCode -> [Char]
editorcode::String,
  EditorCode -> [Char]
editortheme::String,
  EditorCode -> [Char]
editormode::String
  } deriving ((forall x. EditorCode -> Rep EditorCode x)
-> (forall x. Rep EditorCode x -> EditorCode) -> Generic EditorCode
forall x. Rep EditorCode x -> EditorCode
forall x. EditorCode -> Rep EditorCode x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep EditorCode x -> EditorCode
$cfrom :: forall x. EditorCode -> Rep EditorCode x
Generic, Int -> EditorCode -> ShowS
[EditorCode] -> ShowS
EditorCode -> [Char]
(Int -> EditorCode -> ShowS)
-> (EditorCode -> [Char])
-> ([EditorCode] -> ShowS)
-> Show EditorCode
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [EditorCode] -> ShowS
$cshowList :: [EditorCode] -> ShowS
show :: EditorCode -> [Char]
$cshow :: EditorCode -> [Char]
showsPrec :: Int -> EditorCode -> ShowS
$cshowsPrec :: Int -> EditorCode -> ShowS
Show)

instance DA.FromJSON EditorCode
instance DA.ToJSON EditorCode where
    toEncoding :: EditorCode -> Encoding
toEncoding = Options -> EditorCode -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
DA.genericToEncoding Options
DA.defaultOptions
      
data EditorCodeReply = EditorCodeReply{
  EditorCodeReply -> Integer
replybeg::Integer,
  EditorCodeReply -> Integer
replyend::Integer,
  EditorCodeReply -> [Char]
ret::String,
  EditorCodeReply -> [Char]
replydata::String,
  EditorCodeReply -> [Char]
replyfname::String,
  EditorCodeReply -> [Char]
replytheme::String,
  EditorCodeReply -> [Char]
replymode::String
  } deriving ((forall x. EditorCodeReply -> Rep EditorCodeReply x)
-> (forall x. Rep EditorCodeReply x -> EditorCodeReply)
-> Generic EditorCodeReply
forall x. Rep EditorCodeReply x -> EditorCodeReply
forall x. EditorCodeReply -> Rep EditorCodeReply x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep EditorCodeReply x -> EditorCodeReply
$cfrom :: forall x. EditorCodeReply -> Rep EditorCodeReply x
Generic, Int -> EditorCodeReply -> ShowS
[EditorCodeReply] -> ShowS
EditorCodeReply -> [Char]
(Int -> EditorCodeReply -> ShowS)
-> (EditorCodeReply -> [Char])
-> ([EditorCodeReply] -> ShowS)
-> Show EditorCodeReply
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [EditorCodeReply] -> ShowS
$cshowList :: [EditorCodeReply] -> ShowS
show :: EditorCodeReply -> [Char]
$cshow :: EditorCodeReply -> [Char]
showsPrec :: Int -> EditorCodeReply -> ShowS
$cshowsPrec :: Int -> EditorCodeReply -> ShowS
Show)

instance DA.FromJSON   EditorCodeReply
instance DA.ToJSON     EditorCodeReply where
    toEncoding :: EditorCodeReply -> Encoding
toEncoding = Options -> EditorCodeReply -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
DA.genericToEncoding Options
DA.defaultOptions

-- Lens implementation for EditorCodeReply
type MyLens a b = (a -> b, b -> a -> a)

-- BEG12 ret => field
getRet::EditorCodeReply -> String
getRet :: EditorCodeReply -> [Char]
getRet EditorCodeReply
rd = EditorCodeReply -> [Char]
ret EditorCodeReply
rd

setRet::String -> EditorCodeReply -> EditorCodeReply
setRet :: [Char] -> EditorCodeReply -> EditorCodeReply
setRet [Char]
s EditorCodeReply
rd = EditorCodeReply
rd {$sel:ret:EditorCodeReply :: [Char]
ret = [Char]
s}

getReplytheme::EditorCodeReply -> String
getReplytheme :: EditorCodeReply -> [Char]
getReplytheme EditorCodeReply
rd = EditorCodeReply -> [Char]
replytheme EditorCodeReply
rd

setReplytheme::String -> EditorCodeReply -> EditorCodeReply
setReplytheme :: [Char] -> EditorCodeReply -> EditorCodeReply
setReplytheme [Char]
s EditorCodeReply
rd = EditorCodeReply
rd {$sel:replytheme:EditorCodeReply :: [Char]
replytheme = [Char]
s}
-- END12

              
getL :: MyLens a b -> a -> b
getL :: MyLens a b -> a -> b
getL (a -> b
g, b -> a -> a
_) = a -> b
g  -- getL (g, _) a = g a

setL :: MyLens a b -> b -> a -> a
setL :: MyLens a b -> b -> a -> a
setL (a -> b
_, b -> a -> a
h) = b -> a -> a
h  --  setL (_, h) b a = h b a

modL :: MyLens a b -> (b -> b) -> a -> a
modL :: MyLens a b -> (b -> b) -> a -> a
modL MyLens a b
l b -> b
f a
a = MyLens a b -> b -> a -> a
forall a b. MyLens a b -> b -> a -> a
setL MyLens a b
l (b -> b
f (MyLens a b -> a -> b
forall a b. MyLens a b -> a -> b
getL MyLens a b
l a
a)) a
a

ret'::MyLens EditorCodeReply String
ret' :: MyLens EditorCodeReply [Char]
ret' = (EditorCodeReply -> [Char]
getRet, [Char] -> EditorCodeReply -> EditorCodeReply
setRet)

replytheme'::MyLens EditorCodeReply String
replytheme' :: MyLens EditorCodeReply [Char]
replytheme' = (EditorCodeReply -> [Char]
getReplytheme, [Char] -> EditorCodeReply -> EditorCodeReply
setReplytheme)
       
-- (^.)::a -> MyLens a b -> b
-- a ^. l = getL l a

(^=)::MyLens a b -> b -> a -> a
(MyLens a b
l ^= :: MyLens a b -> b -> a -> a
^= b
b) a
a = MyLens a b -> b -> a -> a
forall a b. MyLens a b -> b -> a -> a
setL MyLens a b
l b
b a
a  -- (^=) = setL
       
       
                
-- instance Default EditorCodeReply where
--   def = EditorCodeReply 0 0 "" "" ""
      

data ProcLatex = ProcLatex {ProcLatex -> [Char]
x1cmd :: String,
                            ProcLatex -> [[Char]]
x1opt :: [String],
                            ProcLatex -> [Char]
x1cwd :: String} deriving (Int -> ProcLatex -> ShowS
[ProcLatex] -> ShowS
ProcLatex -> [Char]
(Int -> ProcLatex -> ShowS)
-> (ProcLatex -> [Char])
-> ([ProcLatex] -> ShowS)
-> Show ProcLatex
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [ProcLatex] -> ShowS
$cshowList :: [ProcLatex] -> ShowS
show :: ProcLatex -> [Char]
$cshow :: ProcLatex -> [Char]
showsPrec :: Int -> ProcLatex -> ShowS
$cshowsPrec :: Int -> ProcLatex -> ShowS
Show)

myloop::String -> IO Int
myloop :: [Char] -> IO Int
myloop [Char]
f = do
      [Char] -> IO ()
putStrLn [Char]
"loop it"
      [Char] -> IO Bool
fExist [Char]
f IO Bool -> (Bool -> IO Int) -> IO Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
b -> if Bool
b then Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
1 else [Char] -> IO Int
myloop [Char]
f            

loopDelay::Int -> String -> IO Int
loopDelay :: Int -> [Char] -> IO Int
loopDelay Int
max [Char]
f = do
      Int -> IO ()
threadDelay Int
1000000
      [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"max=" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
max
      if Int
max Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
8000000 then Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
0
        else [Char] -> IO Bool
fExist [Char]
f IO Bool -> (Bool -> IO Int) -> IO Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
b -> if Bool
b then Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
1 else Int -> [Char] -> IO Int
loopDelay (Int
max Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1000000) [Char]
f            

{-|

                               
                                 
                          ↓       ↓        ↓         ↓
-}
runOnExternalProgram :: String -> Int -> String -> FilePath -> IO (Either String String)
runOnExternalProgram :: [Char] -> Int -> [Char] -> [Char] -> IO (Either [Char] [Char])
runOnExternalProgram [Char]
pdflatex Int
n [Char]
fLatexName [Char]
outdir = 
    -- convert the input to a parameter of the external program
    let x :: [Char]
x = Int -> [Char]
forall a. Show a => a -> [Char]
show (Int -> [Char]) -> Int -> [Char]
forall a b. (a -> b) -> a -> b
$ Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
12
        -- TODO: pass as argument
        -- pdflatex = "/usr/local/texlive/2021/bin/universal-darwin/pdflatex"
    -- bracketOnError:: IO a -> (a -> IO b) -> (a -> IO c) -> IO c
    in IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
-> ((Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
    -> IO ExitCode)
-> ((Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
    -> IO (Either [Char] [Char]))
-> IO (Either [Char] [Char])
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracketOnError
        -- (createProcess (proc "ls" []){std_in = CreatePipe
                                         -- ,std_out = CreatePipe
                                         -- ,std_err = Inherit})
        -- (createProcess (proc "/opt/local/bin/pdflatex" ["-output-directory", outdir, fLatexName </> "latex.tex"]){ cwd = Just fLatexName
        (CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess ([Char] -> [[Char]] -> CreateProcess
proc [Char]
pdflatex [[Char]
"-halt-on-error", [Char]
"-output-directory", [Char]
outdir,  [Char]
fLatexName]){ cwd :: Maybe [Char]
cwd = [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just (ShowS
dropName [Char]
fLatexName)
                                                    ,std_in :: StdStream
std_in = StdStream
CreatePipe
                                                    ,std_out :: StdStream
std_out = StdStream
CreatePipe
                                                    ,std_err :: StdStream
std_err = StdStream
Inherit})
        (\(Just Handle
inh, Just Handle
outh, Maybe Handle
_, ProcessHandle
pid) -> ProcessHandle -> IO ()
terminateProcess ProcessHandle
pid IO () -> IO ExitCode -> IO ExitCode
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
pid)
        (\(Just Handle
inh, Just Handle
outh, Maybe Handle
_, ProcessHandle
pid) -> do

          -- fork a thread to consume output
          -- http://neilmitchell.blogspot.com/2012/06/flavours-of-mvar_04.html
          -- let loop f = do
                -- putStrLn "loop it"
                -- fExist f >>= \b -> if b then return 1 else loop f            
          [Char] -> IO ()
mkdir ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
outdir [Char] -> ShowS
</> [Char]
"myaaa"
          Integer
now <- IO Integer
timeNowSecond
          [Char] -> [[Char]] -> IO ()
writeFileListAppend [Char]
"/tmp/f.x" [[Char]
"mkdir=>" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Integer -> [Char]
forall a. Show a => a -> [Char]
show Integer
now]
          let lo :: Bool -> Bool
lo Bool
bo = if Bool
bo then Bool
bo else Bool -> Bool
lo Bool
bo    
          [Char]
output <- Handle -> IO [Char]
hGetContents Handle
outh
          MVar Int
outMVar <- IO (MVar Int)
forall a. IO (MVar a)
newEmptyMVar
          -- forkIO $ evaluate (
            -- len ("a"::String)
            -- length output
            -- lo True
            -- myloop "/tmp/file.x" >>= \x -> return x
            --- length output
            -- ) >>= putMVar outMVar
          
          IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ IO Int -> IO (IO Int)
forall a. a -> IO a
evaluate (
            do
            Int
n <- Int -> [Char] -> IO Int
loopDelay Int
1000000 [Char]
fLatexName
            -- let ln = len output
            -- putMVar outMVar (n + ln)
            Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
n
            -- lo True
            -- myloop "/tmp/file.x" >>= \x -> return x
            --- length output
            ) IO (IO Int) -> (IO Int -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \IO Int
x -> IO Int
x IO Int -> (Int -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MVar Int -> Int -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar Int
outMVar
          
          -- no input in this case
          Handle -> IO ()
hClose Handle
inh

          -- KEY: thread block, polling, wait on output, blocking until there is value in outMVar
          MVar Int -> IO Int
forall a. MVar a -> IO a
takeMVar MVar Int
outMVar
          Integer
now <- IO Integer
timeNowSecond
          [[Char]] -> IO ()
logFileG [[Char]
"after takeMVar=>" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Integer -> [Char]
forall a. Show a => a -> [Char]
show Integer
now]  -- write to $glog
          -- hClose outh

          -- wait for process
          ExitCode
ex <- ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
pid

          case ExitCode
ex of
            ExitCode
ExitSuccess -> do
              -- convert the output as needed
              let verboseAnswer :: [Char]
verboseAnswer = [Char]
"External program answered: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
output
              -- return verboseAnswer
              Either [Char] [Char] -> IO (Either [Char] [Char])
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [Char] [Char] -> IO (Either [Char] [Char]))
-> Either [Char] [Char] -> IO (Either [Char] [Char])
forall a b. (a -> b) -> a -> b
$ [Char] -> Either [Char] [Char]
forall a b. b -> Either a b
Right [Char]
verboseAnswer
            ExitFailure Int
r -> do
              -- ioError (mkIOError OtherError ("spawned process exit: " ++ show r) Nothing Nothing) )
              [[Char]] -> IO ()
logFileG [[Char]
"ERROR: runOnExternalProgram: Compile error =>" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
output]  -- write to $glog
              Either [Char] [Char] -> IO (Either [Char] [Char])
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [Char] [Char] -> IO (Either [Char] [Char]))
-> Either [Char] [Char] -> IO (Either [Char] [Char])
forall a b. (a -> b) -> a -> b
$ [Char] -> Either [Char] [Char]
forall a b. a -> Either a b
Left ([Char]
"ERROR: spawned process exit: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
r [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"runOnExternalProgram: Latex Compile ERROR: output=>" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
output))


data LatexFilePath = LatexFilePath{LatexFilePath -> [Char]
xHtmlPath::String, LatexFilePath -> [Char]
xLatexPath::String, LatexFilePath -> [Char]
xPDFPath::String} deriving ((forall x. LatexFilePath -> Rep LatexFilePath x)
-> (forall x. Rep LatexFilePath x -> LatexFilePath)
-> Generic LatexFilePath
forall x. Rep LatexFilePath x -> LatexFilePath
forall x. LatexFilePath -> Rep LatexFilePath x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LatexFilePath x -> LatexFilePath
$cfrom :: forall x. LatexFilePath -> Rep LatexFilePath x
Generic, Int -> LatexFilePath -> ShowS
[LatexFilePath] -> ShowS
LatexFilePath -> [Char]
(Int -> LatexFilePath -> ShowS)
-> (LatexFilePath -> [Char])
-> ([LatexFilePath] -> ShowS)
-> Show LatexFilePath
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [LatexFilePath] -> ShowS
$cshowList :: [LatexFilePath] -> ShowS
show :: LatexFilePath -> [Char]
$cshow :: LatexFilePath -> [Char]
showsPrec :: Int -> LatexFilePath -> ShowS
$cshowsPrec :: Int -> LatexFilePath -> ShowS
Show)

randomName::IO String
randomName :: IO [Char]
randomName = ([Char] -> ShowS
forall a. [a] -> [a] -> [a]
(++) [Char]
"try") ShowS -> IO [Char] -> IO [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> [Char]
forall a. Show a => a -> [Char]
show (Int -> [Char]) -> IO Int -> IO [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Int -> IO Int
randomInt Int
100000 Int
1000000)

--               HTML    PDF    JSON  file
data EFileType = EHTML | EPDF | EJSON

{-|
   KEY:

   TODO: add root directory config file?

   @
   configFile = "./config.txt"
   data EFileType = EHTML | EPDF | EJSON
   @
-}
datadirFull::String -> EFileType ->IO String
datadirFull :: [Char] -> EFileType -> IO [Char]
datadirFull [Char]
tryRandom EFileType
ftype = do
  HashMap [Char] [Char]
osMap <- [Char] -> IO (HashMap [Char] [Char])
confMap [Char]
configFile                           -- config.txt
  [Char]
home <- [Char] -> IO [Char]
getEnv [Char]
"HOME"
  let rootdir :: [Char]
rootdir      = [Char] -> HashMap [Char] [Char] -> [Char]
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> a
lookupJust [Char]
"rootdir" HashMap [Char] [Char]
osMap         -- "myfile/mybin/haskellwebapp2Bin"
  let datadirlatex :: [Char]
datadirlatex = [Char] -> HashMap [Char] [Char] -> [Char]
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> a
lookupJust [Char]
"datadirlatex" HashMap [Char] [Char]
osMap    -- "src/datadir/latex"
  let fullPath :: [Char]
fullPath = [Char]
home [Char] -> ShowS
</> [Char]
rootdir [Char] -> ShowS
</> [Char]
datadirlatex
  let ext :: [Char]
ext = case EFileType
ftype of
        EFileType
EHTML -> [Char]
".html"
        EFileType
EPDF  -> [Char]
".pdf"
        EFileType
EJSON -> [Char]
".json"
  [Char] -> IO [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> IO [Char]) -> [Char] -> IO [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
fullPath [Char] -> ShowS
</> [Char]
tryRandom [Char] -> ShowS
</> [Char]
tryRandom [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
ext  -- src/datadir/latex/try1515


{-|
 KEY: todo end point, todo app
-}
todoPostJSON::Connection -> IORef HMap2 -> Application
todoPostJSON :: Connection -> IORef HMap2 -> Application
todoPostJSON Connection
conn IORef HMap2
ref Request
req Response -> IO ResponseReceived
response = do
  [Char]
tmpfile <- [Char] -> IO [Char]
getEnv [Char]
"mytmp"
  ByteString
str <- Request -> IO ByteString
getRequestBodyChunk Request
req
  let may :: Maybe TodoItem
may = (ByteString -> Maybe TodoItem
forall a. FromJSON a => ByteString -> Maybe a
DA.decode (ByteString -> Maybe TodoItem)
-> (ByteString -> ByteString) -> ByteString -> Maybe TodoItem
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
forall a. Typeable a => a -> ByteString
toLBS) ByteString
str :: Maybe TodoItem
  Maybe TodoItem -> IO ()
forall (m :: * -> *) a. (MonadIO m, Show a) => a -> m ()
pre Maybe TodoItem
may
  let todo :: TodoItem
todo = case Maybe TodoItem
may of 
        (Just TodoItem
x) -> TodoItem
x 
        Maybe TodoItem
_        -> TodoItem :: Int64 -> Text -> Text -> TodoItem
TodoItem{$sel:todoId:TodoItem :: Int64
todoId = Int64
0, $sel:keyItem:TodoItem :: Text
keyItem = Text
"keyx", $sel:todoItem:TodoItem :: Text
todoItem = Text
"todoItem1"} 
  TodoItem -> IO ()
forall (m :: * -> *) a. (MonadIO m, Show a) => a -> m ()
pre TodoItem
todo
  let todoId' :: Int64
todoId'     = TodoItem -> Int64
todoId TodoItem
todo
  let keyItem' :: Text
keyItem'    = TodoItem -> Text
keyItem TodoItem
todo
  let todoItem' :: Text
todoItem'   = TodoItem -> Text
todoItem TodoItem
todo
  let errorSText :: Text
errorSText  = [Char] -> Text
forall a. Typeable a => a -> Text
toSText ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"ERROR: Invalid cmd:" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"ERR"
  let todoReply :: TodoReply
todoReply = TodoReply :: Text -> TodoReply
TodoReply{
                    $sel:cmdReply:TodoReply :: Text
cmdReply = Text
"From TodoReply"
                  } 

  -- execute_ conn "CREATE TABLE IF NOT EXISTS todoApp (id INTEGER PRIMARY KEY AUTOINCREMENT, keyItem TEXT, todoItem TEXT)"
  Connection -> Query -> (Text, Text) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
execute Connection
conn Query
"INSERT INTO todoApp (key_item, todo_item) VALUES (?,?)" ( Text
keyItem', Text
todoItem')
  -- execute conn Query{fromQuery = s2Text "INSERT INTO todoApp (key_item, todo_item) VALUES (?,?)"} (keyItem', todoItem')
  Response -> IO ResponseReceived
response (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ TodoReply -> Response
forall a. ToJSON a => a -> Response
responseJSON TodoReply
todoReply

{-|
click on "compile"
 goto aronlib.js
  getElementsById("editor")
   get latex source code
    form JSON object => "compile"
                     => latex source code
    send to Server

 Server Side:
  ("editordata") ->
             receiveEditorData
                decode JSON object
                 => "compile"
                 => latex source code
                  => write latex source code to file $b/"latex.tex"
                  => pass path $b/latex.tex to
                       runOnExternalProgram
                         pdflatex compile latex.tex
                          => latex.pdf
       Either (String String) <= return from runOnExternalProgram

       Response to Client side in JSON
       => ret => "True" => Compile => OK
          ret => "False" => Compile => Error
          => On Client side aronlib.js
             => If ret == "True"
                  
           
-}
receiveEditorData::Connection -> IORef HMap2 -> IORef PDFMap -> Application
receiveEditorData :: Connection
-> IORef HMap2 -> IORef (HashMap [Char] [Char]) -> Application
receiveEditorData Connection
conn IORef HMap2
ref IORef (HashMap [Char] [Char])
pdfMapRef Request
req Response -> IO ResponseReceived
response = do
  ByteString
str <- Request -> IO ByteString
getRequestBodyChunk Request
req
  let may :: Maybe EditorCode
may = (ByteString -> Maybe EditorCode
forall a. FromJSON a => ByteString -> Maybe a
DA.decode (ByteString -> Maybe EditorCode)
-> (ByteString -> ByteString) -> ByteString -> Maybe EditorCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
forall a. Typeable a => a -> ByteString
toLBS) ByteString
str :: Maybe EditorCode
  [Char] -> IO ()
fw [Char]
"Receive data:"
  Maybe EditorCode -> IO ()
forall (m :: * -> *) a. (MonadIO m, Show a) => a -> m ()
pre Maybe EditorCode
may
  let codeJson :: EditorCode
codeJson = case Maybe EditorCode
may of 
        (Just EditorCode
x) -> EditorCode
x 
        Maybe EditorCode
_        -> EditorCode :: Integer
-> Integer
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> EditorCode
EditorCode{$sel:editorbeg:EditorCode :: Integer
editorbeg = Integer
0, $sel:editorend:EditorCode :: Integer
editorend = Integer
0, $sel:editorfile:EditorCode :: [Char]
editorfile = [Char]
"", $sel:editorcmd:EditorCode :: [Char]
editorcmd = [Char]
"", $sel:editorcode:EditorCode :: [Char]
editorcode = [Char]
"no data from editor", $sel:editortheme:EditorCode :: [Char]
editortheme = [Char]
"", $sel:editormode:EditorCode :: [Char]
editormode = [Char]
""} 
  [Char] -> IO ()
fw [Char]
"codeJson"
  EditorCode -> IO ()
forall (m :: * -> *) a. (MonadIO m, Show a) => a -> m ()
pre EditorCode
codeJson
  let editBeg :: Integer
editBeg   = EditorCode -> Integer
editorbeg   EditorCode
codeJson                                               
  let editEnd :: Integer
editEnd   = EditorCode -> Integer
editorend   EditorCode
codeJson                                               
  let editFile :: [Char]
editFile  = EditorCode -> [Char]
editorfile  EditorCode
codeJson -- editorfile => "try919591.pdf"
  let editCmd :: [Char]
editCmd   = EditorCode -> [Char]
editorcmd   EditorCode
codeJson -- editorcmd  => "compile" or "save"
  let editCode :: [Char]
editCode  = EditorCode -> [Char]
editorcode  EditorCode
codeJson -- editorcode  => "latex source code" 
  let editTheme :: [Char]
editTheme = EditorCode -> [Char]
editortheme EditorCode
codeJson                                               
  let editMode :: [Char]
editMode  = EditorCode -> [Char]
editormode  EditorCode
codeJson                                               

  let ls :: [[Char]]
ls = [Char] -> [Char] -> [[Char]]
splitStrChar [Char]
"[/]" [Char]
editMode

  -- if len ls == 0 then error "Error: editormode codeJson" else do
  --  logFile2 "/tmp/x.x" ["show codeJson"]
  HashMap [Char] [Char]
osMap <- [Char] -> IO (HashMap [Char] [Char])
confMap [Char]
configFile
  let datadirlatex :: [Char]
datadirlatex = [Char] -> HashMap [Char] [Char] -> [Char]
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> a
lookupJust [Char]
"datadirlatex" HashMap [Char] [Char]
osMap   -- "src/datadir/latex"
  
  [Char]
mathPath <- [Char] -> IO [Char]
getEnv [Char]
"m"
  [Char]
fullrootdir <- IO [Char]
getRootDirFull
  
  [Char]
pdflatex <- [Char] -> IO [Char]
whichGetPath [Char]
"pdflatex"
  
  [Char]
ran <- IO [Char]
randomName -- try919591

  if [Char]
editCmd [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"save" then do
    Int -> IO ()
threadDelay Int
1000000
    -- ran <- randomName -- try919591

    -- IF user input from browser "Save", then use input name
    --  ELSE use random name => ranTexFile
    [[Char]] -> IO ()
logFileG [[Char]
"editFile =>" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
editFile]  -- write to $glog
    let tryRandom :: [Char]
tryRandom = if (Bool -> Bool
not (Bool -> Bool) -> ([Char] -> Bool) -> [Char] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) [Char]
editFile then ShowS
dropExt [Char]
editFile else [Char]
ran
        
    --  flatexFile = bitbucket/math/try919591.tex
    let flatexFile :: [Char]
flatexFile =  [Char]
mathPath [Char] -> ShowS
</> [Char]
tryRandom [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
".tex"
    [Char] -> [Char] -> IO ()
writeFile [Char]
flatexFile [Char]
editCode
        
    --  outdirSave = haskellwebapp2/src/datadir/latex/try919591
    let outdirSave :: [Char]
outdirSave = [Char]
fullrootdir [Char] -> ShowS
</> [Char]
datadirlatex [Char] -> ShowS
</> [Char]
tryRandom
    [Char] -> IO ()
mkdir ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
datadirlatex [Char] -> ShowS
</> [Char]
tryRandom

    [Char]
htmlFile <- [Char] -> EFileType -> IO [Char]
datadirFull [Char]
tryRandom EFileType
EHTML  -- "src/datadir/latex/try919591/try919591{.html, .pdf...}
    -- generate (random key, fileName.html, randomLatex.tex)
    [Char] -> [Char] -> IO ()
copyFile ([Char]
fullrootdir [Char] -> ShowS
</> [Char]
indexEditorHTML) [Char]
htmlFile

    -- LIO.writeFile "/tmp/json.json" (encodeToLazyText codeJson)
    
    [[Char]] -> IO ()
logFileG [[Char]
"copy " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++  ([Char]
fullrootdir [Char] -> ShowS
</> [Char]
indexEditorHTML) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" => " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
htmlFile] -- write to "/tmp/x.x"
    [Char] -> IO ()
forall (m :: * -> *) a. (MonadIO m, Show a) => a -> m ()
pre [Char]
htmlFile

    

    -- TODO: FIXME: \\ => \
    -- ls <- readFileListStrict htmlFile
    -- let ss = splitListWhen (\x -> (trim x) == "replace123" ) ls
    -- let ln = lines editCode  -- it seems to me lines ESCAPE \\ to \\\\ ?
    -- -- let ln = map(\x -> dropEnd 1 $ drop 1 $ show x) $ lines editCode
    -- let repls = (head ss) ++ ln ++ (last ss)
    -- writeFileList htmlFile repls

    -- replaceFileLineEscapeStrict htmlFile "replace123" editCode
    [Char] -> [Char] -> [Char] -> IO ()
replaceFileLineNoRegex [Char]
htmlFile [Char]
hiddenLATEXCODE [Char]
editCode
      
    -- replaceFileWithStr "replace123" editCode htmlFile
    let pdfName :: [Char]
pdfName = ShowS
dropExt (ShowS
takeName [Char]
htmlFile) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
".pdf"
    let hiddenHtml :: [Char]
hiddenHtml = [r|<input  type="hidden" id='idlatex' name="myname" value="|] [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
pdfName [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [r|" /> |]
    let hiddenPDF :: [Char]
hiddenPDF = [r|<a href="|] [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
pdfName [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [r|" onclick='promptPDFName()'>PDF</a> |]
    -- replaceFileWithStr "hidden123" hiddenHtml htmlFile
    -- KEY: video http://xfido.com/song/haskellwebapp2_help.mp4 
    let hiddenCompileOrSave :: [Char]
hiddenCompileOrSave = [r|<input  type="hidden" id='compilesaveID' name="compilesave" value="|] [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
"savepage" [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [r|" /> |]
    [CSSPro] -> [Char] -> IO ()
replaceFileListWord [([Char]
"hidden123", [Char]
hiddenHtml), ([Char]
"hidden444", [Char]
hiddenPDF), ([Char]
hiddenCOMPILESAVE, [Char]
hiddenCompileOrSave)] [Char]
htmlFile
    -- TODO: Fixed use random number => random file name
    -- TODO:           random number => user input name
    -- modifyIORef pdfMapRef $ M.insert ran ran
    -- modifyIORef pdfMapRef $ M.insert ran tryRandom
    IORef (HashMap [Char] [Char])
-> (HashMap [Char] [Char] -> HashMap [Char] [Char]) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef (HashMap [Char] [Char])
pdfMapRef ((HashMap [Char] [Char] -> HashMap [Char] [Char]) -> IO ())
-> (HashMap [Char] [Char] -> HashMap [Char] [Char]) -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> HashMap [Char] [Char] -> HashMap [Char] [Char]
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
M.insert [Char]
tryRandom [Char]
tryRandom
    [Char] -> [Char] -> IO ()
redisSet [Char]
tryRandom [Char]
tryRandom
    [Char] -> IO ()
mkdir [Char]
outdirSave
    [[Char]] -> IO ()
logFileG [[Char]
"mkdir => " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
outdirSave]
    [Char]
hostURI <- IO [Char]
getHostName  -- http://xfido.com or localhost
    let replyURL :: [Char]
replyURL = [Char]
hostURI [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"/aceeditor?id=" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
tryRandom
    let upcodeblock :: EditorCodeReply
upcodeblock = EditorCodeReply :: Integer
-> Integer
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> EditorCodeReply
EditorCodeReply{$sel:replybeg:EditorCodeReply :: Integer
replybeg = Integer
editBeg, $sel:replyend:EditorCodeReply :: Integer
replyend = Integer
editEnd, $sel:ret:EditorCodeReply :: [Char]
ret = [Char]
"True", $sel:replydata:EditorCodeReply :: [Char]
replydata = [Char]
replyURL, $sel:replyfname:EditorCodeReply :: [Char]
replyfname = ShowS
takeName [Char]
flatexFile, $sel:replytheme:EditorCodeReply :: [Char]
replytheme = [Char]
"", $sel:replymode:EditorCodeReply :: [Char]
replymode = [Char]
""}
    -- Compile math/try919591.tex => outdirSave = src/latex/datadir/try919591/{try919591.pdf, try919591.log try919591.aux}
        
    -- FIXME: if file is Javascript, then the line can be ignored

    Maybe (Either [Char] [Char])
mayei <- Int
-> IO (Either [Char] [Char]) -> IO (Maybe (Either [Char] [Char]))
forall a. Int -> IO a -> IO (Maybe a)
timeout (Int
5Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
1000000) (IO (Either [Char] [Char]) -> IO (Maybe (Either [Char] [Char])))
-> IO (Either [Char] [Char]) -> IO (Maybe (Either [Char] [Char]))
forall a b. (a -> b) -> a -> b
$ [Char] -> Int -> [Char] -> [Char] -> IO (Either [Char] [Char])
runOnExternalProgram [Char]
pdflatex Int
3 [Char]
flatexFile [Char]
outdirSave
    case Maybe (Either [Char] [Char])
mayei of
        Just Either [Char] [Char]
ei -> case Either [Char] [Char]
ei of
                     Right [Char]
x -> do
                       [Char] -> IO ()
putStrLn [Char]
x
                       -- Save editor theme, mode, language
                       let jsonFile :: [Char]
jsonFile = [Char]
outdirSave [Char] -> ShowS
</> [Char]
tryRandom [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
".json"
                       [Char] -> Text -> IO ()
LIO.writeFile [Char]
jsonFile (EditorCode -> Text
forall a. ToJSON a => a -> Text
encodeToLazyText EditorCode
codeJson)
                       -- response $ responsePDF $ dropExtension flatexFile ++ ".pdf"
                       -- hostURI <- getHostName  -- http://xfido.com or localhost
                       -- let replyURL = hostURI ++ "/aceeditor?id=" ++ ran
                       -- let replyURL = hostURI ++ "/aceeditor?id=" ++ tryRandom
                       -- logFile2 "/tmp/x.x" [tryRandom]
                       -- let upcodeblock = EditorCodeReply{replybeg = editBeg, replyend = editEnd, ret = "True", replydata = replyURL, replyfname = takeName flatexFile, replytheme = "", replymode = ""}
                       Response -> IO ResponseReceived
response (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ EditorCodeReply -> Response
forall a. ToJSON a => a -> Response
responseJSON EditorCodeReply
upcodeblock
                     Left  [Char]
e -> do
                       [Char] -> IO ()
putStrLn [Char]
e
                       -- let upcodeblock = EditorCodeReply{replybeg = editBeg, replyend = editEnd, ret = "False", replydata = "save => Error", replyfname = takeName flatexFile}
                       let upcodeblock' :: EditorCodeReply
upcodeblock' = (MyLens EditorCodeReply [Char]
ret' MyLens EditorCodeReply [Char]
-> [Char] -> EditorCodeReply -> EditorCodeReply
forall a b. MyLens a b -> b -> a -> a
^= [Char]
"False") EditorCodeReply
upcodeblock
                       Response -> IO ResponseReceived
response (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ EditorCodeReply -> Response
forall a. ToJSON a => a -> Response
responseJSON EditorCodeReply
upcodeblock'
        Maybe (Either [Char] [Char])
Nothing -> do
          let upcodeblock' :: EditorCodeReply
upcodeblock' = (MyLens EditorCodeReply [Char]
ret' MyLens EditorCodeReply [Char]
-> [Char] -> EditorCodeReply -> EditorCodeReply
forall a b. MyLens a b -> b -> a -> a
^= [Char]
"False") EditorCodeReply
upcodeblock
          Response -> IO ResponseReceived
response (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ EditorCodeReply -> Response
forall a. ToJSON a => a -> Response
responseJSON EditorCodeReply
upcodeblock'
          -- ↑
          -- - - response = (Response -> IO ResponseReceived)
    
  else if [Char]
editCmd [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"compile" then do
    [Char]
bitbucket <- [Char] -> IO [Char]
getEnv [Char]
"b"
    [Char]
mathPath <- [Char] -> IO [Char]
getEnv [Char]
"m"
    -- let latexFile = "latex.tex"
    let latexName :: [Char]
latexName = ShowS
dropExt [Char]
editFile
    [[Char]] -> IO ()
logFileG [[Char]
editFile]  -- write to $glog
    [[Char]] -> IO ()
logFileG [[Char]
latexName] -- write to $glog
    let latexFile :: [Char]
latexFile = if (Bool -> Bool
not (Bool -> Bool) -> ([Char] -> Bool) -> [Char] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) [Char]
editFile then [Char]
latexName [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
".tex" else ShowS
forall a. HasCallStack => [Char] -> a
error [Char]
"editorfile => editFile CAN NOT BE EMPTY"
    let flatexFile :: [Char]
flatexFile = [Char]
mathPath [Char] -> ShowS
</> [Char]
latexFile
    [Char] -> [Char] -> IO ()
writeFile [Char]
flatexFile [Char]
editCode
    IO ()
fl
    [Char] -> IO ()
forall (m :: * -> *) a. (MonadIO m, Show a) => a -> m ()
pre [Char]
flatexFile
    IO ()
fl
    [Char] -> IO ()
forall (m :: * -> *) a. (MonadIO m, Show a) => a -> m ()
pre [Char]
editCode

    -- 
    -- file:///Users/aaa/myfile/bitbucket/image/4Tile.svg
    --
    -- runOnExternalProgram::Int -> String -> FilePath -> IO (Either String String)
    --                                                               ↑
    --                    ↓-------------------------------------------
    -- timeout::Int -> IO a -> IO (Maybe a)
    --                      => IO Maybe (Either String String)
    -- TODO: here
    let outdirCompile :: [Char]
outdirCompile = [Char]
fullrootdir [Char] -> ShowS
</> [Char]
datadirlatex [Char] -> ShowS
</> [Char]
latexName
    [Char] -> IO ()
mkdir [Char]
outdirCompile
    let upcodeblock :: EditorCodeReply
upcodeblock = EditorCodeReply :: Integer
-> Integer
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> EditorCodeReply
EditorCodeReply{$sel:replybeg:EditorCodeReply :: Integer
replybeg = Integer
editBeg, $sel:replyend:EditorCodeReply :: Integer
replyend = Integer
editEnd, $sel:ret:EditorCodeReply :: [Char]
ret = [Char]
"True", $sel:replydata:EditorCodeReply :: [Char]
replydata = [Char]
"compile => OK", $sel:replyfname:EditorCodeReply :: [Char]
replyfname = ShowS
takeName [Char]
flatexFile, $sel:replytheme:EditorCodeReply :: [Char]
replytheme = [Char]
"", $sel:replymode:EditorCodeReply :: [Char]
replymode = [Char]
""}
    [[Char]] -> IO ()
logFileG [[Char]
outdirCompile] -- write to $glog
    Maybe (Either [Char] [Char])
mayei <- let sec :: Int
sec = Int
1000000 in Int
-> IO (Either [Char] [Char]) -> IO (Maybe (Either [Char] [Char]))
forall a. Int -> IO a -> IO (Maybe a)
timeout (Int
5Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
sec) (IO (Either [Char] [Char]) -> IO (Maybe (Either [Char] [Char])))
-> IO (Either [Char] [Char]) -> IO (Maybe (Either [Char] [Char]))
forall a b. (a -> b) -> a -> b
$ [Char] -> Int -> [Char] -> [Char] -> IO (Either [Char] [Char])
runOnExternalProgram [Char]
pdflatex Int
3 [Char]
flatexFile [Char]
outdirCompile
    case Maybe (Either [Char] [Char])
mayei of
        Just Either [Char] [Char]
ei -> case Either [Char] [Char]
ei of
                     Right [Char]
x -> do
                       [Char] -> IO ()
putStrLn [Char]
x
                       HashMap [Char] [Char]
osMap <- [Char] -> IO (HashMap [Char] [Char])
confMap [Char]
configFile
                       let datadirlatex :: [Char]
datadirlatex = [Char] -> HashMap [Char] [Char] -> [Char]
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> a
lookupJust [Char]
"datadirlatex" HashMap [Char] [Char]
osMap   -- "src/datadir/latex"

                       -- jsonFile <- datadirFull latexName EJSON
                       -- json <- jsonToRecord jsonFile :: IO (Maybe EditorCodeReply)
                       -- pre json
                       -- let upcodeblock = EditorCodeReply{replybeg = editBeg, replyend = editEnd, ret = "True", replydata = "compile => OK", replyfname = takeName flatexFile, replytheme = "", replymode = ""}
                       Response -> IO ResponseReceived
response (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ EditorCodeReply -> Response
forall a. ToJSON a => a -> Response
responseJSON EditorCodeReply
upcodeblock
                     Left  [Char]
e -> do
                       [Char] -> IO ()
putStrLn [Char]
e
                       let upcodeblock' :: EditorCodeReply
upcodeblock' = (MyLens EditorCodeReply [Char]
ret' MyLens EditorCodeReply [Char]
-> [Char] -> EditorCodeReply -> EditorCodeReply
forall a b. MyLens a b -> b -> a -> a
^= [Char]
"False") EditorCodeReply
upcodeblock
                       Response -> IO ResponseReceived
response (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ EditorCodeReply -> Response
forall a. ToJSON a => a -> Response
responseJSON EditorCodeReply
upcodeblock'
        Maybe (Either [Char] [Char])
Nothing -> do
                     -- let upcodeblock = EditorCodeReply{replybeg = editBeg, replyend = editEnd, ret = "False", replydata = "mayei => Nothing", replyfname = takeName flatexFile, replytheme = "", replymode = ""}
                     let upcodeblock' :: EditorCodeReply
upcodeblock' = (MyLens EditorCodeReply [Char]
ret' MyLens EditorCodeReply [Char]
-> [Char] -> EditorCodeReply -> EditorCodeReply
forall a b. MyLens a b -> b -> a -> a
^= [Char]
"False") EditorCodeReply
upcodeblock
                     Response -> IO ResponseReceived
response (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ EditorCodeReply -> Response
forall a. ToJSON a => a -> Response
responseJSON EditorCodeReply
upcodeblock'
  else do
    let upcodeblock :: EditorCodeReply
upcodeblock = EditorCodeReply :: Integer
-> Integer
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> EditorCodeReply
EditorCodeReply{$sel:replybeg:EditorCodeReply :: Integer
replybeg   = Integer
editBeg,
                                      $sel:replyend:EditorCodeReply :: Integer
replyend   = Integer
editEnd,
                                      $sel:ret:EditorCodeReply :: [Char]
ret        = [Char]
"False",
                                      $sel:replydata:EditorCodeReply :: [Char]
replydata  = [Char]
editCmd [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" : compile or save. Unknown option",
                                      $sel:replyfname:EditorCodeReply :: [Char]
replyfname = [Char]
"",
                                      $sel:replytheme:EditorCodeReply :: [Char]
replytheme = [Char]
"",
                                      $sel:replymode:EditorCodeReply :: [Char]
replymode  = [Char]
""}
    Response -> IO ResponseReceived
response (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ EditorCodeReply -> Response
forall a. ToJSON a => a -> Response
responseJSON EditorCodeReply
upcodeblock


-- read postMatrix.html and replace osname with osName=Dawin, Linux, FreeBSD whatever it is
-- 
respondMatrix::Connection -> IORef HMap2 -> Application
respondMatrix :: Connection -> IORef HMap2 -> Application
respondMatrix Connection
_ IORef HMap2
_ Request
req Response -> IO ResponseReceived
response = do
              ByteString
str <- Request -> IO ByteString
getRequestBodyChunk Request
req
              [[Char]]
ls <- [Char] -> IO [[Char]]
runCmd [Char]
"uname"
              let osName :: [Char]
osName = if [[Char]] -> Integer
forall (t :: * -> *) b a. (Foldable t, Num b) => t a -> b
len [[Char]]
ls Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0 then [[Char]] -> [Char]
forall a. [a] -> a
head [[Char]]
ls else []
              ByteString
bs <- [Char] -> ByteString -> ByteString -> IO ByteString
readFileRepPat [Char]
"postMatrix.html" ByteString
"osname" (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ [Char] -> ByteString
forall a. Typeable a => a -> ByteString
toSBS [Char]
osName
              ByteString -> IO ()
forall (m :: * -> *) a. (MonadIO m, Show a) => a -> m ()
pre ByteString
bs
              -- https://hackage.haskell.org/package/bytestring-0.11.0.0/docs/Data-ByteString-Builder.html
              -- byteString :: ByteString -> Data.ByteString.Builder
              -- https://hackage.haskell.org/package/wai-3.2.2.1/docs/Network-Wai.html
              Response -> IO ResponseReceived
response (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ Status -> ResponseHeaders -> ByteString -> Response
responseLBS
                Status
status200
                [(HeaderName
"Content-Type", ByteString
"text/html")]
                (ByteString -> ByteString
forall a. Typeable a => a -> ByteString
toLBS ByteString
bs)

            -- Nothing -> response $ responseLBS
            -- status400
            -- [("Content-Type", "text/plain; charset=utf-8")]
            -- "No file parameter found"

{-|              
data CommandService = CommandService{cmdServ::String, paramArg::String, inputData::String} deriving (Generic, Show)
instance DA.FromJSON CommandService
instance DA.ToJSON CommandService where
    toEncoding = DA.genericToEncoding DA.defaultOptions
-}
      
{-|
    === KEY: support services from outside browser
    @
    case 1:
       cmdStr = "alignment"
       cmdParam = "="

       a = b
        c  =d
       e = f
         ⇓
       a = b
       c = d
       e = f

    case 2: use space as delimter
       cmdStr = "alignment"
       cmdParam = ""

       a  b
        c  d
       e  f
         ⇓
       a b
       c d
       e f

     Emacs Copy Selected Region
          |
          ↓
     Write to $b/tmp/x.x
          |
          ↓
     Read $b/tmp/x.x
     Http Request => [Send Json]
     $sym/RequestJson  alignment
          |
          ↓
     commandService [Receive Json]
          |
          + → alignment ($b/tmp/x.x inside)
          |
          + → alignmentstr -p kk   (Use pipe instead of file)
          |
          + → commentCode ($b/tmp/x.x inside)
          |
          + → uncommentcode ($b/tmp/x.x inside)
          ↓
     runSh above cmd
          |
          ↓
     Capture STDOUT => Json => ReplyCode{...stdoutx=stdout}
          |
          ↓
     Response JSON ReplyCode{...stdoutx=stdout}

    bitbucket/tmp/x.x , NOT /tmp/x.x
    Store all the code to be processed: alignment, alignmentstr, commentCode, uncommentcode

    @



-}
commandService::Connection -> IORef HMap2 -> Application
commandService :: Connection -> IORef HMap2 -> Application
commandService Connection
conn IORef HMap2
ref Request
req Response -> IO ResponseReceived
response = do
  [Char]
tmpfile <- [Char] -> IO [Char]
getEnv [Char]
"mytmp"
  let cmdAlignment :: [Char]
cmdAlignment     = [Char]
"alignment"    
  let cmdAlignmentStr :: [Char]
cmdAlignmentStr  = [Char]
"alignmentstr" 
  let cmdCommentCode :: [Char]
cmdCommentCode   = [Char]
"commentcode"  
  let cmdUncommentCode :: [Char]
cmdUncommentCode = [Char]
"uncommentcode"
  ByteString
str <- Request -> IO ByteString
getRequestBodyChunk Request
req
  let may :: Maybe CommandService
may = (ByteString -> Maybe CommandService
forall a. FromJSON a => ByteString -> Maybe a
DA.decode (ByteString -> Maybe CommandService)
-> (ByteString -> ByteString) -> ByteString -> Maybe CommandService
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
forall a. Typeable a => a -> ByteString
toLBS) ByteString
str :: Maybe CommandService
  [Char] -> IO ()
fw [Char]
"may"
  Maybe CommandService -> IO ()
forall (m :: * -> *) a. (MonadIO m, Show a) => a -> m ()
pre Maybe CommandService
may
  let cmdService :: CommandService
cmdService = case Maybe CommandService
may of 
        (Just CommandService
x) -> CommandService
x 
        Maybe CommandService
_        -> CommandService :: [Char] -> [Char] -> [Char] -> CommandService
CommandService{$sel:cmdServ:CommandService :: [Char]
cmdServ = [Char]
"", $sel:paramArg:CommandService :: [Char]
paramArg=[Char]
"", $sel:inputData:CommandService :: [Char]
inputData=[Char]
"no data3344"} 
  [Char] -> IO ()
fw [Char]
"cmdService"
  CommandService -> IO ()
forall (m :: * -> *) a. (MonadIO m, Show a) => a -> m ()
pre CommandService
cmdService
  let cmd :: [Char]
cmd      = CommandService -> [Char]
cmdServ   CommandService
cmdService
  let paramArgx :: [Char]
paramArgx = CommandService -> [Char]
paramArg  CommandService
cmdService
  [[Char]] -> IO ()
logFileG [ShowS
forall a. Typeable a => a -> [Char]
toStr [Char]
paramArgx]

  -- Use "=" if paramArgx is empty 
  let delimiter :: [Char]
delimiter = ([Char] -> Integer
forall (t :: * -> *) b a. (Foldable t, Num b) => t a -> b
len ([Char] -> Integer) -> [Char] -> Integer
forall a b. (a -> b) -> a -> b
$ ShowS
trim [Char]
paramArgx) Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 Bool -> [Char] -> ShowS
forall a. Bool -> a -> a -> a
? [Char]
"=" ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ [Char]
paramArgx
  
  [Char] -> IO ()
forall a. Show a => a -> IO ()
pp ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"paramArgx=" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
paramArgx
  let strData :: [Char]
strData  = CommandService -> [Char]
inputData CommandService
cmdService
  let upcodeblock :: CodeBlockReply
upcodeblock = CodeBlockReply :: [Char] -> [Char] -> [Char] -> Integer -> Integer -> CodeBlockReply
CodeBlockReply{$sel:ok:CodeBlockReply :: [Char]
ok = [Char]
"False", $sel:retcmd:CodeBlockReply :: [Char]
retcmd = [Char]
"", $sel:retdata:CodeBlockReply :: [Char]
retdata = [Char]
"", $sel:retbegt:CodeBlockReply :: Integer
retbegt = Integer
0, $sel:retendt:CodeBlockReply :: Integer
retendt = Integer
0}
  CommandService -> IO ()
forall (m :: * -> *) a. (MonadIO m, Show a) => a -> m ()
pre CommandService
cmdService

  if | [Char]
cmd [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
cmdAlignment   -> do
       -- TODO: use tmpfile as argument
       -- let cmdStr = "Alignment.sh"::String
       -- (e2, so, si2) <- runSh $ toSText (if paramArgx == "" then cmdStr else (???)[cmdStr, paramArgx])
       -- if e2 == ExitSuccess then let rcode = ReplyCode{rcmd="", rerror = si2, stdoutx=so} 
                            -- in response $ responseJSON rcode
       -- else do
           -- let upcodeblock' = updateRetcmd ("runSh " + cmdStr) upcodeblock
           -- response $ responseJSON upcodeblock'

       (Maybe Handle
mayOut, ExitCode
exitCode) <- [Char] -> [[Char]] -> [Char] -> IO (Maybe Handle, ExitCode)
createProcessPipeData [Char]
"Alignment.sh" [[Char]
"-p", [Char]
delimiter] (ShowS
forall a. Typeable a => a -> [Char]
toStr [Char]
strData)
       if ExitCode
exitCode ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
== ExitCode
ExitSuccess
       then do
            Text
stdoutData <- case Maybe Handle
mayOut of
                        Just Handle
hout -> Handle -> IO Text
TIO.hGetContents Handle
hout IO Text -> (Text -> IO Text) -> IO Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return
                        Maybe Handle
Nothing   -> Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
""
            [[Char]] -> IO ()
logFileG [[Char]
"stdoutx=" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ (Text -> [Char]
forall a. Typeable a => a -> [Char]
toStr Text
stdoutData)]
            let rcode :: ReplyCode
rcode = ReplyCode :: Text -> Text -> Text -> ReplyCode
ReplyCode{$sel:rcmd:ReplyCode :: Text
rcmd=Text
"", $sel:rerror:ReplyCode :: Text
rerror = [Char] -> Text
forall a. Typeable a => a -> Text
toSText ([Char]
""::String), $sel:stdoutx:ReplyCode :: Text
stdoutx=Text
stdoutData} 
              in Response -> IO ResponseReceived
response (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ ReplyCode -> Response
forall a. ToJSON a => a -> Response
responseJSON ReplyCode
rcode
       else do
           [[Char]] -> IO ()
logFileG [[Char]
"ERROR: exitFailure:" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
cmdAlignment]
           let upcodeblock' :: CodeBlockReply
upcodeblock' = [Char] -> CodeBlockReply -> CodeBlockReply
updateRetcmd [Char]
"Alignment.sh -p =" CodeBlockReply
upcodeblock
           Response -> IO ResponseReceived
response (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ CodeBlockReply -> Response
forall a. ToJSON a => a -> Response
responseJSON CodeBlockReply
upcodeblock'



     | [Char]
cmd [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
cmdAlignmentStr -> do
       [[Char]] -> IO ()
logFileG [[Char]
"cmd=" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
cmd]
       -- TODO: use pipe as stdin
       -- alignmentStr -f /tmp/f.x
       -- alignmentStr -p kk  <-- pipe as stdin, kk is dummy var. Not Used for Now
       (Maybe Handle
mayOut, ExitCode
exitCode) <- [Char] -> [[Char]] -> [Char] -> IO (Maybe Handle, ExitCode)
createProcessPipeData [Char]
"alignmentStr" [[Char]
"-p", [Char]
"kk"] (ShowS
forall a. Typeable a => a -> [Char]
toStr [Char]
strData)
       if ExitCode
exitCode ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
== ExitCode
ExitSuccess
       then do
            Text
stdoutData <- case Maybe Handle
mayOut of
                        Just Handle
hout -> Handle -> IO Text
TIO.hGetContents Handle
hout IO Text -> (Text -> IO Text) -> IO Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return
                        Maybe Handle
Nothing   -> Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
""
            [[Char]] -> IO ()
logFileG [[Char]
"stdoutx=" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ (Text -> [Char]
forall a. Typeable a => a -> [Char]
toStr Text
stdoutData)]
            let rcode :: ReplyCode
rcode = ReplyCode :: Text -> Text -> Text -> ReplyCode
ReplyCode{$sel:rcmd:ReplyCode :: Text
rcmd=Text
"", $sel:rerror:ReplyCode :: Text
rerror = [Char] -> Text
forall a. Typeable a => a -> Text
toSText ([Char]
""::String), $sel:stdoutx:ReplyCode :: Text
stdoutx=Text
stdoutData} 
              in Response -> IO ResponseReceived
response (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ ReplyCode -> Response
forall a. ToJSON a => a -> Response
responseJSON ReplyCode
rcode
       else do
           [[Char]] -> IO ()
logFileG [[Char]
"ERROR WaiLib.hs: exitFailure:"[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
cmdAlignmentStr]
           let upcodeblock' :: CodeBlockReply
upcodeblock' = [Char] -> CodeBlockReply -> CodeBlockReply
updateRetcmd [Char]
"alignmentStr -p kk" CodeBlockReply
upcodeblock
           Response -> IO ResponseReceived
response (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ CodeBlockReply -> Response
forall a. ToJSON a => a -> Response
responseJSON CodeBlockReply
upcodeblock'

     | [Char]
cmd [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
cmdCommentCode -> do
       -- SEE: $j/CommentCode.java for "-p"
       (Maybe Handle
mayOut, ExitCode
exitCode) <- [Char] -> [[Char]] -> [Char] -> IO (Maybe Handle, ExitCode)
createProcessPipeData [Char]
"CommentCode.sh" [[Char]
"-p", [Char]
paramArgx] (ShowS
forall a. Typeable a => a -> [Char]
toStr [Char]
strData)
       if ExitCode
exitCode ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
== ExitCode
ExitSuccess
       then do
            Text
stdoutData <- case Maybe Handle
mayOut of
                        Just Handle
hout -> Handle -> IO Text
TIO.hGetContents Handle
hout IO Text -> (Text -> IO Text) -> IO Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return
                        Maybe Handle
Nothing   -> Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
""
            [[Char]] -> IO ()
logFileG [[Char]
"From WaiLib.hs => stdoutx=" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ (Text -> [Char]
forall a. Typeable a => a -> [Char]
toStr Text
stdoutData)]
            let rcode :: ReplyCode
rcode = ReplyCode :: Text -> Text -> Text -> ReplyCode
ReplyCode{$sel:rcmd:ReplyCode :: Text
rcmd=Text
"", $sel:rerror:ReplyCode :: Text
rerror = [Char] -> Text
forall a. Typeable a => a -> Text
toSText ([Char]
""::String), $sel:stdoutx:ReplyCode :: Text
stdoutx=Text
stdoutData} 
              in Response -> IO ResponseReceived
response (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ ReplyCode -> Response
forall a. ToJSON a => a -> Response
responseJSON ReplyCode
rcode
       else do
           [[Char]] -> IO ()
logFileG [[Char]
"ERROR WaiLib.hs: exitFailure:" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
cmdCommentCode]
           let upcodeblock' :: CodeBlockReply
upcodeblock' = [Char] -> CodeBlockReply -> CodeBlockReply
updateRetcmd [Char]
"CommentCode.sh -p =" CodeBlockReply
upcodeblock
           Response -> IO ResponseReceived
response (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ CodeBlockReply -> Response
forall a. ToJSON a => a -> Response
responseJSON CodeBlockReply
upcodeblock'



       -- TODO: use tmpfile as argument
       -- let cmdStr = "CommentCode.sh"::String
       -- (e2, so, si2) <- runSh $ toSText (if paramArgx == "" then cmdStr else cmdStr + " " + paramArgx)
       -- if e2 == ExitSuccess then let rcode = ReplyCode{rcmd="", rerror = si2, stdoutx=so} 
                            -- in response $ responseJSON rcode
       -- else do
           -- let upcodeblock' = updateRetcmd ("runSh " + cmdStr) upcodeblock
           -- response $ responseJSON upcodeblock'

     | [Char]
cmd [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
cmdUncommentCode -> do
       (Maybe Handle
mayOut, ExitCode
exitCode) <- [Char] -> [[Char]] -> [Char] -> IO (Maybe Handle, ExitCode)
createProcessPipeData [Char]
"UncommentCode.sh" [[Char]
"-p", [Char]
paramArgx] (ShowS
forall a. Typeable a => a -> [Char]
toStr [Char]
strData)
       if ExitCode
exitCode ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
== ExitCode
ExitSuccess
       then do
            Text
stdoutData <- case Maybe Handle
mayOut of
                        Just Handle
hout -> Handle -> IO Text
TIO.hGetContents Handle
hout IO Text -> (Text -> IO Text) -> IO Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return
                        Maybe Handle
Nothing   -> Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
""
            [[Char]] -> IO ()
logFileG [[Char]
"stdoutx=" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ (Text -> [Char]
forall a. Typeable a => a -> [Char]
toStr Text
stdoutData)]
            let rcode :: ReplyCode
rcode = ReplyCode :: Text -> Text -> Text -> ReplyCode
ReplyCode{$sel:rcmd:ReplyCode :: Text
rcmd=Text
"", $sel:rerror:ReplyCode :: Text
rerror = [Char] -> Text
forall a. Typeable a => a -> Text
toSText ([Char]
""::String), $sel:stdoutx:ReplyCode :: Text
stdoutx=Text
stdoutData} 
              in Response -> IO ResponseReceived
response (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ ReplyCode -> Response
forall a. ToJSON a => a -> Response
responseJSON ReplyCode
rcode
       else do
           [[Char]] -> IO ()
logFileG [[Char]
"ERROR: exitFailure:" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
cmdUncommentCode]
           let upcodeblock' :: CodeBlockReply
upcodeblock' = [Char] -> CodeBlockReply -> CodeBlockReply
updateRetcmd [Char]
"UncommentCode.sh -p =" CodeBlockReply
upcodeblock
           Response -> IO ResponseReceived
response (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ CodeBlockReply -> Response
forall a. ToJSON a => a -> Response
responseJSON CodeBlockReply
upcodeblock'


       -- TODO: use tmpfile as argument
       -- let cmdStr = "UncommentCode.sh"::String
       -- (e2, so, si2) <- runSh $ toSText (if paramArgx == "" then cmdStr else cmdStr + " " + paramArgx)
       -- if e2 == ExitSuccess then let rcode = ReplyCode{rcmd="", rerror = si2, stdoutx=so} 
                            -- in response $ responseJSON rcode
       -- else do
           -- let upcodeblock' = updateRetcmd ("runSh " + cmdStr) upcodeblock
           -- response $ responseJSON upcodeblock'


     | Bool
otherwise             -> do
       let errorSText :: Text
errorSText = [Char] -> Text
forall a. Typeable a => a -> Text
toSText ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"ERROR: Invalid cmd:" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
+ [Char]
cmd
       let rcode :: ReplyCode
rcode = ReplyCode :: Text -> Text -> Text -> ReplyCode
ReplyCode{$sel:rcmd:ReplyCode :: Text
rcmd=Text
"", $sel:rerror:ReplyCode :: Text
rerror = Text
errorSText , $sel:stdoutx:ReplyCode :: Text
stdoutx = Text
errorSText} 
       Response -> IO ResponseReceived
response (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ ReplyCode -> Response
forall a. ToJSON a => a -> Response
responseJSON ReplyCode
rcode
  where
    + :: [a] -> [a] -> [a]
(+) = [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
(++)
    ∈ :: [[Char]] -> [Char]
(∈) [[Char]]
cx = [[Char]] -> ShowS
concatStr [[Char]]
cx [Char]
" "
    concatSPC :: [[Char]] -> [Char]
concatSPC [[Char]]
cx = [[Char]] -> ShowS
concatStr [[Char]]
cx [Char]
" "
      
 
deleteCodeBlock::Connection -> IORef HMap2 -> Application
deleteCodeBlock :: Connection -> IORef HMap2 -> Application
deleteCodeBlock Connection
conn IORef HMap2
ref Request
req Response -> IO ResponseReceived
response = do
  ByteString
str <- Request -> IO ByteString
getRequestBodyChunk Request
req
  let may :: Maybe UpdateCodeBlockX
may = (ByteString -> Maybe UpdateCodeBlockX
forall a. FromJSON a => ByteString -> Maybe a
DA.decode (ByteString -> Maybe UpdateCodeBlockX)
-> (ByteString -> ByteString)
-> ByteString
-> Maybe UpdateCodeBlockX
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
forall a. Typeable a => a -> ByteString
toLBS) ByteString
str :: Maybe UpdateCodeBlockX
  [Char] -> IO ()
fw [Char]
"may"
  Maybe UpdateCodeBlockX -> IO ()
forall (m :: * -> *) a. (MonadIO m, Show a) => a -> m ()
pre Maybe UpdateCodeBlockX
may
  let codeJson :: UpdateCodeBlockX
codeJson = case Maybe UpdateCodeBlockX
may of 
        (Just UpdateCodeBlockX
x) -> UpdateCodeBlockX
x 
        Maybe UpdateCodeBlockX
_        -> UpdateCodeBlockX :: Integer
-> [Integer] -> [Char] -> Integer -> Integer -> UpdateCodeBlockX
UpdateCodeBlockX{$sel:pidx:UpdateCodeBlockX :: Integer
pidx = Integer
0, $sel:pidlistx:UpdateCodeBlockX :: [Integer]
pidlistx = [], $sel:newcodex:UpdateCodeBlockX :: [Char]
newcodex =[Char]
"no code deleteCodeBlock", $sel:begtx:UpdateCodeBlockX :: Integer
begtx = Integer
0, $sel:endtx:UpdateCodeBlockX :: Integer
endtx = Integer
0} 
  [Char] -> IO ()
fw [Char]
"deleteCodeBlock"
  UpdateCodeBlockX -> IO ()
forall (m :: * -> *) a. (MonadIO m, Show a) => a -> m ()
pre UpdateCodeBlockX
codeJson
  Connection -> [Integer] -> Text -> IO ()
deleteDatabaseNewCodeTable Connection
conn (UpdateCodeBlockX -> [Integer]
pidlistx UpdateCodeBlockX
codeJson) ([Char] -> Text
forall a. Typeable a => a -> Text
toSText ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ UpdateCodeBlockX -> [Char]
newcodex UpdateCodeBlockX
codeJson)
  -- if update ok, then send back "ok"

  [Char]
cmd <- [Char] -> IO [Char]
redisGetLastCmd [Char]
keyLastCmd
  let begtClient :: Integer
begtClient = UpdateCodeBlockX -> Integer
begtx UpdateCodeBlockX
codeJson
  let upcodeblock :: CodeBlockReply
upcodeblock = CodeBlockReply :: [Char] -> [Char] -> [Char] -> Integer -> Integer -> CodeBlockReply
CodeBlockReply{$sel:ok:CodeBlockReply :: [Char]
ok = [Char]
"True", $sel:retcmd:CodeBlockReply :: [Char]
retcmd=[Char]
"delete", $sel:retdata:CodeBlockReply :: [Char]
retdata = [Char]
cmd, $sel:retbegt:CodeBlockReply :: Integer
retbegt = Integer
begtClient, $sel:retendt:CodeBlockReply :: Integer
retendt = Integer
0}
  [([[Char]], ([[Char]], Integer, Integer, Integer))]
newList <- Connection
-> IO [([[Char]], ([[Char]], Integer, Integer, Integer))]
readDatabaseCodeBlock Connection
conn 
  -- pre newList
  -- read the map out from ref
  -- conver all the keys to list of keyssnippetMap::[([String], [String])] -> IORef HMap -> IO ()
  -- rehash the map
  -- type HMap = M.HashMap String [[String]] 
  -- IORef HMap => ref
  [([[Char]], ([[Char]], Integer, Integer, Integer))]
-> IORef HMap2 -> IO ()
updatePrefixMap [([[Char]], ([[Char]], Integer, Integer, Integer))]
newList IORef HMap2
ref
    
  --   hmap <- readIORef ref 
  --   let keys = M.keys hmap
  --   modifyIORef ref (mapClear2 keys)
  --   listToPrefixMap newList ref
  Response -> IO ResponseReceived
response (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ CodeBlockReply -> Response
forall a. ToJSON a => a -> Response
responseJSON CodeBlockReply
upcodeblock

  

{-|
   type HMap2 = M.HashMap String [([String], Integer)]
-}
updatePrefixMap::[([String], ([String], Integer, Integer, Integer))] -> IORef HMap2 -> IO()
updatePrefixMap :: [([[Char]], ([[Char]], Integer, Integer, Integer))]
-> IORef HMap2 -> IO ()
updatePrefixMap [([[Char]], ([[Char]], Integer, Integer, Integer))]
ls IORef HMap2
ref = do
  HMap2
hmap <- IORef HMap2 -> IO HMap2
forall a. IORef a -> IO a
readIORef IORef HMap2
ref
  let keys :: [[Char]]
keys = HMap2 -> [[Char]]
forall k v. HashMap k v -> [k]
M.keys HMap2
hmap
  -- delete all keys from ref => IORef HMap2
  [[Char]] -> IO ()
logFileG [[Char]
"  11 updatePrefixMap"]
  IORef HMap2 -> (HMap2 -> HMap2) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef HMap2
ref ([[Char]] -> HMap2 -> HMap2
mapClear2 [[Char]]
keys)
  [[Char]] -> IO ()
logFileG [[Char]
"  12 updatePrefixMap"]
  [([[Char]], ([[Char]], Integer, Integer, Integer))]
-> IORef HMap2 -> IO ()
listToPrefixMap [([[Char]], ([[Char]], Integer, Integer, Integer))]
ls IORef HMap2
ref
  [[Char]] -> IO ()
logFileG [[Char]
"  13 updatePrefixMap"]
  () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

    
splitWhenTwo::(a -> Bool) -> [a] -> ([a], [a])
splitWhenTwo :: (a -> Bool) -> [a] -> ([a], [a])
splitWhenTwo a -> Bool
f [a]
cs = ((a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not (Bool -> Bool) -> (a -> Bool) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Bool
f) [a]
cs, (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Bool -> Bool
not (Bool -> Bool) -> (a -> Bool) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Bool
f) [a]
cs)
             
{-|
    === redis get, redis set, background color, color

    @
    Redis color/background DB
    HTMLPre.color:#333333
    HTMLPre.background:#AAAAAA
    @

    'getPreStyle'

    @
     [txtColor, bgColor]
     =>
     [
         ( "color"
         , "#8c9172"
         )
     ,
         ( "background-color"
         , "#3c6358"
         )
     ]
    @

-}
getPreStyle::IO [(String, String)]
getPreStyle :: IO [CSSPro]
getPreStyle = do
        let keyTxtColor :: [Char]
keyTxtColor = [Char]
"color"
        CSSPro
txtColor <- [Char] -> IO CSSPro
redisGetPre [Char]
keyTxtColor
        let keyBgColor :: [Char]
keyBgColor = [Char]
"background-color"
        CSSPro
bgColor <- [Char] -> IO CSSPro
redisGetPre [Char]
keyBgColor
        [CSSPro] -> IO [CSSPro]
forall (m :: * -> *) a. Monad m => a -> m a
return [CSSPro
txtColor, CSSPro
bgColor]
 where
   redisGetPre :: [Char] -> IO CSSPro
redisGetPre [Char]
k = do
                   let key :: [Char]
key = [Char]
pre [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
k
                   Maybe [Char]
may <- [Char] -> IO (Maybe [Char])
redisGet [Char]
key  -- key = "HTMLPre.color", "HTMLPre.background"
                   let color :: CSSPro
color = case Maybe [Char]
may of
                                 Just [Char]
x -> let ls :: [[Char]]
ls = (Char -> Bool) -> [Char] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [[a]]
splitWhen (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':') [Char]
x in ([[Char]] -> [Char]
forall a. [a] -> a
head [[Char]]
ls, [[Char]] -> [Char]
forall a. [a] -> a
last [[Char]]
ls)
                                 Maybe [Char]
_      -> ([Char]
"#333333", [Char]
"#AAAAAA")
                   CSSPro -> IO CSSPro
forall (m :: * -> *) a. Monad m => a -> m a
return CSSPro
color
              where
                pre :: [Char]
pre = [Char]
"HTMLPre."
        
{-|
   === Update background color from user

   * See modifycolor.css  submitUpdateBackground

   * Receive background color from client and decode the JSON string

  src/mystyle.css
  pre {
    display: block;
    font-family: monospace;
    font-size: 14pt;
    white-space: pre;
    margin-top: 1px;
    /* margin-right: 1px; */
    margin-bottom: 1px;
    /* margin-left: 4px; */
    background: #6b695869;  <-- change color
    border-style: outset;
    border-width: thin;
  }

  data R1 = R1{name::String}
  data R2 = R2{name::String}

  data RR1 = RR1 Maybe R1
  data RR2 = RR2 Maybe R2

  @
    pre{color:#90996c;
       background-color:#000000;
    }
  @

  'getPreStyle'

  @
   ------------------------------------styleList-----------------------------------
   [
       ( "color"
       , "#8c9172"
       )
   ,
       ( "background-color"
       , "#3c6358"
       )
   ]
  @
-} 
updateBackground::Application 
updateBackground :: Application
updateBackground Request
req Response -> IO ResponseReceived
response = do
        ByteString
str <- Request -> IO ByteString
getRequestBodyChunk Request
req
        let may :: Maybe Bgcolor
may = (ByteString -> Maybe Bgcolor
forall a. FromJSON a => ByteString -> Maybe a
DA.decode (ByteString -> Maybe Bgcolor)
-> (ByteString -> ByteString) -> ByteString -> Maybe Bgcolor
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
forall a. Typeable a => a -> ByteString
toLBS) ByteString
str :: Maybe Bgcolor
        [Char] -> IO ()
fw [Char]
"updateBackground may"
        Maybe Bgcolor -> IO ()
forall (m :: * -> *) a. (MonadIO m, Show a) => a -> m ()
pre Maybe Bgcolor
may
        case Maybe Bgcolor
may of 
          (Just Bgcolor
x) -> if | [Char] -> [Char] -> Bool
hasPrefix [Char]
"color:" [Char]
str -> [Char] -> [Char] -> IO ()
redisSet ([Char]
prefix [Char] -> ShowS
forall a. [a] -> [a] -> [a]
+ [Char]
"color") [Char]
str  -- redisSet "HTMLPre.color" "#333"
                         | ([Char] -> [Char] -> Bool
hasPrefix [Char]
"background-color:" [Char]
str Bool -> Bool -> Bool
|| [Char] -> [Char] -> Bool
hasPrefix [Char]
"background:" [Char]
str) -> [Char] -> [Char] -> IO ()
redisSet ([Char]
prefix [Char] -> ShowS
forall a. [a] -> [a] -> [a]
+ [Char]
"background-color") [Char]
str  -- redisSet "HTMLPre.background-color" "#444"
                         | Bool
otherwise -> [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Invalid CSS Style=[" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
+ [Char]
str [Char] -> ShowS
forall a. [a] -> [a] -> [a]
+ [Char]
"]"
                   where
                     str :: [Char]
str = Text -> [Char]
forall a. Typeable a => a -> [Char]
toStr (Text -> [Char]) -> Text -> [Char]
forall a b. (a -> b) -> a -> b
$ Bgcolor -> Text
colorname Bgcolor
x
          Maybe Bgcolor
_        -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        [CSSPro]
styleList <- IO [CSSPro]
getPreStyle
        [Char] -> IO ()
fw [Char]
"styleList"
        [CSSPro] -> IO ()
forall (m :: * -> *) a. (MonadIO m, Show a) => a -> m ()
pre [CSSPro]
styleList
        let ls :: [[Char]]
ls = [CSSPro] -> [[Char]]
formCSS [CSSPro]
styleList
        [Char] -> IO ()
fw [Char]
"ls"
        [[Char]] -> IO ()
forall (m :: * -> *) a. (MonadIO m, Show a) => a -> m ()
pre [[Char]]
ls
        let bigstr :: [Char]
bigstr = [Char]
"pre{" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
+ [[Char]] -> [Char]
unlines [[Char]]
ls [Char] -> ShowS
forall a. [a] -> [a] -> [a]
+ [Char]
"}"
        -- let newcolor = [r| pre { background: |] <> colorname colorJson <> [r|;} |]
        [Char] -> Text -> IO ()
TIO.writeFile [Char]
cssfile ([Char] -> Text
forall a. Typeable a => a -> Text
toSText [Char]
bigstr)
        Response -> IO ResponseReceived
response (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ [Char] -> Response
responseCSS [Char]
cssfile
        -- response $ responseNothingBS "updateBackground nothing"
   where
     prefix :: [Char]
prefix = [Char]
"HTMLPre."
     formCSS :: [CSSPro] -> [[Char]]
formCSS [CSSPro]
ls = (CSSPro -> [Char]) -> [CSSPro] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map(\CSSPro
x -> (CSSPro -> [Char]
forall a b. (a, b) -> a
fst CSSPro
x) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
+ [Char]
":" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
+ (CSSPro -> [Char]
forall a b. (a, b) -> b
snd CSSPro
x) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
+ [Char]
";") [CSSPro]
ls
     cssfile :: [Char]
cssfile = [Char]
"src/css/modifycolor.css"
     + :: [a] -> [a] -> [a]
(+) = [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
(++)



{-|
	=== Update pre text color

	* Receive text color from client and decode the JSON string

        * See src/aronlib.js

        See 'updateBackground'

        NOT USED NOW
-}
updateTextColor::Application   
updateTextColor :: Application
updateTextColor Request
req Response -> IO ResponseReceived
response = do
        ByteString
str <- Request -> IO ByteString
getRequestBodyChunk Request
req
        -- data Textcolor = Textcolor = {textcolor :: TS.Text } deriving (Generic, Show)
        let may :: Maybe Textcolor
may = (ByteString -> Maybe Textcolor
forall a. FromJSON a => ByteString -> Maybe a
DA.decode (ByteString -> Maybe Textcolor)
-> (ByteString -> ByteString) -> ByteString -> Maybe Textcolor
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
forall a. Typeable a => a -> ByteString
toLBS) ByteString
str :: Maybe Textcolor
        [Char] -> IO ()
fw [Char]
"Maybe Textcolor"
        Maybe Textcolor -> IO ()
forall (m :: * -> *) a. (MonadIO m, Show a) => a -> m ()
pre Maybe Textcolor
may
        let colorJson :: Textcolor
colorJson = case Maybe Textcolor
may of 
                    (Just Textcolor
x) -> Textcolor
x 
                    Maybe Textcolor
_        -> Textcolor :: Text -> Textcolor
Textcolor{$sel:textcolor:Textcolor :: Text
textcolor = Text
""} 
        [Char] -> IO ()
fw [Char]
"Textcolor matJson"
        Textcolor -> IO ()
forall (m :: * -> *) a. (MonadIO m, Show a) => a -> m ()
pre Textcolor
colorJson
        [Char] -> [Char] -> IO ()
redisSet ([Char]
prefix [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"color") (Text -> [Char]
forall a. Typeable a => a -> [Char]
toStr (Text -> [Char]) -> Text -> [Char]
forall a b. (a -> b) -> a -> b
$ Textcolor -> Text
textcolor Textcolor
colorJson)
        [Char] -> IO ()
fw [Char]
"Textcolor response gbs"
        let newcolor :: Text
newcolor = [r| pre { color: |] Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Textcolor -> Text
textcolor Textcolor
colorJson Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [r|;} |]
        [Char] -> IO ()
fw [Char]
"newcolor"
        Text -> IO ()
forall (m :: * -> *) a. (MonadIO m, Show a) => a -> m ()
pre Text
newcolor
        [CSSPro]
style <- IO [CSSPro]
getPreStyle
        [Char] -> IO ()
fw [Char]
"style"
        [CSSPro] -> IO ()
forall (m :: * -> *) a. (MonadIO m, Show a) => a -> m ()
pre [CSSPro]
style
        if Text -> Bool
checkCSSColorFormat (Textcolor -> Text
textcolor Textcolor
colorJson) then [Char] -> Text -> IO ()
TIO.writeFile [Char]
"src/css/modifycolor.css" Text
newcolor else () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Response -> IO ResponseReceived
response (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ ByteString -> Response
responseNothingBS ByteString
"updateTextColor nothing"
   where
     prefix :: [Char]
prefix = [Char]
"HTMLPre."
                                                                                                            
-- checkCSSColorFormat::TS.Text -> Bool
-- checkCSSColorFormat s = TS.length s <= 7 && TS.head s == '#' && (isHexStr (toStr s'))
--     where 
--         s' = TS.drop 1 s
              
receiveCode::Application
receiveCode :: Application
receiveCode Request
req Response -> IO ResponseReceived
response = do 
        ByteString
str  <- Request -> IO ByteString
getRequestBodyChunk Request
req
        let may :: Maybe CompileCode
may = ByteString -> Maybe CompileCode
forall a. FromJSON a => ByteString -> Maybe a
DA.decode (ByteString -> Maybe CompileCode)
-> ByteString -> Maybe CompileCode
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
forall a. Typeable a => a -> ByteString
toLBS ByteString
str :: Maybe CompileCode 
        [Char] -> IO ()
fw [Char]
"may"
        Maybe CompileCode -> IO ()
forall a. Show a => a -> IO ()
print Maybe CompileCode
may
        let ccode :: CompileCode
ccode = case Maybe CompileCode
may of 
                       (Just CompileCode
x) -> CompileCode
x 
                       Maybe CompileCode
_       -> CompileCode :: Text -> Text -> Text -> CompileCode
CompileCode{$sel:compiler:CompileCode :: Text
compiler = Text
"", $sel:option:CompileCode :: Text
option = Text
"", $sel:code:CompileCode :: Text
code= Text
""} 
        [Char] -> IO ()
fw [Char]
"cool" 
        [Char] -> IO ()
fw [Char]
"cool" 
        let firstLine :: [Char]
firstLine = [[Char]] -> [Char]
forall a. [a] -> a
head ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> [[Char]]
lines ([Char] -> [[Char]]) -> [Char] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
forall a. Typeable a => a -> [Char]
toStr (CompileCode -> Text
code CompileCode
ccode)
        let lang :: [Char]
lang = [[Char]] -> [Char]
forall a. [a] -> a
last ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> [[Char]]
splitStr [Char]
"[[:space:]]+" [Char]
firstLine
        if | [Char]
lang [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"cpp" -> [Char] -> Text -> IO ()
TIO.writeFile [Char]
"/tmp/code.cpp" (CompileCode -> Text
code CompileCode
ccode)
           | [Char]
lang [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"haskell" -> [Char] -> Text -> IO ()
TIO.writeFile [Char]
"/tmp/code.hs" (CompileCode -> Text
code CompileCode
ccode)
           | Bool
otherwise -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return () 
        [Char] -> IO ()
forall a. Show a => a -> IO ()
pp [Char]
lang 
        let cmd :: [Char]
cmd = if | [Char]
lang [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"cpp" -> [Char]
"g++ -o out /tmp/code.cpp && ./out" :: String
                     | [Char]
lang [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"haskell" -> [Char]
"runh2 /tmp/code.hs && /tmp/code" :: String
                     | Bool
otherwise -> [Char]
"" :: String
        (ExitCode
e2, Text
so, Text
si2) <- Text -> IO (ExitCode, Text, Text)
runSh (Text -> IO (ExitCode, Text, Text))
-> Text -> IO (ExitCode, Text, Text)
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
forall a. Typeable a => a -> Text
toSText [Char]
cmd
        if ExitCode
e2 ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
/= ExitCode
ExitSuccess then let rcode :: ReplyCode
rcode = ReplyCode :: Text -> Text -> Text -> ReplyCode
ReplyCode{$sel:rcmd:ReplyCode :: Text
rcmd=Text
"", $sel:rerror:ReplyCode :: Text
rerror = Text
si2, $sel:stdoutx:ReplyCode :: Text
stdoutx=Text
si2} 
                                  in Response -> IO ResponseReceived
response (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ ReplyCode -> Response
forall a. ToJSON a => a -> Response
responseJSON ReplyCode
rcode 
        else do
            Text -> IO ()
forall a. Show a => a -> IO ()
pp Text
so     
            let replyCode :: ReplyCode
replyCode = ReplyCode :: Text -> Text -> Text -> ReplyCode
ReplyCode{$sel:rcmd:ReplyCode :: Text
rcmd=Text
"", $sel:rerror:ReplyCode :: Text
rerror=Text
"", $sel:stdoutx:ReplyCode :: Text
stdoutx= Text
so} 
            Response -> IO ResponseReceived
response (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ ReplyCode -> Response
forall a. ToJSON a => a -> Response
responseJSON ReplyCode
replyCode

-- NOT USED
receiveCode2::Application                                                                            
receiveCode2 :: Application
receiveCode2 Request
req Response -> IO ResponseReceived
response = do                                                                       
        ByteString
str <- Request -> IO ByteString
getRequestBodyChunk Request
req                                                                      
        let may :: Maybe CompileCode
may = ByteString -> Maybe CompileCode
forall a. FromJSON a => ByteString -> Maybe a
DA.decode (ByteString -> Maybe CompileCode)
-> ByteString -> Maybe CompileCode
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
forall a. Typeable a => a -> ByteString
toLBS ByteString
str :: Maybe CompileCode                                
        [Char] -> IO ()
fw [Char]
"may"                                                                                    
        Maybe CompileCode -> IO ()
forall a. Show a => a -> IO ()
print Maybe CompileCode
may                                                                                   
        let ccode :: CompileCode
ccode = case Maybe CompileCode
may of                                                                     
                       (Just CompileCode
x) -> CompileCode
x                                                                
                       Maybe CompileCode
_       -> CompileCode :: Text -> Text -> Text -> CompileCode
CompileCode{$sel:compiler:CompileCode :: Text
compiler = Text
"", $sel:option:CompileCode :: Text
option = Text
"", $sel:code:CompileCode :: Text
code= Text
""}                 
        [Char] -> IO ()
fw [Char]
"cool"                                                                                   
        [Char] -> IO ()
fw [Char]
"cool"                                                                                   
        let firstLine :: [Char]
firstLine = [[Char]] -> [Char]
forall a. [a] -> a
head ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> [[Char]]
lines ([Char] -> [[Char]]) -> [Char] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
forall a. Typeable a => a -> [Char]
toStr (CompileCode -> Text
code CompileCode
ccode)                                 
        let lang :: [Char]
lang = [[Char]] -> [Char]
forall a. [a] -> a
last ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> [[Char]]
splitStr [Char]
"[[:space:]]+" [Char]
firstLine                                         
        if | [Char]
lang [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"cpp" -> [Char] -> Text -> IO ()
TIO.writeFile [Char]
"./cppcode.cpp" (CompileCode -> Text
code CompileCode
ccode)                            
           | [Char]
lang [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"haskell" -> [Char] -> Text -> IO ()
TIO.writeFile [Char]
"./code.hs" (CompileCode -> Text
code CompileCode
ccode)                         
           | Bool
otherwise -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()                                                                 
        [Char] -> IO ()
forall a. Show a => a -> IO ()
pp [Char]
lang                                                                                     
        let cmd :: [Char]
cmd = if | [Char]
lang [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"cpp" -> [Char]
"g++ -o cppout ./cppcode.cpp && ./cppout"                         
                     | [Char]
lang [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"haskell" -> [Char]
"runh2 ./code.hs && /tmp/code"                       
                     | Bool
otherwise -> [Char]
""                                                              
        [[Char]]
sout <- [Char] -> IO [[Char]]
A.run [Char]
cmd                                              
        let rcode :: ReplyCode
rcode = ReplyCode :: Text -> Text -> Text -> ReplyCode
ReplyCode{$sel:rcmd:ReplyCode :: Text
rcmd=Text
"", $sel:rerror:ReplyCode :: Text
rerror = Text
"", $sel:stdoutx:ReplyCode :: Text
stdoutx= ([Char] -> Text
forall a. Typeable a => a -> Text
toSText ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
forall a. [a] -> a
head [[Char]]
sout)}          
        Response -> IO ResponseReceived
response (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ ReplyCode -> Response
forall a. ToJSON a => a -> Response
responseJSON ReplyCode
rcode




responseEditor:: Response
responseEditor :: Response
responseEditor = Status -> ResponseHeaders -> [Char] -> Maybe FilePart -> Response
responseFile
    Status
status200
    [(HeaderName
"Content-Type", ByteString
"text/html")]
    [Char]
"compileCode.html"
    Maybe FilePart
forall a. Maybe a
Nothing

{-|
   === response javacript file function

   * response aronlib.js to client
-} 
responseJavascript::FilePath -> Response
responseJavascript :: [Char] -> Response
responseJavascript [Char]
fname = Status -> ResponseHeaders -> [Char] -> Maybe FilePart -> Response
responseFile
  Status
status200
  [(HeaderName
hContentType, ByteString
"text/javascript")]
  [Char]
fname
  Maybe FilePart
forall a. Maybe a
Nothing

responseCSS::FilePath -> Response
responseCSS :: [Char] -> Response
responseCSS [Char]
fname = Status -> ResponseHeaders -> [Char] -> Maybe FilePart -> Response
responseFile
  Status
status200
  [(HeaderName
hContentType, ByteString
"text/css")]
  [Char]
fname
  Maybe FilePart
forall a. Maybe a
Nothing

  
{-|
   === KEY: response PDF file, send pdf file to client

   @
   pdfSent::BS.ByteString -> Response
   @
-} 
responsePDF::FilePath -> Response
responsePDF :: [Char] -> Response
responsePDF [Char]
fname = Status -> ResponseHeaders -> [Char] -> Maybe FilePart -> Response
responseFile
  Status
status200
  [(HeaderName
hContentType, ByteString
"application/pdf"),
   (HeaderName
hContentDisposition, ByteString
"inline;filename=" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> [Char] -> ByteString
forall a. Typeable a => a -> ByteString
toSBS [Char]
fname),
   (HeaderName
hCacheControl, ByteString
"no-cache")
  ]
  [Char]
fname
  Maybe FilePart
forall a. Maybe a
Nothing
  
{-|
   === response png/PNG file 

   @
   pdfSent::BS.ByteString -> Response
   @
-} 
responsePNG::FilePath -> Response
responsePNG :: [Char] -> Response
responsePNG [Char]
fname = Status -> ResponseHeaders -> [Char] -> Maybe FilePart -> Response
responseFile
  Status
status200
  [(HeaderName
hContentType, ByteString
"image/png")
   -- (hContentDisposition, "inline;filename=" <> toSBS fname)
   -- (hCacheControl, "no-cache")
  ]
  [Char]
fname
  Maybe FilePart
forall a. Maybe a
Nothing

responseHtml::FilePath -> Response
responseHtml :: [Char] -> Response
responseHtml [Char]
fname = Status -> ResponseHeaders -> [Char] -> Maybe FilePart -> Response
responseFile
  Status
status200
  [(HeaderName
hContentType, ByteString
"text/html")]
  [Char]
fname
  Maybe FilePart
forall a. Maybe a
Nothing

--    case lookup "id" params of
--        Nothing -> undefined
--        Just x -> undefined

-- http://localhost:8000/up/
-- | NOTE: file => /upload dir
-- | Plz see uploadPage.html 
replyEditor :: Response
replyEditor :: Response
replyEditor = Status -> ResponseHeaders -> [Char] -> Maybe FilePart -> Response
responseFile
    Status
status200
    [(HeaderName
"Content-Type", ByteString
"text/html")]
    [Char]
"indexEditor.html"
    Maybe FilePart
forall a. Maybe a
Nothing

responseHelp :: Response
responseHelp :: Response
responseHelp = Status -> ResponseHeaders -> [Char] -> Maybe FilePart -> Response
responseFile
    Status
status200
    [(HeaderName
"Content-Type", ByteString
"text/html")]
    [Char]
"help.html"
    Maybe FilePart
forall a. Maybe a
Nothing

replyCssButton :: Response
replyCssButton :: Response
replyCssButton = Status -> ResponseHeaders -> [Char] -> Maybe FilePart -> Response
responseFile
    Status
status200
    [(HeaderName
"Content-Type", ByteString
"text/html")]
    [Char]
"cssButton.html"
    Maybe FilePart
forall a. Maybe a
Nothing

wordcountReply :: Response
wordcountReply :: Response
wordcountReply = Status -> ResponseHeaders -> [Char] -> Maybe FilePart -> Response
responseFile
    Status
status200
    [(HeaderName
"Content-Type", ByteString
"text/html")]
    [Char]
"wordcountReply.html"
    Maybe FilePart
forall a. Maybe a
Nothing

matrixReply :: Response
matrixReply :: Response
matrixReply = Status -> ResponseHeaders -> [Char] -> Maybe FilePart -> Response
responseFile
    Status
status200
    [(HeaderName
"Content-Type", ByteString
"text/html")]
    [Char]
"postMatrix.html"
    Maybe FilePart
forall a. Maybe a
Nothing

sendHTMLTableCmd :: Response
sendHTMLTableCmd :: Response
sendHTMLTableCmd = Status -> ResponseHeaders -> [Char] -> Maybe FilePart -> Response
responseFile
    Status
status200
    [(HeaderName
"Content-Type", ByteString
"text/html")]
    [Char]
"sendHTMLTableCmd.html"
    Maybe FilePart
forall a. Maybe a
Nothing

replyJS :: Response
replyJS :: Response
replyJS = Status -> ResponseHeaders -> [Char] -> Maybe FilePart -> Response
responseFile
    Status
status200
    [(HeaderName
"Content-Type", ByteString
"text/javascript")]
    [Char]
"ace/build/src/ace.js"
    Maybe FilePart
forall a. Maybe a
Nothing


{-| 
    === Insert name and age to MySqlite-simple file-based database.

    http://localhost:8000/insert/

    File: insert.html
    <form action="/insert" method="POST" enctype="multipart/form-data">
      Name <input type="text" name="name"><br>
      Age <input type="text" name="age"><br>
      <input type="submit" value="submit">
    </form> 

    >insert data to table: people
    >"INSERT INTO people (name, age) VALUES (?,?)" 
-} 
insertDatabase::Connection -> Application
insertDatabase :: Connection -> Application
insertDatabase Connection
conn Request
req Response -> IO ResponseReceived
response = do
    ([Param]
params, [File ByteString]
files) <- BackEnd ByteString -> Request -> IO ([Param], [File ByteString])
forall y. BackEnd y -> Request -> IO ([Param], [File y])
parseRequestBody BackEnd ByteString
forall (m :: * -> *) ignored1 ignored2.
Monad m =>
ignored1 -> ignored2 -> m ByteString -> m ByteString
lbsBackEnd Request
req
    case Request -> ByteString
requestMethod Request
req of
        ByteString
"POST" -> do 
              let name :: ByteString
name = case ByteString -> [Param] -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup ByteString
"name" [Param]
params of 
                                Just ByteString
name -> ByteString
name 
                                Maybe ByteString
_         -> ByteString
"name nothing"
              let age :: ByteString
age = case ByteString -> [Param] -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup ByteString
"age" [Param]
params of 
                                Just ByteString
age  -> ByteString
age 
                                Maybe ByteString
_         -> ByteString
"age nothing" 


              Connection -> Query -> IO ()
execute_ Connection
conn Query
"CREATE TABLE IF NOT EXISTS people (id INTEGER PRIMARY KEY AUTOINCREMENT, name TEXT, age TEXT)"
              Connection -> Query -> Person -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
execute Connection
conn Query
"INSERT INTO people (name, age) VALUES (?,?)" (Int64 -> Text -> Text -> Person
Person Int64
0 (ByteString -> Text
forall a. Typeable a => a -> Text
toSText ByteString
name) (ByteString -> Text
forall a. Typeable a => a -> Text
toSText ByteString
age))
              [Person]
people <- Connection -> Query -> IO [Person]
forall r. FromRow r => Connection -> Query -> IO [r]
query_ Connection
conn Query
"SELECT id, name, age from people" :: IO [Person]
              [Person] -> IO ()
forall (m :: * -> *) a. (MonadIO m, Show a) => a -> m ()
pre [Person]
people
              [Char]
hostURL <- IO [Char]
getHostName
              [Char] -> IO ()
forall (m :: * -> *) a. (MonadIO m, Show a) => a -> m ()
pre [Char]
hostURL
              Response -> IO ResponseReceived
response (Response -> IO ResponseReceived)
-> IO Response -> IO ResponseReceived
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< let Just URI
uri = [Char] -> Maybe URI
parseURI ([Char]
hostURL [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"/insertinfo/") in Status -> ResponseHeaders -> URI -> IO Response
forall (m :: * -> *).
Monad m =>
Status -> ResponseHeaders -> URI -> m Response
redirect' Status
status302 [] URI
uri 
              -- response $ responseNothing $ b2s $ BS.concat [name, age]
        ByteString
_      -> Response -> IO ResponseReceived
response (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ [Char] -> Response
responseNothing [Char]
"post nothing from insertDatabase"
      
{-| 
    @
    -- defind in AronModule.hs
    data CodeBlock = 
    CodeBlock 
    { codeblockId  :: Int64
    , header       :: TS.Text
    , codeblock    :: TS.Text
    } deriving (Eq, Read, Show)


    Input:
    a:*.hs:c,d
    line 1
    line 2

    mycode <- query_ conn "SELECT id, header, codeblock from CodeBlock" :: IO [CodeBlock]

    id        = 106
    header    = a:*:c
    codeblock = a:*.hs:c,d \n line 1 \n line 2

    tupleList = [(["a", "c,d"], ["a:*.hs:c", "line 1", "line 2"],    106)
    pplist    = [(["a", "c", "d"], ["a:*.hs:c", "line 1", "line 2"], 106)

    DATE: Thursday, 29 June 2023 00:11 PDT
    Update CodeBlock table with new column: show INTEGER DEFAULT 1
    SET show = 0 to hide the row
    @
-} 
readDatabaseCodeBlock::Connection -> IO [([String], ([String], Integer, Integer, Integer))]
readDatabaseCodeBlock :: Connection
-> IO [([[Char]], ([[Char]], Integer, Integer, Integer))]
readDatabaseCodeBlock Connection
conn = do
                      -- read CodeBlock table => [CodeBlock]::[Text]
                      [CodeBlock]
mycode <- Connection -> Query -> IO [CodeBlock]
forall r. FromRow r => Connection -> Query -> IO [r]
query_ Connection
conn Query
"SELECT id, header, codeblock, addedtime, score from CodeBlock WHERE show = 1" :: IO [CodeBlock]
                      -- mycode = [CodeBlock]::[Text]
                      [Char] -> IO ()
fw [Char]
"mycode beg"
                      -- pre mycode
                      [Char] -> IO ()
fw [Char]
"mycode end"
                      -- only codeblocks
                      -- let list = map (\x -> ( codeBlockId x, (toStr.header) x, (toStr.codeblock) x) ) mycode 
                      let list :: [(Int64, [Char], [Char], Int64, Int64)]
list = (CodeBlock -> (Int64, [Char], [Char], Int64, Int64))
-> [CodeBlock] -> [(Int64, [Char], [Char], Int64, Int64)]
forall a b. (a -> b) -> [a] -> [b]
map (\CodeBlock
x -> let cb :: [Char]
cb = (Text -> [Char]
forall a. Typeable a => a -> [Char]
toStr (Text -> [Char]) -> (CodeBlock -> Text) -> CodeBlock -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CodeBlock -> Text
codeblock) CodeBlock
x in ( CodeBlock -> Int64
codeBlockId CodeBlock
x, [[Char]] -> [Char]
forall a. [a] -> a
head ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> [[Char]]
plines [Char]
cb, [Char]
cb, CodeBlock -> Int64
addedtime CodeBlock
x, CodeBlock -> Int64
score CodeBlock
x) ) [CodeBlock]
mycode 
                      --  list = [(id, header, codebock)]
                      [Char] -> IO ()
fw [Char]
"list"
                      -- pre list
                      -- let ll = filter(\x -> length x > 0) $ splitWhen(\x -> (length $ trim x) == 0) list
                      --
                      -- NOTE: header field in CodeBlock is NOT USED
                      let ll :: [(Int64, [Char], [[Char]], Int64, Int64)]
ll = ((Int64, [Char], [Char], Int64, Int64)
 -> (Int64, [Char], [[Char]], Int64, Int64))
-> [(Int64, [Char], [Char], Int64, Int64)]
-> [(Int64, [Char], [[Char]], Int64, Int64)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Int64
id, [Char]
_, [Char]
c, Int64
addedtime, Int64
score) -> (Int64
id, [[Char]] -> [Char]
forall a. [a] -> a
head ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> [[Char]]
plines [Char]
c, [Char] -> [[Char]]
plines [Char]
c, Int64
addedtime, Int64
score)) [(Int64, [Char], [Char], Int64, Int64)]
list
                      
                      
                      --   ll = [(id, header, [[line 1], [line 2]])]
                      --   let plist = map(\x -> ((splitStrChar "[,:]" $ head x), x) ) ll
                          
                      --   1. take the first line of codeblock
                      --   2. splitStrChar "[:]" =>  mycode : *.hs : Just Bieber Constable, the governer of royal castle
                      --                         =>  [mycode] [*.hs] [Just Bieber Constable, the governer of royal castle]
                      --      remove *.hs 
                      --   3. removeIndex 1 => [mycode] [Just Bieber Constable, the governer of royal castle]
                      --   4. tupleList = [[mycode] [Just Bieber Constable, the governer of royal castle]]
                      
                      let tupleList :: [([[Char]], [[Char]], Int64, Int64, Int64)]
tupleList = ((Int64, [Char], [[Char]], Int64, Int64)
 -> ([[Char]], [[Char]], Int64, Int64, Int64))
-> [(Int64, [Char], [[Char]], Int64, Int64)]
-> [([[Char]], [[Char]], Int64, Int64, Int64)]
forall a b. (a -> b) -> [a] -> [b]
map(\(Int64
id, [Char]
header, [[Char]]
cs, Int64
addedtime, Int64
score) -> ((Int -> [[Char]] -> [[Char]]
forall a. Int -> [a] -> [a]
removeIndex Int
1 ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> [[Char]]
splitStrChar [Char]
"[:]" [Char]
header), [[Char]]
cs, Int64
id, Int64
addedtime, Int64
score) ) [(Int64, [Char], [[Char]], Int64, Int64)]
ll
                      [Char] -> IO ()
fw [Char]
"tupleList"
                      -- pre tupleList
                      let pplist :: [([[Char]], ([[Char]], Integer, Integer, Integer))]
pplist = (([[Char]], [[Char]], Int64, Int64, Int64)
 -> ([[Char]], ([[Char]], Integer, Integer, Integer)))
-> [([[Char]], [[Char]], Int64, Int64, Int64)]
-> [([[Char]], ([[Char]], Integer, Integer, Integer))]
forall a b. (a -> b) -> [a] -> [b]
map(\([[Char]]
header, [[Char]]
cs, Int64
id, Int64
addedtime, Int64
score) -> (
                                                      [[Char]] -> [[Char]]
forall a. Ord a => [a] -> [a]
uniqueOrder ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ ([[Char]] -> [[Char]] -> [[Char]])
-> [[Char]] -> [[[Char]]] -> [[Char]]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr[[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
(++) [] ([[[Char]]] -> [[Char]]) -> [[[Char]]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ ([Char] -> [[Char]]) -> [[Char]] -> [[[Char]]]
forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> [Char] -> [[Char]]
splitStrCharTrim [Char]
"[,]") [[Char]]
header, 
                                                      ([[Char]]
cs, Int64 -> Integer
forall a. Integral a => a -> Integer
toInteger Int64
id, Int64 -> Integer
forall a. Integral a => a -> Integer
toInteger Int64
addedtime, Int64 -> Integer
forall a. Integral a => a -> Integer
toInteger Int64
score))
                                             ) [([[Char]], [[Char]], Int64, Int64, Int64)]
tupleList
                      [Char] -> IO ()
fw [Char]
"pplist"
                      -- pre pplist
                      -- pre $ typeOf pplist    
                      [([[Char]], ([[Char]], Integer, Integer, Integer))]
-> IO [([[Char]], ([[Char]], Integer, Integer, Integer))]
forall (m :: * -> *) a. Monad m => a -> m a
return [([[Char]], ([[Char]], Integer, Integer, Integer))]
pplist
                      
--              fl
--              pre mycode
--              fl
--              let codels = map (\x -> let h = head $ lines $ strictTextToStr x 
--                                      in (removeIndex 1 $ splitStrChar "[:]" h, lines $ strictTextToStr x)) $ map (\x -> codeblock x) mycode 
--              return  codels
--    where 
--        b2s = strictTextToStr . strictByteStringToStrictText
--        toSText = strictByteStringToStrictText

readSnippet2::FilePath->IO [([String], [String])]
readSnippet2 :: [Char] -> IO [([[Char]], [[Char]])]
readSnippet2 [Char]
path = do 
            -- list <- readFileToList path;
            [[Char]]
list <- [Char] -> IO [[Char]]
readFileLatin1ToList [Char]
path;
            let ll :: [[[Char]]]
ll = ([[Char]] -> Bool) -> [[[Char]]] -> [[[Char]]]
forall a. (a -> Bool) -> [a] -> [a]
filter(\[[Char]]
x -> [[Char]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Char]]
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) ([[[Char]]] -> [[[Char]]]) -> [[[Char]]] -> [[[Char]]]
forall a b. (a -> b) -> a -> b
$ ([Char] -> Bool) -> [[Char]] -> [[[Char]]]
forall a. (a -> Bool) -> [a] -> [[a]]
splitWhen(\[Char]
x -> ([Char] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Char] -> Int) -> [Char] -> Int
forall a b. (a -> b) -> a -> b
$ ShowS
trim [Char]
x) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) [[Char]]
list
            -- let plist = map(\x -> ((splitStrChar "[,:]" $ head x), x) ) ll
            let plist :: [([[Char]], [[Char]])]
plist = ([[Char]] -> ([[Char]], [[Char]]))
-> [[[Char]]] -> [([[Char]], [[Char]])]
forall a b. (a -> b) -> [a] -> [b]
map(\[[Char]]
x -> ((Int -> [[Char]] -> [[Char]]
forall a. Int -> [a] -> [a]
removeIndex Int
1 ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> [[Char]]
splitStrChar [Char]
"[:]" ([Char] -> [[Char]]) -> [Char] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
forall a. [a] -> a
head [[Char]]
x), [[Char]]
x) ) [[[Char]]]
ll
            let pplist :: [([[Char]], [[Char]])]
pplist = (([[Char]], [[Char]]) -> ([[Char]], [[Char]]))
-> [([[Char]], [[Char]])] -> [([[Char]], [[Char]])]
forall a b. (a -> b) -> [a] -> [b]
map(\([[Char]], [[Char]])
k -> (
                                       -- remove duplicated elem and keey the order
                                       -- L.nubBy (\x y -> x == y) $ foldr(++) [] (map(\x -> map(\r -> trim r) $ splitStrChar "[,]" x) (fst k)), 
                                       [[Char]] -> [[Char]]
forall a. Ord a => [a] -> [a]
uniqueOrder ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ ([[Char]] -> [[Char]] -> [[Char]])
-> [[Char]] -> [[[Char]]] -> [[Char]]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr[[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
(++) [] (([Char] -> [[Char]]) -> [[Char]] -> [[[Char]]]
forall a b. (a -> b) -> [a] -> [b]
map(\[Char]
x -> ShowS -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map(\[Char]
r -> ShowS
trim [Char]
r) ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> [[Char]]
splitStrChar [Char]
"[,]" [Char]
x) (([[Char]], [[Char]]) -> [[Char]]
forall a b. (a, b) -> a
fst ([[Char]], [[Char]])
k)), 

                                       -- NOTE: fix bug, unique does not keep the order of elem
                                       -- unique $ foldr(++) [] (map(\x -> map(\r -> trim r) $ splitStrChar "[,]" x) (fst k)), 
                                       ([[Char]], [[Char]]) -> [[Char]]
forall a b. (a, b) -> b
snd ([[Char]], [[Char]])
k
                                   ) 
                            ) [([[Char]], [[Char]])]
plist
            [([[Char]], [[Char]])] -> IO [([[Char]], [[Char]])]
forall (m :: * -> *) a. Monad m => a -> m a
return [([[Char]], [[Char]])]
pplist 


queryCreateTable::DQ.Query
queryCreateTable :: Query
queryCreateTable = Query
query
  where
    q :: [Char]
q = [Char]
"CREATE TABLE IF NOT EXISTS CodeBlock (id INTEGER PRIMARY KEY AUTOINCREMENT, header TEXT, codeblock TEXT, addedtime DATETIME DEFAULT (strftime('%s', 'now')), score INTEGER DEFAULT 0)"
    query :: Query
query = Query :: Text -> Query
DQ.Query{fromQuery :: Text
fromQuery = [Char] -> Text
s2Text [Char]
q}

            
{-| 
    === Create CodeBlock table

    NOT USED
-} 
createCodeBlockTable::Connection -> IO() 
createCodeBlockTable :: Connection -> IO ()
createCodeBlockTable Connection
conn = do
              Connection -> Query -> IO ()
execute_ Connection
conn Query
queryCreateTable
              () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

{-|
  NOT USED
-}
addCodeBlockTable::Connection -> TS.Text -> TS.Text -> IO() 
addCodeBlockTable :: Connection -> Text -> Text -> IO ()
addCodeBlockTable Connection
conn Text
header Text
text = do
              let header' :: Text
header' = Text -> Text
trimT Text
header
              let text' :: Text
text' = Text -> Text
trimT Text
text
              Connection -> Query -> IO ()
execute_ Connection
conn Query
queryCreateTable
              Connection -> Query -> CodeBlock -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
execute Connection
conn Query :: Text -> Query
Query{fromQuery :: Text
fromQuery = [Char] -> Text
s2Text [Char]
"INSERT INTO CodeBlock (header, codeblock) VALUES (?,?)"} (Int64 -> Text -> Text -> Int64 -> Int64 -> CodeBlock
CodeBlock Int64
0 Text
header' Text
text' Int64
0 Int64
0)
              () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

{-|
  NOT USED
-}
updateDatabaseCodeBlockTable::Connection -> TS.Text -> TS.Text -> IO() 
updateDatabaseCodeBlockTable :: Connection -> Text -> Text -> IO ()
updateDatabaseCodeBlockTable Connection
conn Text
oldHeader Text
text = do
              let oldHeader' :: Text
oldHeader' = Text -> Text
trimT Text
oldHeader 
              Connection -> Query -> Only Text -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
execute Connection
conn Query :: Text -> Query
Query{fromQuery :: Text
fromQuery = [Char] -> Text
s2Text [Char]
"DELETE FROM CodeBlock WHERE header = ? "} (Text -> Only Text
forall a. a -> Only a
Only Text
oldHeader') 
              [CodeBlock]
codeblock <- Connection -> Query -> IO [CodeBlock]
forall r. FromRow r => Connection -> Query -> IO [r]
query_ Connection
conn Query :: Text -> Query
Query{fromQuery :: Text
fromQuery = [Char] -> Text
s2Text [Char]
"SELECT id, header, codeblock from CodeBlock"} :: IO [CodeBlock]
              -- pre codeblock 

              let newHeader :: Text
newHeader = let ln :: [[Char]]
ln = [Char] -> [[Char]]
plines ([Char] -> [[Char]]) -> [Char] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
forall a. Typeable a => a -> [Char]
toStr Text
text in [Char] -> Text
forall a. Typeable a => a -> Text
toSText ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
forall a. [a] -> a
head [[Char]]
ln
              let newHeader' :: Text
newHeader' = Text -> Text
trimT Text
newHeader
              let text' :: Text
text' = Text -> Text
trimT Text
text
              Connection -> Query -> IO ()
execute_ Connection
conn Query
queryCreateTable
              Connection -> Query -> CodeBlock -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
execute Connection
conn Query :: Text -> Query
Query{fromQuery :: Text
fromQuery = [Char] -> Text
s2Text [Char]
"INSERT INTO CodeBlock (header, codeblock) VALUES (?,?)"} (Int64 -> Text -> Text -> Int64 -> Int64 -> CodeBlock
CodeBlock Int64
0 Text
newHeader' Text
text Int64
0 Int64
0)
              Int64
rowId <- Connection -> IO Int64
lastInsertRowId Connection
conn
              let myhead :: [Char]
myhead = [Char]
"hi"
              -- execute conn "DELETE FROM CodeBlock WHERE id = ? " (Only rowId) 
              -- TODO:
              -- oldHeader need to be cleanup a bit to compare the origin header
              [Char] -> IO ()
fw [Char]
"oldHeader beg"
              Text -> IO ()
forall (m :: * -> *) a. (MonadIO m, Show a) => a -> m ()
pre Text
oldHeader
              [Char] -> IO ()
fw [Char]
"oldHeader end"
              () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  
{-|
   === Update database table

   @
   data CodeBlock =
       CodeBlock
       { codeBlockId :: Int64
       , header      :: TS.Text
       , codeblock   :: TS.Text
       , addedtime   :: Int64
       , score       :: Int64
       } deriving (Eq, Read, Show)
   @
-}              
updateDatabaseNewCodeTable::Connection -> Integer -> TS.Text -> IO()
updateDatabaseNewCodeTable :: Connection -> Integer -> Text -> IO ()
updateDatabaseNewCodeTable Connection
conn Integer
pid Text
ucode = do
  let mycode :: Text
mycode = Text
"hi"::TS.Text
  let pidInt :: Int64
pidInt = Integer -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
pid
  let header :: Text
header = [Text] -> Text
forall a. [a] -> a
head ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
linesSText Text
ucode
  Connection -> Query -> [NamedParam] -> IO ()
executeNamed Connection
conn Query :: Text -> Query
Query{fromQuery :: Text
fromQuery = [Char] -> Text
s2Text [Char]
"UPDATE CodeBlock SET header = :header , codeblock = :codeblock, addedtime = strftime('%s', 'now') WHERE id = :id "} [Text
":header" Text -> Text -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= Text
header, Text
":codeblock" Text -> Text -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= Text
ucode, Text
":id" Text -> Int64 -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= (Int64
pidInt::Int64)]
  -- executeNamed conn Query{fromQuery = s2Text "UPDATE CodeBlock SET header = :header , codeblock = :codeblock, addedtime = strftime('%s', 'now'),  score = :score WHERE id = :id "} [":header" := header, ":codeblock" := ucode, ":score" := score, ":id" := (pidInt::Int64)]

updateDatabaseScoreTable::Connection -> Integer -> String -> IO()
updateDatabaseScoreTable :: Connection -> Integer -> [Char] -> IO ()
updateDatabaseScoreTable Connection
conn Integer
pid [Char]
upordown  = do
  let pidInt :: Int64
pidInt = Integer -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
pid
  let addedtime :: Int64
addedtime = Int64
999::Int64
  let score :: Int64
score     = Int64
33::Int64
  case [Char]
upordown of
    [Char]
"upscore"   -> Connection -> Query -> [NamedParam] -> IO ()
executeNamed Connection
conn Query :: Text -> Query
Query{fromQuery :: Text
fromQuery = [Char] -> Text
s2Text [Char]
"UPDATE CodeBlock SET score = score + 1 WHERE id = :id"} [Text
":id" Text -> Int64 -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= (Int64
pidInt::Int64)]
    [Char]
"downscore" -> Connection -> Query -> [NamedParam] -> IO ()
executeNamed Connection
conn Query :: Text -> Query
Query{fromQuery :: Text
fromQuery = [Char] -> Text
s2Text [Char]
"UPDATE CodeBlock SET score = score - 1 WHERE id = :id"} [Text
":id" Text -> Int64 -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= (Int64
pidInt::Int64)]
    [Char]
_           -> [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error [Char]
"Unknow command from updateDatabaseScoreTable"
  
updateDatabaseShowTable::Connection -> Integer -> IO()
updateDatabaseShowTable :: Connection -> Integer -> IO ()
updateDatabaseShowTable Connection
conn Integer
pid = do
  let pidInt :: Int64
pidInt = Integer -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
pid
  Connection -> Query -> [NamedParam] -> IO ()
executeNamed Connection
conn Query :: Text -> Query
Query{fromQuery :: Text
fromQuery = [Char] -> Text
s2Text [Char]
"UPDATE CodeBlock SET show = 0 WHERE id = :id"} [Text
":id" Text -> Int64 -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= (Int64
pidInt::Int64)]

  
{-|
   ==== Two Commands only
   "upscore"    => score += 1
   "downscore"  => score -= 1
-}
updateScoreCodeBlock::Connection -> IORef HMap2 -> String -> Application
updateScoreCodeBlock :: Connection -> IORef HMap2 -> [Char] -> Application
updateScoreCodeBlock Connection
conn IORef HMap2
ref [Char]
cmd Request
req Response -> IO ResponseReceived
response = do
  ByteString
str <- Request -> IO ByteString
getRequestBodyChunk Request
req
  let may :: Maybe UpdateCodeBlock
may = (ByteString -> Maybe UpdateCodeBlock
forall a. FromJSON a => ByteString -> Maybe a
DA.decode (ByteString -> Maybe UpdateCodeBlock)
-> (ByteString -> ByteString)
-> ByteString
-> Maybe UpdateCodeBlock
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
forall a. Typeable a => a -> ByteString
toLBS) ByteString
str :: Maybe UpdateCodeBlock
  [Char] -> IO ()
fw [Char]
"may"
  Maybe UpdateCodeBlock -> IO ()
forall (m :: * -> *) a. (MonadIO m, Show a) => a -> m ()
pre Maybe UpdateCodeBlock
may
  let codeJson :: UpdateCodeBlock
codeJson = case Maybe UpdateCodeBlock
may of 
        (Just UpdateCodeBlock
x) -> UpdateCodeBlock
x 
        Maybe UpdateCodeBlock
_        -> UpdateCodeBlock :: Integer -> [Char] -> Integer -> Integer -> UpdateCodeBlock
UpdateCodeBlock{$sel:pid:UpdateCodeBlock :: Integer
pid = Integer
0, $sel:newcode:UpdateCodeBlock :: [Char]
newcode=[Char]
"no code", $sel:begt:UpdateCodeBlock :: Integer
begt=Integer
0, $sel:endt:UpdateCodeBlock :: Integer
endt=Integer
0} 
  [Char] -> IO ()
fw [Char]
"updateScoreCodeBlock WaiLib.hs"
  UpdateCodeBlock -> IO ()
forall (m :: * -> *) a. (MonadIO m, Show a) => a -> m ()
pre UpdateCodeBlock
codeJson
  Connection -> Integer -> [Char] -> IO ()
updateDatabaseScoreTable Connection
conn (UpdateCodeBlock -> Integer
pid UpdateCodeBlock
codeJson) [Char]
cmd
  -- if update ok, then send back "ok"
  let begtClient :: Integer
begtClient = UpdateCodeBlock -> Integer
begt UpdateCodeBlock
codeJson

  -- KEY: Last command, top command
  [Char]
cmd <- [Char] -> IO [Char]
redisGetLastCmd [Char]
keyLastCmd
  let upcodeblock :: CodeBlockReply
upcodeblock = CodeBlockReply :: [Char] -> [Char] -> [Char] -> Integer -> Integer -> CodeBlockReply
CodeBlockReply{$sel:ok:CodeBlockReply :: [Char]
ok = [Char]
"True", $sel:retcmd:CodeBlockReply :: [Char]
retcmd = [Char]
"updateScore", $sel:retdata:CodeBlockReply :: [Char]
retdata = [Char]
cmd, $sel:retbegt:CodeBlockReply :: Integer
retbegt = Integer
begtClient, $sel:retendt:CodeBlockReply :: Integer
retendt = Integer
0}
  MVar Integer
result <- IO (MVar Integer)
forall a. IO (MVar a)
newEmptyMVar

  [[Char]] -> IO ()
logFileG [[Char]
"1 updateScoreCodeBlock"]
  [([[Char]], ([[Char]], Integer, Integer, Integer))]
newList <- Connection
-> IO [([[Char]], ([[Char]], Integer, Integer, Integer))]
readDatabaseCodeBlock Connection
conn

  [[Char]] -> IO ()
logFileG [[Char]
"2 updateScoreCodeBlock"]
  [([[Char]], ([[Char]], Integer, Integer, Integer))]
-> IORef HMap2 -> IO ()
updatePrefixMap [([[Char]], ([[Char]], Integer, Integer, Integer))]
newList IORef HMap2
ref
  MVar Integer -> Integer -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar Integer
result Integer
100        
  
  [Char] -> IO ()
putStrLn [Char]
"Waiting"
  Integer
value <- MVar Integer -> IO Integer
forall a. MVar a -> IO a
takeMVar MVar Integer
result
  
  [[Char]] -> IO ()
logFileG [[Char]
"3 updateScoreCodeBlock"]
  Response -> IO ResponseReceived
response (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ CodeBlockReply -> Response
forall a. ToJSON a => a -> Response
responseJSON CodeBlockReply
upcodeblock

addScoreCodeBlock:: Connection -- ^ Connection
  -> IORef HMap2 -- ^ type HMap2 = M.HashMap String [([String], Integer, Integer, Integer)]
  -> Application
addScoreCodeBlock :: Connection -> IORef HMap2 -> Application
addScoreCodeBlock Connection
conn IORef HMap2
ref = Connection -> IORef HMap2 -> [Char] -> Application
updateScoreCodeBlock Connection
conn IORef HMap2
ref [Char]
"upscore"
  
subtractScoreCodeBlock:: Connection -- ^ Connection
  -> IORef HMap2 -- ^ type HMap2 = M.HashMap String [([String], Integer, Integer, Integer)]
  -> Application
subtractScoreCodeBlock :: Connection -> IORef HMap2 -> Application
subtractScoreCodeBlock Connection
conn IORef HMap2
ref = Connection -> IORef HMap2 -> [Char] -> Application
updateScoreCodeBlock Connection
conn IORef HMap2
ref [Char]
"downscore"
  
{-|
   KEY: insert code to database
-- data CodeBlock = 
--    CodeBlock 
--    { codeblockId        :: Int64
--    , header    :: TS.Text
--    , codeblock :: TS.Text
--    } deriving (Eq, Read, Show)
-} 
insertDatabaseNewCodeTable::Connection -> Integer -> TS.Text -> IO()
insertDatabaseNewCodeTable :: Connection -> Integer -> Text -> IO ()
insertDatabaseNewCodeTable Connection
conn Integer
pid Text
ucode = do
  let pidInt :: Integer
pidInt = Integer -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
pid -- pidInt is not used here
  let header' :: Text
header' = [Char] -> Text
forall a. Typeable a => a -> Text
toSText ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
forall a. [a] -> a
head ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> [[Char]]
plines ([Char] -> [[Char]]) -> [Char] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
forall a. Typeable a => a -> [Char]
toStr Text
ucode
  Connection -> Query -> (Text, Text) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
execute Connection
conn Query :: Text -> Query
Query{fromQuery :: Text
fromQuery = [Char] -> Text
s2Text [Char]
"INSERT INTO CodeBlock (header, codeblock) VALUES(?, ?)"} ((Text
header', Text
ucode)::(TS.Text, TS.Text))

{-|
  KEY: duplicated row and set show=0
-}
duplicatedRowNoShow::Connection -> Integer-> IO()
duplicatedRowNoShow :: Connection -> Integer -> IO ()
duplicatedRowNoShow Connection
conn Integer
pid = do
  let pidInt :: Int64
pidInt = Integer -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
pid
  Connection -> Query -> Only Int64 -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
execute Connection
conn Query :: Text -> Query
Query{fromQuery :: Text
fromQuery = [Char] -> Text
s2Text [Char]
"INSERT INTO CodeBlock (header, codeblock) SELECT header, codeblock from CodeBlock WHERE id = ? "} (Int64 -> Only Int64
forall a. a -> Only a
Only (Int64
pidInt::Int64))
  Connection -> Query -> IO ()
execute_ Connection
conn Query :: Text -> Query
Query{fromQuery :: Text
fromQuery = [Char] -> Text
s2Text [Char]
"UPDATE CodeBlock SET show = 0 WHERE id = (select MAX(id) from CodeBlock)"}
  

{-|
 @
 Fake deletion, SET show = 0 in database table 
 NOTE: ucode is NOT USED
 @
-}
deleteDatabaseNewCodeTable::Connection -> [Integer] -> TS.Text -> IO()
deleteDatabaseNewCodeTable :: Connection -> [Integer] -> Text -> IO ()
deleteDatabaseNewCodeTable Connection
conn [Integer]
pidlist Text
ucode = do
  -- let pidInt = fromIntegral pid
  let x1 :: Integer
x1 = Integer -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
868 
  let ps :: [Char]
ps = [[Char]] -> ShowS
concatStr ((Integer -> [Char]) -> [Integer] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map Integer -> [Char]
forall a. Show a => a -> [Char]
show [Integer]
pidlist) [Char]
","
  let px :: [Char]
px = [Char]
"(" [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
ps [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
")"
  -- executeNamed conn Query{fromQuery = s2Text "UPDATE CodeBlock SET show = 0 WHERE id = :id "} [":id" := (pidInt::Int64)]
  -- executeNamed conn Query{fromQuery = s2Text "UPDATE CodeBlock SET show = 0 WHERE id IN (:id, :x1)"} [":id" := (pidInt::Int64), ":x1" := (x1 :: Int64)]
  Connection -> Query -> [NamedParam] -> IO ()
executeNamed Connection
conn Query :: Text -> Query
Query{fromQuery :: Text
fromQuery = [Char] -> Text
s2Text ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"UPDATE CodeBlock SET show = 0 WHERE id IN " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
px} []
  
deleteDatabaseCodeBlockTable::Connection -> TS.Text -> IO() 
deleteDatabaseCodeBlockTable :: Connection -> Text -> IO ()
deleteDatabaseCodeBlockTable Connection
conn Text
header = do
  let header' :: Text
header' = Text -> Text
trimT Text
header
  Connection -> Query -> Only Text -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
execute Connection
conn Query :: Text -> Query
Query{fromQuery :: Text
fromQuery = [Char] -> Text
s2Text [Char]
"DELETE FROM CodeBlock WHERE header = ? "} (Text -> Only Text
forall a. a -> Only a
Only Text
header') 
  [CodeBlock]
codeblock <- Connection -> Query -> IO [CodeBlock]
forall r. FromRow r => Connection -> Query -> IO [r]
query_ Connection
conn Query :: Text -> Query
Query{fromQuery :: Text
fromQuery = [Char] -> Text
s2Text [Char]
"SELECT id, header, codeblock from CodeBlock"} :: IO [CodeBlock]
  [CodeBlock] -> IO ()
forall (m :: * -> *) a. (MonadIO m, Show a) => a -> m ()
pre [CodeBlock]
codeblock 
  () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

loginCheck::Connection -> Application
loginCheck :: Connection -> Application
loginCheck Connection
conn Request
req Response -> IO ResponseReceived
response = do
    ([Param]
params, [File ByteString]
files) <- BackEnd ByteString -> Request -> IO ([Param], [File ByteString])
forall y. BackEnd y -> Request -> IO ([Param], [File y])
parseRequestBody BackEnd ByteString
forall (m :: * -> *) ignored1 ignored2.
Monad m =>
ignored1 -> ignored2 -> m ByteString -> m ByteString
lbsBackEnd Request
req
    case Request -> ByteString
requestMethod Request
req of
        ByteString
"POST" -> do 
              let email_ :: Text
email_ = case ByteString -> [Param] -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup ByteString
"email" [Param]
params of 
                                Just ByteString
email -> ByteString -> Text
forall a. Typeable a => a -> Text
toSText ByteString
email 
                                Maybe ByteString
_          -> Text
"email nothing" 

              let password_ :: Text
password_ = case ByteString -> [Param] -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup ByteString
"password" [Param]
params of 
                                -- Just password -> BS.takeWhile (not.DW.isSpace) $ BS.dropWhile (DW.isSpace) password 
                                Just ByteString
password -> ByteString -> Text
forall a. Typeable a => a -> Text
toSText ByteString
password 
                                Maybe ByteString
_             -> Text
"password nothing" 
              Text -> IO ()
forall a. Show a => a -> IO ()
print Text
email_
              Text -> IO ()
forall a. Show a => a -> IO ()
print Text
password_ 
              -- row <- queryNamed conn "SELECT * FROM user WHERE uid = :uid" [":uid" := uid] :: IO [User]
              [User]
row <- Connection -> Query -> [NamedParam] -> IO [User]
forall r.
FromRow r =>
Connection -> Query -> [NamedParam] -> IO [r]
queryNamed Connection
conn Query :: Text -> Query
Query{fromQuery :: Text
fromQuery = [Char] -> Text
s2Text [Char]
"SELECT * FROM user WHERE email = :email AND password = :password"} [Text
":password" Text -> Text -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= Text
password_, Text
":email" Text -> Text -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= Text
email_] :: IO [User]
              [User] -> IO ()
forall a. Show a => a -> IO ()
print [User]
row
              Response -> IO ResponseReceived
response (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ [Char] -> Response
responseNothing [Char]
"row nothing"
        ByteString
_      -> Response -> IO ResponseReceived
response (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ [Char] -> Response
responseNothing [Char]
"user nothing"


{-| 
    validate user input and santize me
-} 
securityValidate:: BS.ByteString -> 
                   BS.ByteString -> 
                   BS.ByteString -> 
                   BS.ByteString -> 
                   BS.ByteString -> 
                   Bool
securityValidate :: ByteString
-> ByteString -> ByteString -> ByteString -> ByteString -> Bool
securityValidate ByteString
name ByteString
email ByteString
password ByteString
task ByteString
money = Bool
nameBool Bool -> Bool -> Bool
&& Bool
passwordBool Bool -> Bool -> Bool
&& Bool
emailBool
        where
            nameT :: Text
nameT = ByteString -> Text
forall a. Typeable a => a -> Text
toSText ByteString
name
            passwordT :: Text
passwordT = ByteString -> Text
forall a. Typeable a => a -> Text
toSText ByteString
password
            nameBool :: Bool
nameBool = if (Text -> Int
TS.length Text
nameT) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& (Text -> Int
TS.length Text
nameT) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
40 Bool -> Bool -> Bool
&& (Char -> Bool) -> Text -> Bool
TS.all (Char -> Bool
isAlphaNum) Text
nameT then Bool
True else Bool
False
            passwordBool :: Bool
passwordBool = if (Char -> Bool) -> Text -> Bool
TS.all (Char -> Bool
isAlphaNum) Text
passwordT then Bool
True else Bool
False
            emailBool :: Bool
emailBool = ByteString -> Bool
EM.isValid ByteString
email

insertUserDB::Connection -> Application
insertUserDB :: Connection -> Application
insertUserDB Connection
conn Request
req Response -> IO ResponseReceived
response = do
    ([Param]
params, [File ByteString]
files) <- BackEnd ByteString -> Request -> IO ([Param], [File ByteString])
forall y. BackEnd y -> Request -> IO ([Param], [File y])
parseRequestBody BackEnd ByteString
forall (m :: * -> *) ignored1 ignored2.
Monad m =>
ignored1 -> ignored2 -> m ByteString -> m ByteString
lbsBackEnd Request
req
    case Request -> ByteString
requestMethod Request
req of
        ByteString
"POST" -> do 
              let name_ :: ByteString
name_ = case ByteString -> [Param] -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup ByteString
"name" [Param]
params of    -- ByteString
                          Just ByteString
name -> ByteString
name 
                          Maybe ByteString
_         -> ByteString
"name nothing"
              let email_ :: ByteString
email_ = case ByteString -> [Param] -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup ByteString
"email" [Param]
params of 
                           Just ByteString
email -> ByteString
email 
                           Maybe ByteString
_          -> ByteString
"email nothing" 

              let password_ :: ByteString
password_ = case ByteString -> [Param] -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup ByteString
"password" [Param]
params of 
                              Just ByteString
password -> ByteString
password 
                              Maybe ByteString
_             -> ByteString
"password nothing" 

              let task_ :: ByteString
task_ = case ByteString -> [Param] -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup ByteString
"task" [Param]
params of 
                          Just ByteString
task -> ByteString
task 
                          Maybe ByteString
_         -> ByteString
"task nothing" 

              let money_ :: ByteString
money_ = case ByteString -> [Param] -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup ByteString
"money" [Param]
params of 
                           Just ByteString
money -> ByteString
money 
                           Maybe ByteString
_         -> ByteString
"money nothing" 

              -- validate user input
              -- formatValidate::User -> Bool
              Connection -> Query -> IO ()
execute_ Connection
conn Query :: Text -> Query
Query{fromQuery :: Text
fromQuery = [Char] -> Text
s2Text [Char]
"CREATE TABLE IF NOT EXISTS user (uid INTEGER PRIMARY KEY AUTOINCREMENT, name TEXT, email TEXT, password TEXT, task TEXT, money INTEGER)"}
              [User]
row <- Connection -> Query -> [NamedParam] -> IO [User]
forall r.
FromRow r =>
Connection -> Query -> [NamedParam] -> IO [r]
queryNamed Connection
conn Query :: Text -> Query
Query{fromQuery :: Text
fromQuery = [Char] -> Text
s2Text [Char]
"SELECT * FROM user WHERE email = :email"} [Text
":email" Text -> Text -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= (ByteString -> Text
forall a. Typeable a => a -> Text
toSText ByteString
email_)] :: IO [User]
              if [User] -> Integer
forall (t :: * -> *) b a. (Foldable t, Num b) => t a -> b
len [User]
row Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 then do
                  Connection -> Query -> User -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
execute Connection
conn Query :: Text -> Query
Query{fromQuery :: Text
fromQuery = [Char] -> Text
s2Text [Char]
"INSERT INTO user (name, email, password, task, money) VALUES (?,?,?,?,?)"} (Int64 -> Text -> Text -> Text -> Text -> Integer -> User
User Int64
0 (ByteString -> Text
forall a. Typeable a => a -> Text
toSText ByteString
name_) (ByteString -> Text
forall a. Typeable a => a -> Text
toSText ByteString
email_) (ByteString -> Text
forall a. Typeable a => a -> Text
toSText ByteString
password_) (ByteString -> Text
forall a. Typeable a => a -> Text
toSText ByteString
task_) (ByteString -> Integer
b2Integer ByteString
money_))
                  Int
changeRow <- Connection -> IO Int
changes Connection
conn
                  [Char] -> IO ()
forall a. Show a => a -> IO ()
print ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"changeRow=" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ (Int -> [Char]
forall a. Show a => a -> [Char]
show Int
changeRow)
                  if Int
changeRow Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then do
                      [User]
userList <- Connection -> Query -> IO [User]
forall r. FromRow r => Connection -> Query -> IO [r]
query_ Connection
conn Query :: Text -> Query
Query{fromQuery :: Text
fromQuery = [Char] -> Text
s2Text [Char]
"SELECT uid, name, email, password, task, money FROM user"} :: IO [User]
                      (User -> IO ()) -> [User] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ User -> IO ()
forall a. Show a => a -> IO ()
print [User]
userList
                      -- let listTask = TS.concat $ map (\x -> [r|<div>|] <> (t2b $ task x) <> [r|</div><br>|]) userList -- => TS.Text
                      -- response $ responseTaskBS (task (head userList))
                      ByteString
hostURL <- IO [Char]
getHostName IO [Char] -> ([Char] -> IO ByteString) -> IO ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString)
-> ([Char] -> ByteString) -> [Char] -> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ByteString
forall a. Typeable a => a -> ByteString
toSBS
                      Response -> IO ResponseReceived
response (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ ByteString -> Response
responseTaskBS (ByteString -> Response) -> ByteString -> Response
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> ByteString
replyTaskHtml ByteString
hostURL ByteString
task_ 
                  else do
                      Response -> IO ResponseReceived
response (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ ByteString -> Response
responseTaskBS ByteString
"Insect task field" 
                      -- response =<< let Just uri = parseURI "http://localhost:8000/insertUser/" in redirect' status302 [] uri 
              else do
                  Response -> IO ResponseReceived
response (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ [Char] -> Response
responseNothing [Char]
"email exists"
        ByteString
_      -> Response -> IO ResponseReceived
response (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ [Char] -> Response
responseNothing [Char]
"no POST"

    where 
        b2Integer :: ByteString -> Integer
b2Integer = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fi (Int -> Integer) -> (ByteString -> Int) -> ByteString -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int
b2i
        b2i :: ByteString -> Int
b2i = [Char] -> Int
stringToInt ([Char] -> Int) -> (ByteString -> [Char]) -> ByteString -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
strictTextToStr (Text -> [Char]) -> (ByteString -> Text) -> ByteString -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
forall a. Typeable a => a -> Text
toSText
        

-- | -------------------------------------------------------------------------------- 
-- | Wed Dec  5 15:06:00 2018 
--   Sat Jun  8 23:42:18 2019 
-- | upload with following POST to upload file to server
-- | -------------------------------------------------------------------------------- 
-- <form action="/upload" method="POST" enctype="multipart/form-data">
--  Upload File: <input type="file" name="file"><br>
--  <input type="submit" value="submit">
-- </form> 
-- | -------------------------------------------------------------------------------- 
--   http://localhost:8000/up/
-- | File is uploaded to => haskell_web/uploaddir 
upload::String -> Application
upload :: [Char] -> Application
upload [Char]
updir Request
req Response -> IO ResponseReceived
response = do
    -- Parse the request body. We'll ignore parameters and just look
    -- at the files
    ([Param]
params, [File ByteString]
files) <- BackEnd ByteString -> Request -> IO ([Param], [File ByteString])
forall y. BackEnd y -> Request -> IO ([Param], [File y])
parseRequestBody BackEnd ByteString
forall (m :: * -> *) ignored1 ignored2.
Monad m =>
ignored1 -> ignored2 -> m ByteString -> m ByteString
lbsBackEnd Request
req
--    case lookup "id" params of
--        Nothing -> undefined
--        Just x -> undefined

    -- Look for the file parameter called "file"
    case ByteString -> [File ByteString] -> Maybe (FileInfo ByteString)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup ByteString
"file" [File ByteString]
files of
        -- Not found, so return a 400 response
        Maybe (FileInfo ByteString)
Nothing -> Response -> IO ResponseReceived
response (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ Status -> ResponseHeaders -> ByteString -> Response
responseLBS
            Status
status400
            [(HeaderName
"Content-Type", ByteString
"text/plain; charset=utf-8")]
            ByteString
"No file parameter found"
        -- Got the file 
        -- take the file name
        -- grab the content
        -- write the file to filesystem
        Just FileInfo ByteString
file -> do
            let
                -- Determine the name of the file to write out
                name :: [Char]
name = ShowS
takeFileName ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ ByteString -> [Char]
forall a. Typeable a => a -> [Char]
toStr (ByteString -> [Char]) -> ByteString -> [Char]
forall a b. (a -> b) -> a -> b
$ FileInfo ByteString -> ByteString
forall c. FileInfo c -> ByteString
fileName FileInfo ByteString
file
                -- and grab the content
                content :: ByteString
content = FileInfo ByteString -> ByteString
forall c. FileInfo c -> c
fileContent FileInfo ByteString
file
            -- Write it out
            [Char] -> [[Char]] -> IO ()
writeToFile [Char]
"/tmp/f1.x" [[Char]
name]
            [Char] -> ByteString -> IO ()
LA.writeFile ([Char]
updir [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
name) ByteString
content
            Response -> IO ResponseReceived
response (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ Response
replyCssButton 

searchMap:: Application
searchMap :: Application
searchMap Request
req Response -> IO ResponseReceived
response = do
    -- Parse the request body. We'll ignore parameters and just look
    -- at the files
    ([Param]
_params, [File ByteString]
files) <- BackEnd ByteString -> Request -> IO ([Param], [File ByteString])
forall y. BackEnd y -> Request -> IO ([Param], [File y])
parseRequestBody BackEnd ByteString
forall (m :: * -> *) ignored1 ignored2.
Monad m =>
ignored1 -> ignored2 -> m ByteString -> m ByteString
lbsBackEnd Request
req

    -- Look for the file parameter called "file"
    case ByteString -> [Param] -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup ByteString
"post" [Param]
_params of
        -- Not found, so return a 400 response
        Maybe ByteString
Nothing -> Response -> IO ResponseReceived
response (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ Status -> ResponseHeaders -> ByteString -> Response
responseLBS
            Status
status400
            [(HeaderName
"Content-Type", ByteString
"text/plain; charset=utf-8")]
            ByteString
"No post"
        -- Got it!
        Just ByteString
"post" -> Response -> IO ResponseReceived
response (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ Status -> ResponseHeaders -> ByteString -> Response
responseLBS
            Status
status200
            [(HeaderName
"Content-Type", ByteString
"text/text")]
            ByteString
"Just post" 


{-| 
    === user input autocomplete

    * search field, search input, search form

    <https://developer.mozilla.org/en-US/docs/Web/HTML/Element/input/color change background color Javascript>

    * search form has moved to htmlBody.htmlbs

    submitUpdateBackground => aronlib.js

    NOTE: NOT USE IT NOW ❌ 
    gf: js/aronlib.js
-} 
searchForm::String -> String
searchForm :: ShowS
searchForm [Char]
s = [r| 
             <div style="text-align:center;">
             <form action="/snippet" method="get" target=""> 
             <input type="text" style="font-size:18pt;height:50px;width:400px;" id="inputid" value="s van" oninput="searchChange(this);" name="id" list="autocomplete">  
                 <datalist id="autocomplete">" |] [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
s [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [r| </datalist><br>  
             </form> 
             </div> 
                <div>
                
                <input id='bgidcolor' type="color" onchange="submitUpdateBackground('background-color:' + this.value)" name="colorname"
                value="#e66465">
                <label for="body_background">Background</label>
                
                <input id='textcolorid' type="color" onchange="submitUpdateTextColor('color:' + this.value)" name="textcolorname"
                value="#e66465">
                <label for="text_color">TextColor</label>
                <svg width="20" height="20">
                  <rect width="20" height="20" style="fill:rgb(10,10,255);stroke-width:3;stroke:rgb(0,0,0)" />
                </svg>
                
                <svg width="20" height="20">
                  <rect width="20" height="20" style="fill:rgb(0,33,55);stroke-width:3;stroke:rgb(0,9,20)" />
                </svg>
                </div>
             |]