Aelve Codesearch

grep over package repositories
Please provide a string to search for.
3+ characters are required.
Index updated 4 hours ago

total matches: more than 1000

AC-PPM-1.1.1
2 matches
Codec/PPM/Text.hs
stringPPM :: (Integer,Integer) -> [(Word8,Word8,Word8)] -> TXT.ByteString
stringPPM (sx,sy) ps =
  TXT.pack ("P3\n" ++ show sx ++ " " ++ show sy ++ "\n255\n") `TXT.append`
  TXT.unlines (map (\(r,g,b) -> TXT.pack $ unwords [show r, show g,show b]) ps)

{-|
  Convenience function: Generate PPM data and write it to the
  specified 'Handle'. The handle is not closed or flushed afterwards.
  This allows writing PPM data to network streams, etc. This function

            
Codec/PPM/Text.hs
  other PPM functions.
-}
fn_list :: ((Integer,Integer) -> (Word8,Word8,Word8)) -> (Integer, Integer) -> [(Word8,Word8,Word8)]
fn_list fn (sx, sy) = map fn [ (x,y) | y <- [0..sy-1], x <- [0..sx-1] ]

            
AMI-0.1
1 matches
Network/AMI.hs
    formatParams $ [("Action", name), ("ActionID", packID i)] ++ ps

formatParams :: Parameters -> B.ByteString
formatParams pairs = B.intercalate "\r\n" $ map one pairs
  where
    one (k,v) = k `B.append` ": " `B.append` v


            
Advise-me-0.1
27 matches
app/AdviseMeAdmin.hs
   query = queryString req

   param :: B.ByteString -> Maybe String
   param = fmap (safeString . maybe "" B.unpack) . flip lookup query

   paramFlag :: B.ByteString -> Bool
   paramFlag = maybe False (const True) . flip lookup query

   paramString :: B.ByteString -> String

            
app/AdviseMeAdmin.hs
table :: Bool -> [[HTMLBuilder]] -> HTMLBuilder
table hasHeader = tableAll . mconcat . zipWith f (hasHeader : repeat False)
 where
   f header = tag "tr" . mconcat . map make
    where
      make | header    = tag "th"
           | otherwise = tag "td"

pageNavBar :: Int -> Env -> (Int -> PageType) -> Int -> HTMLBuilder

            
app/AdviseMeAdmin.hs
pageNavBar :: Int -> Env -> (Int -> PageType) -> Int -> HTMLBuilder
pageNavBar nr env pageFor lastPage = fontSize Small $ mconcat $
   [ pageLinkWith 1 False (string "previous")] ++
   map pageLink [start .. end] ++
   [pageLinkWith lastPage False (string "next")]
 where
   start = (nr-5) `max` 1
   end   = (start+10) `min` lastPage


            
app/AdviseMeAdmin.hs
      = spanClass "strategies"
      . mconcat
      . intersperse br
      . map (string . uncurry (state2label taskNetwork))
      . filter (("Strat" `isSuffixOf`) . fst)
      . hardEvidence


-- ** HTML pages

            
app/AdviseMeAdmin.hs
reportPage showEvidence env = do
   allEntries <- allRecords (connection env)
   humanAssessments <- allHumanAssessments (connection env)
   return . HTMLFile . mconcat . intersperse hr . flip map (grouped allEntries) $
      \(sID, entries) ->
         h2 sID <> (mconcat . intersperse br . map (htmlEntry env humanAssessments showEvidence) $ entries)

   where
   grouped = orderBy ((! "studentid") :: SqlRecord -> String)



            
app/AdviseMeAdmin.hs
         <> pageNavBar i env (ModelPage studentid) n <>
         tag "div" (right $ string (formatTime defaultTimeLocale "%Y-%m-%d %H:%M:%S" time))) <>
      h3 ("Inputs for " ++ tID) <>
      mconcat (map (uncurry inputBox) (inputHTMLs inputXML)) <>
      bold (string "Evidence: ") <> text ev <> br <>
      h3 ("Report for " ++ sID) <>
      htmlReport report <>
      h3 ("User model for " ++ sID) <>
      networkToSVG Just l1 (sm `trans` nw1) <>

            
app/AdviseMeAdmin.hs
-- | Create a table representing the student report.
htmlReport :: StudentReport -> HTMLBuilder
htmlReport report = W3.tableAll . mconcat $
      ( tag "tr" . mconcat . map (tag "th") $ [string "Competence", string "Value", string "Visualisation"] ) : 
      [ htmlCompetence 0 c | c <- competences report ]

   where 

   htmlCompetence :: Int -> Competence -> HTMLBuilder

            
app/AdviseMeAdmin.hs

   htmlCompetence :: Int -> Competence -> HTMLBuilder
   htmlCompetence i c = mconcat $ 
      ( tag "tr" . mconcat . map (tag "td") $
            [ spacer i <> (translationLabel $ skillText c), maybe (string "?") htmlPercentage $ skillValue c, skillBar $ (maybe 0.5 id (skillValue c) - 0.5) * 2]
      ) :
      [ htmlCompetence (i+1) c' | c' <- subskills c ]

   spacer :: Int -> HTMLBuilder

            
app/AdviseMeAdmin.hs

-- | Extract the inputIDs and input texts from an entry's XML.
inputHTMLs :: XML.XML -> [(InputID, HTMLBuilder)]
inputHTMLs = map (fmap $ XML.tag "pre"
                       . mconcat
                       . (("style" XML..=. "white-space: pre-wrap"):)
                       . map (either XML.string XML.builder)
                       . content
                       )
           . fromMaybe []
           . collectInputs


            
app/AdviseMeAdmin.hs
   bold (string $ record ! "taskid") <> 
   string (" (request: " ++ findWithDefault "unknown" "original" record ++ ")") <> br <>
   (if showEvidence then tag "div" $ small (bold (string "evidence") <> string ": " <> text (record ! "evidence" :: Evidence) <> mistakesHTML) else mempty) <>
   mconcat (map (uncurry inputBox) (inputHTMLs $ record ! "input")) <>
   button
      (urlFor env {pageType = SingleRequest (record ! "rowid")})
      (rounded XL . border . W3.background W3.Blue $ string "download XML") <> br
   
   where

            
app/AdviseMeAdmin.hs

   mistakesHTML = maybe
      (tag "div" $ string "(no human assessment)")
      (tag "div" . mconcat . intersperse (string ", ") . map mistaketoHTML)
      mistakes

   mistaketoHTML (nID, Just x, Nothing) = tag "span" $ textColor Blue (string nID <> string " should be " <> string x)
   mistaketoHTML (nID, x, _) = tag "span" $ textColor Red (string nID <> string " should be " <> maybe (string "empty") string x)


            
app/AdviseMeAdmin.hs
   inputBoxes :: M.Map InputID [(StudentID, XMLBuilder)] -> HTMLBuilder
   inputBoxes = flip M.foldrWithKey mempty $ \inputID list accumulator ->
      h3 ("Inputs for " ++ inputID) <>
      mconcat (map (uncurry inputBox) list) <>
      accumulator

   perc :: (Show a, Show b, Real a, Real b) => a -> b -> String
   perc x y = show x ++ " of " ++ show y ++ " (" ++ percentage 1 (x // y) ++ ")"


            
app/AdviseMeAdmin.hs
   perc x y = show x ++ " of " ++ show y ++ " (" ++ percentage 1 (x // y) ++ ")"

   makeTable :: Priors -> Table String String String
   makeTable (Priors mapping)
      = fromList
      . concatMap (\(nID, Prior p) -> [ ((nID, maybe "Undecided" id lbl), show count) | (lbl, count) <- M.toList p])
      . M.toList
      . M.mapKeysWith mappend snd
      $ mapping


studentsPage :: Env -> IO Resource
studentsPage env
   = HTMLFile

            
app/AdviseMeAdmin.hs
   . panel
   . htmlTable (htmlStudentID env) (const $ htmlLabel "Number of entries") text
   . fromList
   . map (\(x,y) -> ((x,()),y))
   <$> countStudentEntries (connection env)



studentModelsPage :: FileType -> Env -> IO Resource

            
app/AdviseMeAdmin.hs
optionsPage :: Env -> IO Resource
optionsPage env = do
   files <- findDatabases
   times <- mapM getModificationTime files
   return $ HTMLFile $ panel $
      h1 "Database" <>
      table False (zipWith f files times)
 where
   f file time =

            
app/AdviseMeAdmin.hs
-- * Network stuff

trans :: Evidence -> Network () -> Network Probability
trans ev = mapNodes $ \n ->
   let ps = case lookup (nodeId n) (fromEvidenceTp ev) of
               Just (Index i)    -> take (size n) [ if a==i then 1 else 0 | a <- [0..] ]
               Just (Virtual xs) -> map snd xs
               Nothing           -> replicate (size n) 0

   in n { states = zipWith (\(s, _) a -> (s, a)) (states n) ps }

            
app/DatabaseBuilder.hs
         )
#endif
      <*>
         ( fmap (fmap $ map trim . split ',') . O.optional . O.strOption $
            O.long "filter" <>
            O.help "Put requests in the given order; discard all others (expects comma-seperated list of task IDs)"
         )
      <*>
         ( O.switch $

            
app/DatabaseBuilder.hs
   let filterFlag = isJust . taskFilterArg
       taskFilter = fromMaybe [] $ taskFilterArg arg

   inConns <- mapM connectSqlite3 (inDBs arg)

   -- Test if a students table already exist
   (anyStudentsTable, allStudentsTable) <- do
      hasTable <- map ("students" `elem`) <$> mapM SQL.getTables inConns
      return (or hasTable, and hasTable)

   -- Check for nonsensical commands
   unless (smFlag arg `implies` (allStudentsTable || drFlag arg)) $
      error "Cannot run student modeller without evidence. Either run --evidence or make sure your input databases already contain students tables."

            
app/DatabaseBuilder.hs
#ifdef XLSX
   -- Write final models table
   let humanAssessments = writeHumanAssessmentTableFlag arg
   let allObserved = foldl (\m r -> M.insertWith mappend (r!"studentid",r!"taskid") (r ! "evidence") m) mempty records
   when (not $ null humanAssessments) $ do
      tallies <- forM humanAssessments $ \path -> do
         xlsx <- getSpreadsheet path
         tally' xlsx allObserved
      writeHumanAssessmentTable conn . mconcat . concat . map M.elems $ tallies

            
app/DatabaseBuilder.hs
      tallies <- forM humanAssessments $ \path -> do
         xlsx <- getSpreadsheet path
         tally' xlsx allObserved
      writeHumanAssessmentTable conn . mconcat . concat . map M.elems $ tallies
#endif

   -- Finalize
   SQL.commit conn
   SQL.disconnect conn

            
app/DatabaseBuilder.hs
   -- Finalize
   SQL.commit conn
   SQL.disconnect conn
   mapM_ SQL.disconnect inConns


-- | Auxiliary: List all possible task IDs.
taskIDs :: [String]
taskIDs = map showId tasks

            
app/DatabaseBuilder.hs

-- | Auxiliary: List all possible task IDs.
taskIDs :: [String]
taskIDs = map showId tasks


-- | Auxiliary: Logical material implication.
implies :: Bool -> Bool -> Bool
x `implies` y = not x || y

            
app/DatabaseBuilder.hs
   forM records $ \record ->
      let input = addCodepoints . fixEntities . T.unpack . T.decodeLatin1 . Char8.pack $ record ! "input"
      in do
         --mapM putChar (filter (\x -> not $ x == '\10' || x >= ' ' || x <= '~') input)
         return . insert "input" input $ record

   where
   -- | Temporary solution to solve issue #240 & #253. The issue was that
   -- parseXML expects a string without actual Unicode characters - not a

            
app/DatabaseBuilder.hs

   -- | Fix HTML entities DWO sent wrong. (see issue #242)
   fixEntities :: String -> String
   fixEntities = flip (foldr ($)) $ map (uncurry replace)
      [ ("&lt;;","&lt;") -- This is super hacky, but so is the problem itself
      , ("&lt","&lt;")
      ]



            
app/DatabaseBuilder.hs
-- | Add identifying information that is not logged by Ideas. Clearly, this is
-- not an ideal solution, but it will do for now.
decorateRequests :: [SqlRecord] -> IO [SqlRecord]
decorateRequests = mapM $ \record ->
   let  input = record ! "input"
        (sID,tID) = fromJust . collectIDs $ input
        iIDs = intercalate "," . map fst . fromJust . collectInputs $ input
        rID = range [record ! "rowid"]
   in return
         . insert "inputs" iIDs
         . insert "studentid" sID
         . insert "taskid" tID

            
app/DatabaseBuilder.hs
anonymize :: [SqlRecord] -> IO [SqlRecord]
anonymize records = 
   let translation :: M.Map String String
       translation = M.fromList $ zip (nub $ map (! "studentid") records) (map show [1..])
   in forM records $ \record -> do
      let sID' = translation M.! (record ! "studentid")
      return $ insert "studentid" sID'
             . insert "input" (setID sID' $ record ! "input")
             . insert "output" (setID sID' $ record ! "output")

            
app/DatabaseBuilder.hs

   where
   setID :: String -> XML.XML -> XML.XML
   setID sID = XML.foldXML (\t as cs -> XML.makeXML t . mconcat $ map (mkAttr' sID) as ++ map (either XML.string XML.builder) cs) id id

   mkAttr' :: String -> XML.Attribute -> XML.XMLBuilder
   mkAttr' sID ("userid" XML.:= _) = "userid" XML..=. sID
   mkAttr' sID ("user" XML.:= _) = "user" XML..=. sID
   mkAttr' sID (n XML.:= a) = n XML..=. a