Commit 13d70dd4 authored by Alexandre Delanoë's avatar Alexandre Delanoë

[PRELUDE] no implicit prelude any more.

parent bd0a84dc
module Main where
--import System.Environment (getArgs)
import Data.Gargantext.Server (startGargantext)
main :: IO ()
main = startGargantext
-- (iniFile:_) <- getArgs
main = startGargantext -- port iniFile
......@@ -2,7 +2,7 @@
--
-- see: https://github.com/sol/hpack
--
-- hash: b579b76daf844d03881190aae30b1ef7e26436cddf446a3ef2d524ca4f122a97
-- hash: b9bfa189420281ceb8fe8d47b1d7800acdc1f9529c864156abcbfbfea5e06dc6
name: gargantext
version: 0.1.0.0
......@@ -22,6 +22,7 @@ cabal-version: >= 1.10
library
hs-source-dirs:
src
default-extensions: NoImplicitPrelude
build-depends:
aeson
, aeson-lens
......
......@@ -16,6 +16,8 @@ dependencies:
- text
library:
source-dirs: src
default-extensions:
- NoImplicitPrelude
ghc-options:
- -Wincomplete-uni-patterns
- -Wincomplete-record-updates
......
module Gargantext.Analysis where
import Gargantext.Prelude
-- import qualified Data.Text.Lazy as DTL
import Data.Text
import Opaleye (Column, PGInt4)
......
......@@ -4,6 +4,8 @@
module Gargantext.Database.Instances where
import Gargantext.Prelude
import Data.Time (UTCTime)
import Opaleye (PGInt4, PGTimestamptz, PGFloat8
, QueryRunnerColumnDefault
......
......@@ -2,14 +2,15 @@
module Gargantext.Ngrams.Count where
import System.Environment (getArgs)
import Gargantext.Prelude
import Data.Foldable as F
import Data.Map (Map)
import qualified Data.Map as M
import qualified Data.Text.Lazy.IO as DTLIO
--import qualified Data.Text.Lazy.IO as DTLIO
import qualified Data.Text.Lazy as DTL
-- | /O(n)/ Breaks a 'Text' up into each Text list of chars.
......@@ -36,11 +37,11 @@ occurrences xs = foldl' (\x y -> M.insertWith' (+) y 1 x) M.empty xs
--occurrences' :: Ord a => [a] -> Map a Integer
--occurrences' xs = DTL.foldl (\x y -> M.insertWith' (+) y 1 x) M.empty xs
countMain :: IO ()
countMain = do
(fichier:_) <- getArgs
c <- DTLIO.readFile fichier
--print $ occurrences $ DTL.chunksOf 1 c
print $ occurrences $ letters'' c
--print $ occurrences $ DTL.words $ DTL.toLower c
--countMain :: IO ()
--countMain = do
-- (fichier:_) <- getArgs
-- c <- DTLIO.readFile fichier
-- --print $ occurrences $ DTL.chunksOf 1 c
-- pure $ occurrences $ letters'' c
-- --print $ occurrences $ DTL.words $ DTL.toLower c
--
......@@ -21,6 +21,8 @@ module Gargantext.Ngrams.Metrics (levenshtein
, hamming
) where
import Gargantext.Prelude
import Data.Text (Text)
import GHC.Real (Ratio)
import qualified Data.Text.Metrics as DTM
......
......@@ -2,14 +2,18 @@
module Gargantext.Ngrams.Occurrences where
import Gargantext.Prelude
import Control.Monad ((>>),(>>=))
import Data.String (String())
import Data.Attoparsec.Text
import Data.Text (Text)
import Data.Either.Extra(Either(..))
import qualified Data.Text as T
import Control.Applicative
occurrenceParser :: Text -> Parser Bool
occurrenceParser txt = manyTill anyChar (string txt) >> pure True
......
module Gargantext.Ngrams.TextMining where
import Gargantext.Prelude
import Data.Ord(Ordering(LT,GT), compare)
import Data.Text (pack)
import Data.Bool (otherwise)
import Data.Map (empty, Map, insertWith, toList)
import Data.List (foldl, foldl')
import qualified Data.List as L
......@@ -9,7 +14,7 @@ sortGT (a1, b1) (a2, b2)
| a1 < a2 = GT
| a1 > a2 = LT
| a1 == a2 = compare b1 b2
sortGT (_, _) (_, _) = error "What is this case ?"
sortGT (_, _) (_, _) = panic (pack "What is this case ?")
--histogram :: Ord a => [a] -> [(a, Int)]
......@@ -51,7 +56,3 @@ countYear (x:xs) = insertWith (+) x 1 (countYear xs)
countYear' :: [Integer] -> Map Integer Integer
countYear' (xs) = foldl' (\x y -> insertWith (+) y 1 x) empty xs
textMiningMain :: IO ()
textMiningMain = do
print $ merge ["abc"::String] ["bcd" :: String]
......@@ -21,11 +21,15 @@ please follow the types.
module Gargantext.Parsers -- (parse, FileFormat(..))
where
import System.FilePath (takeExtension)
import Gargantext.Prelude
import System.FilePath (takeExtension, FilePath())
import Data.Attoparsec.ByteString (parseOnly, Parser)
import Data.ByteString as DB
import Data.Map as DM
----import Data.Either.Extra(Either(..))
import Data.Map as DM
import Data.Ord()
import Data.String()
import Data.Either.Extra(Either())
----
--import Control.Monad (join)
import Codec.Archive.Zip (withArchive, getEntry, getEntries)
......@@ -34,7 +38,7 @@ import Path.IO (resolveFile')
--import Control.Applicative ( (<$>) )
import Control.Concurrent.Async as CCA (mapConcurrently)
import Data.String (String())
import Gargantext.Parsers.WOS (wosParser)
---- import Gargantext.Parsers.XML (xmlParser)
---- import Gargantext.Parsers.DOC (docParser)
......
......@@ -10,6 +10,8 @@ module Gargantext.Prelude
( module Gargantext.Prelude
, module Protolude
, headMay
, module Text.Show
, module Text.Read
)
where
......@@ -22,7 +24,7 @@ import Protolude ( Bool(True, False), Int, Double, Integer
, sum, fromIntegral, length, fmap
, takeWhile, sqrt, undefined, identity
, abs, maximum, minimum, return, snd, truncate
, (+), (*), (/), (-), (.), (>=), ($), (**), (^)
, (+), (*), (/), (-), (.), (>=), ($), (**), (^), (<), (>), (==)
)
-- TODO import functions optimized in Utils.Count
......@@ -34,7 +36,8 @@ import qualified Control.Monad as M
import qualified Data.Map as Map
import qualified Data.Vector as V
import Safe (headMay)
import Text.Show (Show(), show)
import Text.Read (Read())
--pf :: (a -> Bool) -> [a] -> [a]
--pf = filter
......
module Gargantext.RCT where
import Gargantext.Prelude
foo :: Int
foo = undefined
--import Data.Text (Text, words)
......
-- | CNRS Copyrights
-- Licence: https://gitlab.iscpif.fr/humanities/gargantext/blob/stable/LICENSE
-- Author: Alexandre Delanoë (alexandre.delanoe@iscpif.fr)
{-|
Module : .Gargantext.Types.Main
Description : Short description
Copyright : (c) CNRS, 2017
License : AGPL + CECILL v3
Maintainer : team@gargantext.org
Stability : experimental
Portability : POSIX
Here is a longer description of this module, containing some
commentary with @some markup@.
-}
{-# LANGUAGE FlexibleInstances #-}
module Gargantext.Types.Main where
import Prelude
import Data.Eq (Eq())
import Data.Monoid ((<>))
import Protolude (fromMaybe)
--import Data.ByteString (ByteString())
import Data.Text (Text)
import Data.Time (UTCTime)
import Data.List (lookup)
import Gargantext.Types.Node ( NodePoly, HyperdataUser
, HyperdataFolder , HyperdataCorpus , HyperdataDocument
, HyperdataFavorites, HyperdataResource
......@@ -171,13 +185,14 @@ nodeTypes = [ (NodeUser , 1)
]
--
nodeTypeId :: NodeType -> NodeTypeId
nodeTypeId tn = fromMaybe (error ("Typename " ++ show tn ++ " does not exist")) (lookup tn nodeTypes)
nodeTypeId tn = fromMaybe (error $ "Typename " <> show tn <> " does not exist")
(lookup tn nodeTypes)
-- Temporary types to be removed
type Ngrams = (Text, Text, Text)
type ErrorMessage = String
type ErrorMessage = Text
......
......@@ -4,6 +4,9 @@
module Gargantext.Types.Node where
import Gargantext.Prelude
import Text.Show (Show())
import Data.Text (Text)
import GHC.Generics (Generic)
import Data.Time (UTCTime)
......
module Gargantext.Utils.DateUtils where
import Gargantext.Prelude
import Data.Time (UTCTime, toGregorian, utctDay)
--
......@@ -26,5 +27,3 @@ averageLength l = fromIntegral (sum (map length l)) / fromIntegral (length l)
-- c <- getCurrentTime
-- print c -- $ toYear $ toGregorian $ utctDay c
charToString :: Char -> String
charToString = (:[])
module Gargantext.Utils.Prefix where
import Prelude
import Data.Aeson (Value, defaultOptions, parseJSON)
import Data.Aeson.TH (Options, fieldLabelModifier, omitNothingFields)
import Data.Aeson.Types (Parser)
import Data.Char (toLower)
import Data.Monoid ((<>))
import Text.Read (readMaybe)
import Text.Read (Read(..),readMaybe)
-- | Aeson Options that remove the prefix from fields
......@@ -24,13 +27,13 @@ unCapitalize (c:cs) = toLower c : cs
dropPrefix :: String -> String -> String
dropPrefix prefix input = go prefix input
where
go pre [] = error $ contextual $ "prefix leftover: " <> pre
go pre [] = error $ conStringual $ "prefix leftover: " <> pre
go [] (c:cs) = c : cs
go (p:preRest) (c:cRest)
| p == c = go preRest cRest
| otherwise = error $ contextual $ "not equal: " <> (p:preRest) <> " " <> (c:cRest)
| otherwise = error $ conStringual $ "not equal: " <> (p:preRest) <> " " <> (c:cRest)
contextual msg = "dropPrefix: " <> msg <> ". " <> prefix <> " " <> input
conStringual msg = "dropPrefix: " <> msg <> ". " <> prefix <> " " <> input
parseJSONFromString :: (Read a) => Value -> Parser a
parseJSONFromString v = do
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment